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 C |
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 | |
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 | |
a631063f | 157 | ." Symbol '" sym pr-str safe-type ." ' not found." cr |
60801ed6 | 158 | 1 throw |
a631063f C |
159 | else |
160 | @ | |
60801ed6 C |
161 | endif ;; |
162 | drop | |
163 | ||
45c1894b | 164 | : eval-ast { env list -- list } |
60801ed6 C |
165 | here |
166 | list MalList/start @ { expr-start } | |
167 | list MalList/count @ 0 ?do | |
45c1894b | 168 | env expr-start i cells + @ eval , |
60801ed6 C |
169 | loop |
170 | here>MalList ; | |
171 | ||
172 | MalList | |
173 | extend mal-eval { env list -- val } | |
45c1894b C |
174 | env list MalList/start @ @ eval |
175 | env list rot eval-invoke ;; | |
60801ed6 C |
176 | drop |
177 | ||
178 | MalVector | |
179 | extend mal-eval ( env vector -- vector ) | |
45c1894b | 180 | MalVector/list @ eval-ast |
60801ed6 C |
181 | MalVector new swap over MalVector/list ! ;; |
182 | drop | |
183 | ||
184 | MalMap | |
185 | extend mal-eval ( env map -- map ) | |
45c1894b | 186 | MalMap/list @ eval-ast |
60801ed6 C |
187 | MalMap new swap over MalMap/list ! ;; |
188 | drop | |
189 | ||
45c1894b | 190 | : rep ( str-addr str-len -- str-addr str-len ) |
60801ed6 C |
191 | read |
192 | repl-env swap eval | |
193 | print ; | |
194 | ||
195 | create buff 128 allot | |
45c1894b | 196 | 77777777777 constant stack-leak-detect |
60801ed6 C |
197 | |
198 | : read-lines | |
199 | begin | |
200 | ." user> " | |
45c1894b | 201 | stack-leak-detect |
60801ed6 | 202 | buff 128 stdin read-line throw |
45c1894b C |
203 | while ( num-bytes-read ) |
204 | buff swap ( str-addr str-len ) | |
60801ed6 | 205 | ['] rep |
45c1894b C |
206 | \ execute safe-type |
207 | catch ?dup 0= if safe-type else ." Caught error " . endif | |
60801ed6 | 208 | cr |
45c1894b | 209 | stack-leak-detect <> if ." --stack leak--" cr endif |
60801ed6 C |
210 | repeat ; |
211 | ||
212 | read-lines | |
213 | cr | |
214 | bye |