X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=blobdiff_plain;f=scheme.4th;h=f8dd0899d0e02aac9094648a03be84f1f10ee6f6;hp=244a33f67e612dfbb74165c7460fdf8fd1d8e356;hb=3eaf389aa81bcfbf8dd64c89520925413d5c2390;hpb=82b93d081309895fe1a8e446daad5b8a75896fa3 diff --git a/scheme.4th b/scheme.4th index 244a33f..f8dd089 100644 --- a/scheme.4th +++ b/scheme.4th @@ -139,11 +139,6 @@ variable nextfree cdr-cells + ! ; -: caar car car ; -: cadr cdr car ; -: cdar car cdr ; -: cddr cdr cdr ; - : nil 0 nil-type ; : nil? nil-type istype? ; @@ -1058,7 +1053,7 @@ parse-idx-stack parse-idx-sp ! quote-symbol tagged-list? ; : quote-body ( quote-obj -- quote-body-obj ) - cadr ; + cdr car ; : quasiquote? ( obj -- obj bool ) quasiquote-symbol tagged-list? ; @@ -1094,15 +1089,12 @@ parse-idx-stack parse-idx-sp ! ; defer eval-quasiquote-item -: eval-quasiquote-list ( env obj -- res ) - nil? if - 2swap 2drop exit - then - +: eval-quasiquote-pair ( env obj -- res ) 2over 2over ( env obj env obj ) - cdr recurse - -2rot car ( cdritems env objcar ) + cdr eval-quasiquote-item + + -2rot car ( cdritem env objcar ) unquote-splicing? if eval-unquote ( cdritems caritem ) @@ -1120,12 +1112,16 @@ defer eval-quasiquote-item ; :noname ( env obj ) + nil? if + 2swap 2drop exit + then + unquote? if eval-unquote exit then pair-type istype? if - eval-quasiquote-list exit + eval-quasiquote-pair exit then 2swap 2drop @@ -1407,6 +1403,7 @@ 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 )