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
Factored apply out of application-executor
[scheme.forth.jl.git]
/
src
/
scheme.4th
diff --git
a/src/scheme.4th
b/src/scheme.4th
index
7b1da05
..
af4157f
100644
(file)
--- a/
src/scheme.4th
+++ b/
src/scheme.4th
@@
-1273,6
+1273,11
@@
parse-idx-stack parse-idx-sp !
exit
then
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
\ Anything else is parsed as a symbol
readsymbol charlist>symbol
@@
-1286,7
+1291,7
@@
parse-idx-stack parse-idx-sp !
\ }}}
\ }}}
-\ ----
Eval
---- {{{
+\ ----
Syntax
---- {{{
: self-evaluating? ( obj -- obj bool )
boolean-type istype? if true exit then
: self-evaluating? ( obj -- obj bool )
boolean-type istype? if true exit then
@@
-1449,7
+1454,7
@@
parse-idx-stack parse-idx-sp !
\ }}}
\ }}}
-\ ---- Analyze ----
+\ ---- Analyze ----
{{{
: evaluate-eproc ( eproc env --- res )
: evaluate-eproc ( eproc env --- res )
@@
-1636,15
+1641,7
@@
parse-idx-stack parse-idx-sp !
then
;
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
dup case
primitive-proc-type of
drop execute
@@
-1668,6
+1665,18
@@
parse-idx-stack parse-idx-sp !
endcase
;
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
: analyze-application ( exp -- eproc )
2dup operator analyze
2swap operands operand-eproc-list
@@
-1700,6
+1709,7
@@
parse-idx-stack parse-idx-sp !
; is analyze
; is analyze
+\ }}}
\ ---- Macro Expansion ---- {{{
\ ---- Macro Expansion ---- {{{