exit
then
+ nextchar [char] ) = if
+ inc-parse-idx
+ except-message: ." unmatched closing parenthesis." recoverable-exception throw
+ then
+
\ Anything else is parsed as a symbol
readsymbol charlist>symbol
\ }}}
-\ ---- Eval ---- {{{
+\ ---- Syntax ---- {{{
: self-evaluating? ( obj -- obj bool )
boolean-type istype? if true exit then
\ }}}
-\ ---- Analyze ----
+\ ---- Analyze ---- {{{
: evaluate-eproc ( eproc env --- res )
then
;
-: application-executor ( operator-proc arg-procs env -- res )
- 2rot 2over ( aprocs env fproc env )
- evaluate-eproc ( aprocs env proc )
-
- -2rot 2swap ( proc env aprocs )
- evaluate-operand-eprocs ( proc vals )
-
- 2swap ( vals proc )
-
+: apply ( vals proc )
dup case
primitive-proc-type of
drop execute
endcase
;
+: application-executor ( operator-proc arg-procs env -- res )
+ 2rot 2over ( aprocs env fproc env )
+ evaluate-eproc ( aprocs env proc )
+
+ -2rot 2swap ( proc env aprocs )
+ evaluate-operand-eprocs ( proc vals )
+
+ 2swap ( vals proc )
+
+ ['] apply goto
+;
+
: analyze-application ( exp -- eproc )
2dup operator analyze
2swap operands operand-eproc-list
; is analyze
+\ }}}
\ ---- Macro Expansion ---- {{{
;
:noname
- \ ." GC! "
+ ." GC! "
+
+ trace
gc-unmark
gc-sweep
- \ ." (" gc-count-marked . ." pairs marked as used.)" cr
+ ." (" gc-count-marked . ." pairs marked as used.)" cr
; is collect-garbage
\ }}}
ok-symbol ( port res )
begin
+ \ DEBUG
+ bold fg blue ." READ from " 2over drop . ." ==> " reset-term
+
2over read-port ( port res obj )
+ \ DEBUG
+ 2dup print cr
+
2dup EOF character-type objeq? if
2drop 2swap close-port
exit
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