From: Tim Vaughan Date: Sat, 5 Nov 2016 22:01:34 +0000 (+1300) Subject: Quasiquote fix. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=fa6316fc696ddda325b2e2a8af83f4024ddf32bd;p=scheme.forth.jl.git Quasiquote fix. --- diff --git a/scheme-library.scm b/scheme-library.scm index 62a7aa3..1a68a10 100644 --- a/scheme-library.scm +++ b/scheme-library.scm @@ -41,10 +41,7 @@ (define-macro (backwards . body) (cons 'begin (reverse body))) -(define method '(while (> counter 0) - (display counter) (newline) - (set! counter (- counter 1)))) - +; Test for the while macro. (define (count) (define counter 10) (while (> counter 0) diff --git a/scheme.4th b/scheme.4th index 244a33f..95c621a 100644 --- a/scheme.4th +++ b/scheme.4th @@ -1094,15 +1094,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 +1117,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 +1408,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 )