include debugging.4th
defer read
+defer expand
defer eval
defer print
create-symbol if if-symbol
create-symbol lambda lambda-symbol
create-symbol λ λ-symbol
-create-symbol begin begin-symbol
create-symbol eof eof-symbol
create-symbol no-match no-match-symbol
: lambda-body ( obj -- body )
cdr cdr ;
-: begin? ( obj -- obj bool )
- begin-symbol tagged-list? ;
-
-: begin-actions ( obj -- actions )
- cdr ;
-
: eval-sequence ( explist env -- finalexp env )
( Evaluates all bar the final expressions in
an an expression list. The final expression
exit
then
- begin? if
- begin-actions 2swap
- eval-sequence
- ['] eval goto-deferred
- then
-
application? if
2over 2over ( env exp env exp )
extend-env eval-sequence eval
;
-defer expand
-
: expand-macro ( exp -- result )
pair-type istype? invert if exit then
2dup car symbol-type istype? invert if 2drop exit then
nil? if exit then
unquote? if
- unquote-symbol 2swap cdr expand nil cons cons
+ 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? if
+ pair-type istype? if
2dup car recurse
2swap cdr recurse
cons
2swap if-alternative none? if
2drop nil
else
- nil cons
+ expand nil cons
then
cons cons cons ;
-: expand-begin ( exp -- res )
- begin-symbol 2swap
- begin-actions expand-list
-
- cons ;
-
: expand-application ( exp -- res )
- 2dup operator
+ 2dup operator expand
2swap operands expand-list
cons ;
:noname ( exp -- result )
-
expand-macro
self-evaluating? if exit then
if? if expand-if exit then
- begin? if expand-begin exit then
-
application? if expand-application exit then
; is expand
include scheme-primitives.4th
- s" scheme-derived-forms.scm" load 2drop
-
-\ s" scheme-library.scm" load 2drop
+ s" scheme-library.scm" load 2drop
\ }}}
enable-gc
\ Display welcome message
- \ welcome-symbol nil cons global-env obj@ eval 2drop
+ welcome-symbol nil cons global-env obj@ eval 2drop
begin
['] repl-body catch