5 core MalEnv. constant
repl-env
7 99999999 constant
TCO-eval
12 \
." eval-> " dup pr
-str safe
-type cr
19 \
." Type: " dup mal
-type @ type-name
safe-type cr
22 MalDefault extend mal
-eval
nip ;; drop \
By default, evalutate
to yourself
25 extend eval
-invoke
{ env list
kw -- val }
26 0 kw env list
MalList/start
@ cell
+ @ eval
get
28 \ compute
not-found value
29 list
MalList/count
@ 1 > if
30 env list
MalList/start
@ 2 cells
+ @ TCO-eval
37 \ eval
all but
the first
item of list
38 : eval
-rest
{ env list
-- argv argc
}
39 list
MalList/start
@ cell
+ { expr
-start
}
40 list
MalList/count
@ 1- { argc
}
41 argc cells
allocate throw
{ target
}
43 env expr
-start
i cells
+ @ eval
49 extend eval
-invoke
{ env list
this -- list
}
50 env list
eval-rest
( argv
argc )
52 extend invoke ( argv
argc this -- val )
53 MalNativeFn/xt
@ execute
;;
57 extend eval-invoke ( env list
this -- list
)
58 SpecialOp/xt
@ execute
;;
61 : install
-special
( symbol
xt )
62 SpecialOp. repl-env env
/set
;
65 parse
-allot
-name
MalSymbol.
70 defspecial quote ( env list -- form )
71 nip MalList/start @ cell+ @ ;;
73 defspecial def! { env list -- val }
74 list MalList/start @ cell+ { arg0 }
76 env arg0 cell+ @ eval dup { val } ( key val )
79 defspecial let* { old-env list -- val }
80 old-env MalEnv. { env }
81 list MalList/start @ cell+ dup { arg0 }
83 dup MalList/start @ { bindings-start } ( list )
85 bindings-start i cells + dup @ swap cell+ @ ( sym expr )
89 env arg0 cell+ @ TCO-eval
90 \ TODO: dec refcount of env
93 defspecial do { env list -- val }
94 list MalList/start @ { start }
95 list MalList/count @ dup 1- { last } 1 ?do
104 defspecial if { env list -- val }
105 list MalList/start @ cell+ { arg0 }
106 env arg0 @ eval ( test-val )
114 list MalList/count @ 3 > if
115 env arg0 cell+ cell+ @ TCO-eval
121 env arg0 cell+ @ TCO-eval
124 s" &" MalSymbol. constant &-sym
126 : new-user-fn-env { argv argc mal-fn -- env }
127 mal-fn MalUserFn/formal-args @ { f-args-list }
128 mal-fn MalUserFn/env @ MalEnv. { env }
130 f-args-list MalList/start @ { f-args }
131 f-args-list MalList/count @ ?dup 0= if else
132 \ pass empty list for last arg, unless overridden below
133 1- cells f-args + @ MalList new env env/set
140 c cells allocate throw { start }
141 argv i cells + start c cells cmove
142 f-args i 1+ cells + @ ( more-args-symbol )
143 start c MalList. env env/set
152 extend eval-invoke { call-env list mal-fn -- list }
153 call-env list eval-rest
156 extend invoke ( argv argc mal-fn )
157 dup { mal-fn } new-user-fn-env { env }
158 env mal-fn MalUserFn/body @ TCO-eval ;;
161 defspecial fn* { env list -- val }
162 list MalList/start @ cell+ { arg0 }
164 env over MalUserFn/env !
165 arg0 @ to-list over MalUserFn/formal-args !
166 arg0 cell+ @ over MalUserFn/body ! ;;
169 extend mal-eval { env sym -- val }
173 ." Symbol '" sym pr-str safe-type ." ' not found." cr
180 : eval-ast { env list -- list }
182 list MalList/start @ { expr-start }
183 list MalList/count @ 0 ?do
184 env expr-start i cells + @ eval ,
189 extend mal-eval { env list -- val }
190 env list MalList/start @ @ eval
191 env list rot eval-invoke ;;
195 extend mal-eval ( env vector -- vector )
196 MalVector/list @ eval-ast
197 MalVector new swap over MalVector/list ! ;;
201 extend mal-eval ( env map -- map )
202 MalMap/list @ eval-ast
203 MalMap new swap over MalMap/list ! ;;
206 defcore eval ( argv argc )
207 drop @ repl-env swap eval ;;
209 : rep ( str-addr str-len -- str-addr str-len )
214 : mk-args-list ( -- )
217 next-arg 2dup 0 0 d<> while
222 create buff 128 allot
223 77777777777 constant stack-leak-detect
227 defcore swap! { argv argc -- val }
228 \ argv is (atom fn args...)
231 argc 1- { call-argc }
232 call-argc cells allocate throw { call-argv }
233 atom Atom/val call-argv 1 cells cmove
234 argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove
235 call-argv call-argc fn invoke
236 dup TCO-eval = if drop eval endif { new-val }
237 new-val atom Atom/val !
240 s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
246 buff 128 stdin read-line throw
247 while ( num-bytes-read )
248 buff swap ( str-addr str-len )
251 catch
?dup 0= if safe-type else ." Caught error " . endif
253 stack-leak
-detect
<> if ." --stack leak--" cr endif
257 mk
-args
-list
{ args
-list
}
258 args
-list
MalList/count
@ 0= if
259 s
" *ARGV*" MalSymbol. MalList/Empty repl-env env
/set
262 args
-list
MalList/start
@ @ { filename
}
263 s
" *ARGV*" MalSymbol. args
-list
MalList/rest
repl-env env
/set
266 here
s" load-file" MalSymbol. , filename
, here
>MalList