5 core MalEnv. constant
repl-env
8 : eval
( env obj
) mal
-eval
;
10 \
." Type: " dup mal
-type @ type-name
safe-type cr
13 MalDefault extend mal
-eval
nip ;; drop \
By default, evalutate
to yourself
16 extend eval
-invoke
{ env list
kw -- val }
17 0 kw env list
MalList/start
@ cell
+ @ eval
get
19 \ compute
not-found value
20 list
MalList/count
@ 1 > if
21 env list
MalList/start
@ 2 cells
+ @ eval
28 \ eval
all but
the first
item of list
29 : eval
-rest
{ env list
-- argv argc
}
30 list
MalList/start
@ cell
+ { expr
-start
}
31 list
MalList/count
@ 1- { argc
}
32 argc cells
allocate throw
{ target
}
34 env expr
-start
i cells
+ @ eval
40 extend eval
-invoke
( env list
this -- list
)
41 MalNativeFn/xt
@ { xt
}
42 eval
-rest
( argv
argc )
43 xt
execute ( return
-val ) ;;
47 extend eval
-invoke
( env list
this -- list
)
48 SpecialOp/xt
@ execute ;;
51 : install
-special
( symbol
xt )
52 SpecialOp. repl-env env
/set
;
55 parse
-allot
-name
MalSymbol.
60 defspecial quote ( env list -- form )
61 nip MalList/start @ cell+ @ ;;
63 defspecial def! { env list -- val }
64 list MalList/start @ cell+ { arg0 }
66 env arg0 cell+ @ eval dup { val } ( key val )
69 defspecial let* { old-env list -- val }
70 old-env MalEnv. { env }
71 list MalList/start @ cell+ dup { arg0 }
73 dup MalList/start @ { bindings-start } ( list )
75 bindings-start i cells + dup @ swap cell+ @ ( sym expr )
80 \ TODO: dec refcount of env
83 defspecial do { env list -- val }
86 list MalList/count @ 1 ?do
88 dup i cells + @ env swap eval
92 defspecial if { env list -- val }
93 list MalList/start @ cell+ { arg0 }
94 env arg0 @ eval ( test-val )
102 list MalList/count @ 3 > if
103 env arg0 cell+ cell+ @ eval
109 env arg0 cell+ @ eval
112 s" &" MalSymbol. constant &-sym
115 extend eval-invoke { call-env list mal-fn -- list }
116 call-env list eval-rest { argv argc }
118 mal-fn MalUserFn/formal-args @ { f-args-list }
119 mal-fn MalUserFn/env @ MalEnv. { env }
121 f-args-list MalList/start @ { f-args }
122 f-args-list MalList/count @ ?dup 0= if else
123 \ pass nil for last arg, unless overridden below
124 1- cells f-args + @ mal-nil env env/set
130 f-args i 1+ cells + @ ( more-args-symbol )
131 MalList new ( sym more-args )
132 argc i - dup { c } over MalList/count !
133 c cells allocate throw dup { start } over MalList/start !
134 argv i cells + start c cells cmove
142 env mal-fn MalUserFn/body @ eval ;;
145 defspecial fn* { env list -- val }
146 list MalList/start @ cell+ { arg0 }
148 env over MalUserFn/env !
149 arg0 @ to-list over MalUserFn/formal-args !
150 arg0 cell+ @ over MalUserFn/body ! ;;
153 extend mal-eval { env sym -- val }
157 ." Symbol '" sym pr-str safe-type ." ' not found." cr
164 : eval-ast { env list -- list }
166 list MalList/start @ { expr-start }
167 list MalList/count @ 0 ?do
168 env expr-start i cells + @ eval ,
173 extend mal-eval { env list -- val }
174 env list MalList/start @ @ eval
175 env list rot eval-invoke ;;
179 extend mal-eval ( env vector -- vector )
180 MalVector/list @ eval-ast
181 MalVector new swap over MalVector/list ! ;;
185 extend mal-eval ( env map -- map )
186 MalMap/list @ eval-ast
187 MalMap new swap over MalMap/list ! ;;
190 : rep ( str-addr str-len -- str-addr str-len )
195 create buff 128 allot
196 77777777777 constant stack-leak-detect
202 buff 128 stdin read-line throw
203 while ( num-bytes-read )
204 buff swap ( str-addr str-len )
207 catch
?dup 0= if safe-type else ." Caught error " . endif
209 stack-leak
-detect
<> if ." --stack leak--" cr endif