: quote-body ( quote-obj -- quote-body-obj )
cadr ;
+: quasiquote? ( obj -- obj bool )
+ quasiquote-symbol tagged-list? ;
+
+: unquote? ( obj -- obj bool )
+ unquote-symbol tagged-list?
+;
+
+: eval-unquote ( env obj -- res )
+ cdr ( env args )
+
+ nil? if
+ recoverable-exception throw" no arguments to unquote."
+ then
+
+ 2dup cdr
+ nil? false = if
+ recoverable-exception throw" too many arguments to unquote."
+ then
+
+ 2drop car 2swap eval
+;
+
+defer eval-quasiquote-item
+: eval-quasiquote-list ( env obj -- res )
+ nil? if
+ 2swap 2drop exit
+ then
+
+ 2over 2over ( env obj env obj )
+
+ car eval-quasiquote-item ( env obj caritem )
+
+ -2rot cdr recurse ( caritem cdritems )
+ cons
+;
+
+:noname ( env obj )
+ unquote? if
+ eval-unquote exit
+ then
+
+ pair-type istype? if
+ eval-quasiquote-list exit
+ then
+
+ 2swap 2drop
+; is eval-quasiquote-item
+
+: eval-quasiquote ( obj env -- res )
+ 2swap cdr ( env args )
+
+ nil? if
+ recoverable-exception throw" no arguments to quasiquote."
+ then
+
+ 2dup cdr ( env args args-cdr )
+ nil? false = if
+ recoverable-exception throw" too many arguments to quasiquote."
+ then
+
+ 2drop car ( env arg )
+
+ eval-quasiquote-item
+;
+
: variable? ( obj -- obj bool )
symbol-type istype? ;
exit
then
+ quasiquote? if
+ 2swap eval-quasiquote
+ exit
+ then
+
variable? if
2swap lookup-var
exit