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
\ }}}
+\ ---- 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 ;
2swap 2drop ( port obj )
+ expand
+
global-env obj@ eval ( port res )
again
;
true exit
then
+ expand
+
global-env obj@ eval
fg cyan ." ; " print reset-term