The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Quasiquote fix.
[scheme.forth.jl.git]
/
scheme.4th
diff --git
a/scheme.4th
b/scheme.4th
index
c300365
..
95c621a
100644
(file)
--- a/
scheme.4th
+++ b/
scheme.4th
@@
-1094,15
+1094,12
@@
parse-idx-stack parse-idx-sp !
;
defer eval-quasiquote-item
;
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 )
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 )
unquote-splicing? if
eval-unquote ( cdritems caritem )
@@
-1120,12
+1117,16
@@
defer eval-quasiquote-item
;
:noname ( env obj )
;
:noname ( env obj )
+ nil? if
+ 2swap 2drop exit
+ then
+
unquote? if
eval-unquote exit
then
pair-type istype? if
unquote? if
eval-unquote exit
then
pair-type istype? if
- eval-quasiquote-
list
exit
+ eval-quasiquote-
pair
exit
then
2swap 2drop
then
2swap 2drop
@@
-1247,10
+1248,10
@@
hide env
: if-consequent ( ifobj -- conseq )
cdr cdr car ;
: if-consequent ( ifobj -- conseq )
cdr cdr car ;
-: if-alternative ( ifobj -- alt|
fals
e )
+: if-alternative ( ifobj -- alt|
non
e )
cdr cdr cdr
nil? if
cdr cdr cdr
nil? if
- 2drop
fals
e
+ 2drop
non
e
else
car
then ;
else
car
then ;
@@
-1407,6
+1408,7
@@
hide env
endcase
;
endcase
;
+( Simply evaluates the given procedure with expbody as its argument. )
: macro-expand ( proc expbody -- result )
2swap
2dup procedure-body ( expbody proc procbody )
: macro-expand ( proc expbody -- result )
2swap
2dup procedure-body ( expbody proc procbody )