Commit | Line | Data |
---|---|---|
60801ed6 C |
1 | require reader.fs |
2 | require printer.fs | |
3 | require core.fs | |
4 | ||
5 | core MalEnv. constant repl-env | |
6 | ||
45c1894b C |
7 | : read read-str ; |
8 | : eval ( env obj ) mal-eval ; | |
9 | ||
10 | \ ." Type: " dup mal-type @ type-name safe-type cr | |
11 | pr-str ; | |
60801ed6 | 12 | |
45c1894b | 13 | MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself |
60801ed6 C |
14 | |
15 | MalKeyword | |
45c1894b C |
16 | extend eval-invoke { env list kw -- val } |
17 | 0 kw env list MalList/start @ cell+ @ eval get | |
60801ed6 C |
18 | ?dup 0= if |
19 | \ compute not-found value | |
20 | list MalList/count @ 1 > if | |
45c1894b | 21 | env list MalList/start @ 2 cells + @ eval |
60801ed6 C |
22 | else |
23 | mal-nil | |
24 | endif | |
25 | endif ;; | |
26 | drop | |
27 | ||
45c1894b C |
28 | \ eval all but the first item of list |
29 | : eval-rest { env list -- argv argc } | |
136ce7c9 | 30 | list MalList/start @ cell+ { expr-start } |
45c1894b C |
31 | list MalList/count @ 1- { argc } |
32 | argc cells allocate throw { target } | |
33 | argc 0 ?do | |
34 | env expr-start i cells + @ eval | |
35 | target i cells + ! | |
60801ed6 | 36 | loop |
45c1894b | 37 | target argc ; |
136ce7c9 C |
38 | |
39 | MalNativeFn | |
45c1894b | 40 | extend eval-invoke ( env list this -- list ) |
136ce7c9 | 41 | MalNativeFn/xt @ { xt } |
45c1894b C |
42 | eval-rest ( argv argc ) |
43 | xt execute ( return-val ) ;; | |
60801ed6 C |
44 | drop |
45 | ||
46 | SpecialOp | |
45c1894b | 47 | extend eval-invoke ( env list this -- list ) |
60801ed6 C |
48 | SpecialOp/xt @ execute ;; |
49 | drop | |
50 | ||
51 | : install-special ( symbol xt ) | |
52 | SpecialOp. repl-env env/set ; | |
53 | ||
54 | : defspecial | |
55 | parse-allot-name MalSymbol. | |
56 | ['] install-special | |
57 | :noname | |
58 | ; | |
59 | ||
60 | defspecial quote ( env list -- form ) | |
61 | nip MalList/start @ cell+ @ ;; | |
62 | ||
63 | defspecial def! { env list -- val } | |
64 | list MalList/start @ cell+ { arg0 } | |
65 | arg0 @ ( key ) | |
45c1894b C |
66 | env arg0 cell+ @ eval dup { val } ( key val ) |
67 | env env/set val ;; | |
60801ed6 C |
68 | |
69 | defspecial let* { old-env list -- val } | |
70 | old-env MalEnv. { env } | |
71 | list MalList/start @ cell+ dup { arg0 } | |
72 | @ to-list | |
73 | dup MalList/start @ { bindings-start } ( list ) | |
74 | MalList/count @ 0 +do | |
75 | bindings-start i cells + dup @ swap cell+ @ ( sym expr ) | |
45c1894b | 76 | env swap eval |
60801ed6 C |
77 | env env/set |
78 | 2 +loop | |
45c1894b | 79 | env arg0 cell+ @ eval |
60801ed6 C |
80 | \ TODO: dec refcount of env |
81 | ;; | |
82 | ||
83 | defspecial do { env list -- val } | |
84 | list MalList/start @ | |
85 | 0 | |
86 | list MalList/count @ 1 ?do | |
87 | drop | |
45c1894b | 88 | dup i cells + @ env swap eval |
60801ed6 C |
89 | loop |
90 | nip ;; | |
91 | ||
92 | defspecial if { env list -- val } | |
93 | list MalList/start @ cell+ { arg0 } | |
45c1894b | 94 | env arg0 @ eval ( test-val ) |
60801ed6 C |
95 | dup mal-false = if |
96 | drop -1 | |
97 | else | |
98 | mal-nil = | |
99 | endif | |
100 | if | |
101 | \ branch to false | |
102 | list MalList/count @ 3 > if | |
45c1894b | 103 | env arg0 cell+ cell+ @ eval |
60801ed6 C |
104 | else |
105 | mal-nil | |
106 | endif | |
107 | else | |
108 | \ branch to true | |
45c1894b | 109 | env arg0 cell+ @ eval |
60801ed6 C |
110 | endif ;; |
111 | ||
c4403c17 C |
112 | s" &" MalSymbol. constant &-sym |
113 | ||
136ce7c9 | 114 | MalUserFn |
45c1894b C |
115 | extend eval-invoke { call-env list mal-fn -- list } |
116 | call-env list eval-rest { argv argc } | |
136ce7c9 | 117 | |
c4403c17 | 118 | mal-fn MalUserFn/formal-args @ { f-args-list } |
136ce7c9 | 119 | mal-fn MalUserFn/env @ MalEnv. { env } |
60801ed6 C |
120 | |
121 | f-args-list MalList/start @ { f-args } | |
c4403c17 | 122 | f-args-list MalList/count @ ?dup 0= if else |
fe364a97 DM |
123 | \ pass empty list for last arg, unless overridden below |
124 | 1- cells f-args + @ MalList new env env/set | |
c4403c17 | 125 | endif |
60801ed6 C |
126 | argc 0 ?do |
127 | f-args i cells + @ | |
c4403c17 C |
128 | dup &-sym m= if |
129 | drop | |
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 | |
135 | env env/set | |
136 | leave | |
137 | endif | |
60801ed6 C |
138 | argv i cells + @ |
139 | env env/set | |
140 | loop | |
141 | ||
45c1894b C |
142 | env mal-fn MalUserFn/body @ eval ;; |
143 | drop | |
60801ed6 C |
144 | |
145 | defspecial fn* { env list -- val } | |
146 | list MalList/start @ cell+ { arg0 } | |
136ce7c9 C |
147 | MalUserFn new |
148 | env over MalUserFn/env ! | |
149 | arg0 @ to-list over MalUserFn/formal-args ! | |
150 | arg0 cell+ @ over MalUserFn/body ! ;; | |
60801ed6 C |
151 | |
152 | MalSymbol | |
153 | extend mal-eval { env sym -- val } | |
a631063f | 154 | sym env env/get-addr |
60801ed6 C |
155 | dup 0= if |
156 | drop | |
9e2a4ab0 | 157 | 0 0 s" ' not found" sym pr-str s" '" ...throw-str |
a631063f C |
158 | else |
159 | @ | |
60801ed6 C |
160 | endif ;; |
161 | drop | |
162 | ||
45c1894b | 163 | : eval-ast { env list -- list } |
60801ed6 C |
164 | here |
165 | list MalList/start @ { expr-start } | |
166 | list MalList/count @ 0 ?do | |
45c1894b | 167 | env expr-start i cells + @ eval , |
60801ed6 C |
168 | loop |
169 | here>MalList ; | |
170 | ||
171 | MalList | |
172 | extend mal-eval { env list -- val } | |
4e258d3a DM |
173 | list MalList/count @ 0= if |
174 | list | |
175 | else | |
176 | env list MalList/start @ @ eval | |
177 | env list rot eval-invoke | |
178 | endif ;; | |
60801ed6 C |
179 | drop |
180 | ||
181 | MalVector | |
182 | extend mal-eval ( env vector -- vector ) | |
45c1894b | 183 | MalVector/list @ eval-ast |
60801ed6 C |
184 | MalVector new swap over MalVector/list ! ;; |
185 | drop | |
186 | ||
187 | MalMap | |
188 | extend mal-eval ( env map -- map ) | |
45c1894b | 189 | MalMap/list @ eval-ast |
60801ed6 C |
190 | MalMap new swap over MalMap/list ! ;; |
191 | drop | |
192 | ||
45c1894b | 193 | : rep ( str-addr str-len -- str-addr str-len ) |
60801ed6 C |
194 | read |
195 | repl-env swap eval | |
196 | print ; | |
197 | ||
198 | create buff 128 allot | |
45c1894b | 199 | 77777777777 constant stack-leak-detect |
60801ed6 | 200 | |
c5ea1323 NB |
201 | s\" (def! not (fn* (x) (if x false true)))" rep 2drop |
202 | ||
60801ed6 C |
203 | : read-lines |
204 | begin | |
205 | ." user> " | |
45c1894b | 206 | stack-leak-detect |
60801ed6 | 207 | buff 128 stdin read-line throw |
45c1894b | 208 | while ( num-bytes-read ) |
9e2a4ab0 JMC |
209 | dup 0 <> if |
210 | buff swap ( str-addr str-len ) | |
211 | ['] rep | |
212 | \ execute ['] nop \ uncomment to see stack traces | |
213 | catch ?dup 0= if | |
214 | safe-type cr | |
215 | stack-leak-detect <> if ." --stack leak--" cr endif | |
216 | else { errno } | |
217 | begin stack-leak-detect = until | |
218 | errno 1 <> if | |
219 | s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc | |
220 | to exception-object | |
221 | endif | |
222 | ." Uncaught exception: " | |
223 | exception-object pr-str safe-type cr | |
224 | endif | |
225 | endif | |
60801ed6 C |
226 | repeat ; |
227 | ||
228 | read-lines | |
229 | cr | |
230 | bye |