+\ ---- 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
+;
+
+defer expand
+
+: expand-quasiquote ;
+: expand-definition ;
+: expand-assignment ;
+: expand-define-macro ;
+: expand-if ;
+: expand-lambda ;
+: expand-begin ;
+: expand-application ;
+
+: expand-macro ( exp -- result )
+ pair-type istype? invert if exit then
+ 2dup car symbol-type istype? invert if 2drop exit then
+
+ lookup-macro nil? if
+ 2drop exit then
+
+ 2over cdr macro-eval
+
+ 2dup no-match-symbol objeq? if
+ 2drop exit
+ else
+ 2swap 2drop
+ then
+
+ R> drop ['] expand goto-deferred
+;
+
+:noname ( exp -- result )
+
+ expand-macro
+
+ 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-begin exit then
+
+ application? if expand-application exit then
+
+; is expand
+
+\ }}}
+