Added macro expansion skeleton.
authorTim Vaughan <tgvaughan@gmail.com>
Mon, 12 Jun 2017 07:23:07 +0000 (19:23 +1200)
committerTim Vaughan <tgvaughan@gmail.com>
Mon, 12 Jun 2017 07:23:07 +0000 (19:23 +1200)
src/scheme.4th

index bb65be2..1068229 100644 (file)
@@ -1656,20 +1656,6 @@ hide env
         endcase
 ;
 
-( Simply evaluates the given procedure with expbody as its argument. )
-: macro-expand ( proc expbody -- result )
-    2swap
-    2dup procedure-body ( expbody proc procbody )
-    -2rot 2dup procedure-params ( procbody expbody proc argnames )
-    -2rot procedure-env ( procbody argnames expbody procenv )
-    
-    -2rot 2swap
-    flatten-proc-args
-    2swap 2rot
-
-    extend-env eval-sequence eval
-;
-
 :noname ( obj env -- result )
     2swap
 
@@ -1764,6 +1750,44 @@ hide env
 
 \ }}}
 
+\ ---- Macro Expansion ---- {{{
+
+( Simply evaluates the given procedure with expbody as its argument. )
+: macro-eval ( proc expbody -- result )
+    2swap
+    2dup procedure-body ( expbody proc procbody )
+    -2rot 2dup procedure-params ( procbody expbody proc argnames )
+    -2rot procedure-env ( procbody argnames expbody procenv )
+    
+    -2rot 2swap
+    flatten-proc-args
+    2swap 2rot
+
+    extend-env eval-sequence eval
+;
+
+:noname ( exp -- result )
+
+    quasiquote? if expand-quasiquote exit then
+
+    definition? if expand-definition exit then
+
+    assignment? if expand-assignment exit then
+
+    macro-definition? if expand-define-macro exit then
+
+    if? if expand-if exit then
+
+    lambda? if expand-lambda exit then
+
+    begin? if expand-sequence exit then
+
+    application? if expand-apply exit then
+
+; is expand
+
+\ }}}
+
 \ ---- Print ---- {{{
 
 : printfixnum ( fixnum -- ) drop 0 .R ;
@@ -1988,6 +2012,8 @@ variable gc-stack-depth
 
         2swap 2drop ( port obj )
 
+        expand
+
         global-env obj@ eval ( port res )
     again
 ;
@@ -2016,6 +2042,8 @@ variable gc-stack-depth
         true exit
     then
 
+    expand
+
     global-env obj@ eval
 
     fg cyan ." ; " print reset-term