From: Tim Vaughan Date: Fri, 23 Jun 2017 01:29:08 +0000 (+1200) Subject: Removed quasiquote code. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=82718616a82ff93f0f307b36d0ba510c5c58a127;p=scheme.forth.jl.git Removed quasiquote code. --- diff --git a/src/scheme.4th b/src/scheme.4th index ec97f09..14f1c8e 100644 --- a/src/scheme.4th +++ b/src/scheme.4th @@ -1309,95 +1309,6 @@ parse-idx-stack parse-idx-sp ! : quote-body ( quote-obj -- quote-body-obj ) cdr car ; -: quasiquote? ( obj -- obj bool ) - quasiquote-symbol tagged-list? ; - -: unquote? ( obj -- obj bool ) - unquote-symbol tagged-list? ; - -: unquote-splicing? ( obj -- obj bool ) - unquote-splicing-symbol tagged-list? ; - -: eval-unquote ( env obj -- res ) - cdr ( env args ) - - nil? if - except-message: ." no arguments to unquote." recoverable-exception throw - then - - 2dup cdr - nil? false = if - except-message: ." too many arguments to unquote." recoverable-exception throw - then - - 2drop car 2swap eval -; - -( Create a new list from elements of l1 consed on to l2 ) -: join-lists ( l2 l1 -- l3 ) - nil? if 2drop exit then - - 2dup car - -2rot cdr - recurse cons -; - -defer eval-quasiquote-item -: eval-quasiquote-pair ( env obj -- res ) - 2over 2over ( env obj env obj ) - - cdr eval-quasiquote-item - - -2rot car ( cdritem env objcar ) - - unquote-splicing? if - eval-unquote ( cdritems caritem ) - - 2swap nil? if - 2drop - else - 2swap join-lists - then - else - eval-quasiquote-item ( cdritems caritem ) - 2swap cons - then - -; - -:noname ( env obj ) - nil? if - 2swap 2drop exit - then - - unquote? if - eval-unquote exit - then - - pair-type istype? if - eval-quasiquote-pair exit - then - - 2swap 2drop -; is eval-quasiquote-item - -: eval-quasiquote ( obj env -- res ) - 2swap cdr ( env args ) - - nil? if - except-message: ." no arguments to quasiquote." recoverable-exception throw - then - - 2dup cdr ( env args args-cdr ) - nil? false = if - except-message: ." too many arguments to quasiquote." recoverable-exception throw - then - - 2drop car ( env arg ) - - eval-quasiquote-item -; - : variable? ( obj -- obj bool ) symbol-type istype? ; @@ -1659,11 +1570,6 @@ hide env exit then - quasiquote? if - 2swap eval-quasiquote - exit - then - variable? if 2swap lookup-var exit @@ -1760,33 +1666,6 @@ hide env R> drop ['] expand goto-deferred ; -: expand-quasiquote-item ( exp -- result ) - nil? if exit then - - unquote? if - unquote-symbol 2swap cdr car expand nil cons cons - exit - then - - unquote-splicing? if - unquote-splicing-symbol 2swap cdr car expand nil cons cons - exit - then - - pair-type istype? if - 2dup car recurse - 2swap cdr recurse - cons - then -; - -: expand-quasiquote ( exp -- result ) - quasiquote-symbol 2swap cdr - - expand-quasiquote-item - - cons ; - : expand-definition ( exp -- result ) define-symbol 2swap @@ -1856,8 +1735,6 @@ hide env quote? if exit then - quasiquote? if expand-quasiquote exit then - definition? if expand-definition exit then assignment? if expand-assignment exit then @@ -2110,7 +1987,8 @@ variable gc-stack-depth include scheme-primitives.4th - s" scheme-library.scm" load 2drop + s" testing-library.scm" load 2drop + \ s" scheme-library.scm" load 2drop \ }}}