The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
f1bd626
)
Full draft of macro expander in place.
author
Tim Vaughan
<tgvaughan@gmail.com>
Tue, 13 Jun 2017 12:14:20 +0000
(
00:14
+1200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Tue, 13 Jun 2017 12:14:20 +0000
(
00:14
+1200)
src/scheme.4th
patch
|
blob
|
history
diff --git
a/src/scheme.4th
b/src/scheme.4th
index
0722208
..
9b5eb27
100644
(file)
--- a/
src/scheme.4th
+++ b/
src/scheme.4th
@@
-1756,12
+1756,6
@@
hide env
defer expand
defer expand
-: expand-quasiquote ;
-: expand-define-macro ;
-: expand-if ;
-: expand-lambda ;
-: expand-application ;
-
: expand-macro ( exp -- result )
pair-type istype? invert if exit then
2dup car symbol-type istype? invert if 2drop exit then
: expand-macro ( exp -- result )
pair-type istype? invert if exit then
2dup car symbol-type istype? invert if 2drop exit then
@@
-1780,6
+1774,28
@@
defer expand
R> drop ['] expand goto-deferred
;
R> drop ['] expand goto-deferred
;
+: expand-quasiquote-item ( exp -- result )
+ nil? if exit then
+
+ unquote? if
+ unquote-symbol 2swap cdr expand nil cons cons
+ exit
+ then
+
+ pair? 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
: expand-definition ( exp -- result )
define-symbol 2swap
@@
-1798,7
+1814,7
@@
defer expand
cons cons cons ;
cons cons cons ;
-: expand-
sequence
( exp -- res )
+: expand-
list
( exp -- res )
nil? if exit then
2dup car expand
nil? if exit then
2dup car expand
@@
-1806,23
+1822,54
@@
defer expand
cons ;
cons ;
-: expand-begin ( exp -- res )
- begin-symbol 2swap
- begin-actions expand-sequence
+: macro-definition-nameparams
+ cdr car ;
- cons ;
+: expand-define-macro ( exp -- res )
+ define-macro-symbol 2swap
+ 2dup macro-definition-nameparams
+ 2swap macro-definition-body expand-list
+
+ cons cons ;
: expand-lambda ( exp -- res )
lambda-symbol 2swap
2dup lambda-parameters
: expand-lambda ( exp -- res )
lambda-symbol 2swap
2dup lambda-parameters
- 2swap lambda-body expand-
sequence
+ 2swap lambda-body expand-
list
cons cons ;
cons cons ;
+: expand-if ( exp -- res )
+ if-symbol 2swap
+
+ 2dup if-predicate expand
+ 2swap 2dup if-consequent expand
+ 2swap if-alternative none? if
+ 2drop nil
+ else
+ nil cons
+ then
+
+ cons cons cons ;
+
+: expand-begin ( exp -- res )
+ begin-symbol 2swap
+ begin-actions expand-list
+
+ cons ;
+
+: expand-application ( exp -- res )
+ 2dup operator
+ 2swap operands expand-list
+
+ cons ;
+
:noname ( exp -- result )
expand-macro
:noname ( exp -- result )
expand-macro
+ self-evaluating? if exit then
+
quote? if exit then
quasiquote? if expand-quasiquote exit then
quote? if exit then
quasiquote? if expand-quasiquote exit then
@@
-1833,10
+1880,10
@@
defer expand
macro-definition? if expand-define-macro exit then
macro-definition? if expand-define-macro exit then
- if? if expand-if exit then
-
lambda? if expand-lambda exit then
lambda? if expand-lambda exit then
+ if? if expand-if exit then
+
begin? if expand-begin exit then
application? if expand-application exit then
begin? if expand-begin exit then
application? if expand-application exit then