Commit | Line | Data |
---|---|---|
9e8f5211 JM |
1 | REM POKE 1, PEEK(1)AND248: REM enable all ROM areas as RAM |
2 | REM POKE 55,0: POKE 56,192: CLR: REM move BASIC end from $A000 to $C000 | |
3 | GOTO MAIN | |
4 | ||
5 | REM $INCLUDE: 'readline.in.bas' | |
6 | REM $INCLUDE: 'types.in.bas' | |
7 | REM $INCLUDE: 'reader.in.bas' | |
8 | REM $INCLUDE: 'printer.in.bas' | |
9 | REM $INCLUDE: 'env.in.bas' | |
10 | REM $INCLUDE: 'core.in.bas' | |
11 | ||
12 | REM $INCLUDE: 'debug.in.bas' | |
13 | ||
14 | REM READ(A$) -> R% | |
15 | MAL_READ: | |
16 | GOSUB READ_STR | |
17 | RETURN | |
18 | ||
19 | REM PAIR_Q(B%) -> R% | |
20 | PAIR_Q: | |
21 | R%=0 | |
22 | IF (Z%(B%,0)AND15)<>6 AND (Z%(B%,0)AND15)<>7 THEN RETURN | |
23 | IF (Z%(B%,1)=0) THEN RETURN | |
24 | R%=1 | |
25 | RETURN | |
26 | ||
27 | REM QUASIQUOTE(A%) -> R% | |
28 | QUASIQUOTE: | |
29 | B%=A%: GOSUB PAIR_Q | |
30 | IF R%=1 THEN GOTO QQ_UNQUOTE | |
31 | REM ['quote, ast] | |
32 | AS$="quote": T%=5: GOSUB STRING | |
33 | B2%=R%: B1%=A%: GOSUB LIST2 | |
34 | ||
35 | RETURN | |
36 | ||
37 | QQ_UNQUOTE: | |
38 | R%=A%+1: GOSUB DEREF_R | |
39 | IF (Z%(R%,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE | |
40 | IF ZS$(Z%(R%,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE | |
41 | REM [ast[1]] | |
42 | R%=Z%(A%,1)+1: GOSUB DEREF_R | |
43 | Z%(R%,0)=Z%(R%,0)+16 | |
44 | ||
45 | RETURN | |
46 | ||
47 | QQ_SPLICE_UNQUOTE: | |
48 | REM push A% on the stack | |
49 | ZL%=ZL%+1: ZZ%(ZL%)=A% | |
50 | REM rest of cases call quasiquote on ast[1..] | |
51 | A%=Z%(A%,1): GOSUB QUASIQUOTE: T6%=R% | |
52 | REM pop A% off the stack | |
53 | A%=ZZ%(ZL%): ZL%=ZL%-1 | |
54 | ||
55 | REM set A% to ast[0] for last two cases | |
56 | A%=A%+1: GOSUB DEREF_A | |
57 | ||
58 | B%=A%: GOSUB PAIR_Q | |
59 | IF R%=0 THEN GOTO QQ_DEFAULT | |
60 | B%=A%+1: GOSUB DEREF_B | |
61 | IF (Z%(B%,0)AND15)<>5 THEN GOTO QQ_DEFAULT | |
62 | IF ZS$(Z%(B%,1))<>"splice-unquote" THEN QQ_DEFAULT | |
63 | REM ['concat, ast[0][1], quasiquote(ast[1..])] | |
64 | ||
65 | B%=Z%(A%,1)+1: GOSUB DEREF_B: B2%=B% | |
66 | AS$="concat": T%=5: GOSUB STRING: B3%=R% | |
67 | B1%=T6%: GOSUB LIST3 | |
68 | REM release inner quasiquoted since outer list takes ownership | |
69 | AY%=B1%: GOSUB RELEASE | |
70 | RETURN | |
71 | ||
72 | QQ_DEFAULT: | |
73 | REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] | |
74 | ||
75 | REM push T6% on the stack | |
76 | ZL%=ZL%+1: ZZ%(ZL%)=T6% | |
77 | REM A% set above to ast[0] | |
78 | GOSUB QUASIQUOTE: B2%=R% | |
79 | REM pop T6% off the stack | |
80 | T6%=ZZ%(ZL%): ZL%=ZL%-1 | |
81 | ||
82 | AS$="cons": T%=5: GOSUB STRING: B3%=R% | |
83 | B1%=T6%: GOSUB LIST3 | |
84 | REM release inner quasiquoted since outer list takes ownership | |
85 | AY%=B1%: GOSUB RELEASE: AY%=B2%: GOSUB RELEASE | |
86 | RETURN | |
87 | ||
88 | ||
89 | REM EVAL_AST(A%, E%) -> R% | |
90 | REM called using GOTO to avoid basic return address stack usage | |
91 | REM top of stack should have return label index | |
92 | EVAL_AST: | |
93 | REM push A% and E% on the stack | |
94 | ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A% | |
95 | ||
96 | IF ER%<>0 THEN GOTO EVAL_AST_RETURN | |
97 | ||
98 | GOSUB DEREF_A | |
99 | ||
100 | T%=Z%(A%,0)AND15 | |
101 | IF T%=5 THEN EVAL_AST_SYMBOL | |
102 | IF T%=6 THEN EVAL_AST_SEQ | |
103 | IF T%=7 THEN EVAL_AST_SEQ | |
104 | IF T%=8 THEN EVAL_AST_SEQ | |
105 | ||
106 | REM scalar: deref to actual value and inc ref cnt | |
107 | R%=A%: GOSUB DEREF_R | |
108 | Z%(R%,0)=Z%(R%,0)+16 | |
109 | GOTO EVAL_AST_RETURN | |
110 | ||
111 | EVAL_AST_SYMBOL: | |
112 | K%=A%: GOSUB ENV_GET | |
113 | GOTO EVAL_AST_RETURN | |
114 | ||
115 | EVAL_AST_SEQ: | |
116 | REM allocate the first entry | |
117 | SZ%=2: GOSUB ALLOC | |
118 | ||
119 | REM make space on the stack | |
120 | ZL%=ZL%+4 | |
121 | REM push type of sequence | |
122 | ZZ%(ZL%-3)=T% | |
123 | REM push sequence index | |
124 | ZZ%(ZL%-2)=-1 | |
125 | REM push future return value (new sequence) | |
126 | ZZ%(ZL%-1)=R% | |
127 | REM push previous new sequence entry | |
128 | ZZ%(ZL%)=R% | |
129 | ||
130 | EVAL_AST_SEQ_LOOP: | |
131 | REM set new sequence entry type (with 1 ref cnt) | |
132 | Z%(R%,0)=ZZ%(ZL%-3)+16 | |
133 | Z%(R%,1)=0 | |
134 | REM create value ptr placeholder | |
135 | Z%(R%+1,0)=14 | |
136 | Z%(R%+1,1)=0 | |
137 | ||
138 | REM update index | |
139 | ZZ%(ZL%-2)=ZZ%(ZL%-2)+1 | |
140 | ||
141 | REM check if we are done evaluating the source sequence | |
142 | IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE | |
143 | ||
144 | REM if hashmap, skip eval of even entries (keys) | |
145 | IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF | |
146 | GOTO EVAL_AST_DO_EVAL | |
147 | ||
148 | EVAL_AST_DO_REF: | |
149 | R%=A%+1: GOSUB DEREF_R: REM deref to target of referred entry | |
150 | Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value | |
151 | GOTO EVAL_AST_ADD_VALUE | |
152 | ||
153 | EVAL_AST_DO_EVAL: | |
154 | REM call EVAL for each entry | |
155 | A%=A%+1: GOSUB EVAL | |
156 | A%=A%-1 | |
157 | GOSUB DEREF_R: REM deref to target of evaluated entry | |
158 | ||
159 | EVAL_AST_ADD_VALUE: | |
160 | ||
161 | REM update previous value pointer to evaluated entry | |
162 | Z%(ZZ%(ZL%)+1,1)=R% | |
163 | ||
164 | IF ER%<>0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE | |
165 | ||
166 | REM allocate the next entry | |
167 | SZ%=2: GOSUB ALLOC | |
168 | ||
169 | REM update previous sequence entry value to point to new entry | |
170 | Z%(ZZ%(ZL%),1)=R% | |
171 | REM update previous ptr to current entry | |
172 | ZZ%(ZL%)=R% | |
173 | ||
174 | REM process the next sequence entry from source list | |
175 | A%=Z%(A%,1) | |
176 | ||
177 | GOTO EVAL_AST_SEQ_LOOP | |
178 | EVAL_AST_SEQ_LOOP_DONE: | |
179 | REM if no error, get return value (new seq) | |
180 | IF ER%=0 THEN R%=ZZ%(ZL%-1) | |
181 | REM otherwise, free the return value and return nil | |
182 | IF ER%<>0 THEN R%=0: AY%=ZZ%(ZL%-1): GOSUB RELEASE | |
183 | ||
184 | REM pop previous, return, index and type | |
185 | ZL%=ZL%-4 | |
186 | GOTO EVAL_AST_RETURN | |
187 | ||
188 | EVAL_AST_RETURN: | |
189 | REM pop A% and E% off the stack | |
190 | E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 | |
191 | ||
192 | REM pop EVAL AST return label/address | |
193 | RN%=ZZ%(ZL%): ZL%=ZL%-1 | |
194 | IF RN%=1 GOTO EVAL_AST_RETURN_1 | |
195 | IF RN%=2 GOTO EVAL_AST_RETURN_2 | |
196 | IF RN%=3 GOTO EVAL_AST_RETURN_3 | |
197 | RETURN | |
198 | ||
199 | REM EVAL(A%, E%)) -> R% | |
200 | EVAL: | |
201 | LV%=LV%+1: REM track basic return stack level | |
202 | ||
203 | REM push A% and E% on the stack | |
204 | ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A% | |
205 | ||
206 | EVAL_TCO_RECUR: | |
207 | ||
208 | REM AZ%=A%: GOSUB PR_STR | |
209 | REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%) | |
210 | ||
211 | GOSUB DEREF_A | |
212 | ||
213 | GOSUB LIST_Q | |
214 | IF R% THEN GOTO APPLY_LIST | |
215 | REM ELSE | |
216 | REM push EVAL_AST return label/address | |
217 | ZL%=ZL%+1: ZZ%(ZL%)=1 | |
218 | GOTO EVAL_AST | |
219 | EVAL_AST_RETURN_1: | |
220 | ||
221 | GOTO EVAL_RETURN | |
222 | ||
223 | APPLY_LIST: | |
224 | GOSUB EMPTY_Q | |
225 | IF R% THEN R%=A%: Z%(R%,0)=Z%(R%,0)+16: GOTO EVAL_RETURN | |
226 | ||
227 | A0%=A%+1 | |
228 | R%=A0%: GOSUB DEREF_R: A0%=R% | |
229 | ||
230 | REM get symbol in A$ | |
231 | IF (Z%(A0%,0)AND15)<>5 THEN A$="" | |
232 | IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1)) | |
233 | ||
234 | IF A$="def!" THEN GOTO EVAL_DEF | |
235 | IF A$="let*" THEN GOTO EVAL_LET | |
236 | IF A$="quote" THEN GOTO EVAL_QUOTE | |
237 | IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE | |
238 | IF A$="do" THEN GOTO EVAL_DO | |
239 | IF A$="if" THEN GOTO EVAL_IF | |
240 | IF A$="fn*" THEN GOTO EVAL_FN | |
241 | GOTO EVAL_INVOKE | |
242 | ||
243 | EVAL_GET_A3: | |
244 | A3%=Z%(Z%(Z%(A%,1),1),1)+1 | |
245 | R%=A3%: GOSUB DEREF_R: A3%=R% | |
246 | EVAL_GET_A2: | |
247 | A2%=Z%(Z%(A%,1),1)+1 | |
248 | R%=A2%: GOSUB DEREF_R: A2%=R% | |
249 | EVAL_GET_A1: | |
250 | A1%=Z%(A%,1)+1 | |
251 | R%=A1%: GOSUB DEREF_R: A1%=R% | |
252 | RETURN | |
253 | ||
254 | EVAL_DEF: | |
255 | REM PRINT "def!" | |
256 | GOSUB EVAL_GET_A2: REM set a1% and a2% | |
257 | ||
258 | ZL%=ZL%+1: ZZ%(ZL%)=A1%: REM push A1% | |
259 | A%=A2%: GOSUB EVAL: REM eval a2 | |
260 | A1%=ZZ%(ZL%): ZL%=ZL%-1: REM pop A1% | |
261 | ||
262 | REM set a1 in env to a2 | |
263 | K%=A1%: V%=R%: GOSUB ENV_SET | |
264 | GOTO EVAL_RETURN | |
265 | ||
266 | EVAL_LET: | |
267 | REM PRINT "let*" | |
268 | GOSUB EVAL_GET_A2: REM set a1% and a2% | |
269 | ||
270 | E4%=E%: REM save the current environment for release | |
271 | ||
272 | REM create new environment with outer as current environment | |
273 | EO%=E%: GOSUB ENV_NEW | |
274 | E%=R% | |
275 | EVAL_LET_LOOP: | |
276 | IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE | |
277 | ||
278 | REM push A1% | |
279 | ZL%=ZL%+1: ZZ%(ZL%)=A1% | |
280 | REM eval current A1 odd element | |
281 | A%=Z%(A1%,1)+1: GOSUB EVAL | |
282 | REM pop A1% | |
283 | A1%=ZZ%(ZL%): ZL%=ZL%-1 | |
284 | ||
285 | REM set environment: even A1% key to odd A1% eval'd above | |
286 | K%=A1%+1: V%=R%: GOSUB ENV_SET | |
287 | AY%=R%: GOSUB RELEASE: REM release our use, ENV_SET took ownership | |
288 | ||
289 | REM skip to the next pair of A1% elements | |
290 | A1%=Z%(Z%(A1%,1),1) | |
291 | GOTO EVAL_LET_LOOP | |
292 | EVAL_LET_LOOP_DONE: | |
293 | REM release previous env (if not root repl_env) because our | |
294 | REM new env refers to it and we no longer need to track it | |
295 | REM (since we are TCO recurring) | |
296 | IF E4%<>RE% THEN AY%=E4%: GOSUB RELEASE | |
297 | ||
298 | A%=A2%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
299 | ||
300 | EVAL_DO: | |
301 | A%=Z%(A%,1): REM rest | |
302 | ||
303 | REM TODO: TCO | |
304 | ||
305 | REM push EVAL_AST return label/address | |
306 | ZL%=ZL%+1: ZZ%(ZL%)=2 | |
307 | GOTO EVAL_AST | |
308 | EVAL_AST_RETURN_2: | |
309 | ||
310 | ZL%=ZL%+1: ZZ%(ZL%)=R%: REM push eval'd list | |
311 | A%=R%: GOSUB LAST: REM return the last element | |
312 | AY%=ZZ%(ZL%): ZL%=ZL%-1: REM pop eval'd list | |
313 | GOSUB RELEASE: REM release the eval'd list | |
314 | GOTO EVAL_RETURN | |
315 | ||
316 | EVAL_QUOTE: | |
317 | R%=Z%(A%,1)+1: GOSUB DEREF_R | |
318 | Z%(R%,0)=Z%(R%,0)+16 | |
319 | GOTO EVAL_RETURN | |
320 | ||
321 | EVAL_QUASIQUOTE: | |
322 | R%=Z%(A%,1)+1: GOSUB DEREF_R | |
323 | A%=R%: GOSUB QUASIQUOTE | |
324 | REM add quasiquote result to pending release queue to free when | |
325 | REM next lower EVAL level returns (LV%) | |
326 | ZM%=ZM%+1: ZR%(ZM%,0)=R%: ZR%(ZM%,1)=LV% | |
327 | ||
328 | A%=R%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
329 | ||
330 | EVAL_IF: | |
331 | GOSUB EVAL_GET_A1: REM set a1% | |
332 | REM push A% | |
333 | ZL%=ZL%+1: ZZ%(ZL%)=A% | |
334 | A%=A1%: GOSUB EVAL | |
335 | REM pop A% | |
336 | A%=ZZ%(ZL%): ZL%=ZL%-1 | |
337 | IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE | |
338 | ||
339 | EVAL_IF_TRUE: | |
340 | AY%=R%: GOSUB RELEASE | |
341 | GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL | |
342 | A%=A2%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
343 | EVAL_IF_FALSE: | |
344 | AY%=R%: GOSUB RELEASE | |
345 | REM if no false case (A3%), return nil | |
346 | IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0: GOTO EVAL_RETURN | |
347 | GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL | |
348 | A%=A3%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
349 | ||
350 | EVAL_FN: | |
351 | GOSUB EVAL_GET_A2: REM set a1% and a2% | |
352 | A%=A2%: P%=A1%: GOSUB MAL_FUNCTION | |
353 | GOTO EVAL_RETURN | |
354 | ||
355 | EVAL_INVOKE: | |
356 | REM push EVAL_AST return label/address | |
357 | ZL%=ZL%+1: ZZ%(ZL%)=3 | |
358 | GOTO EVAL_AST | |
359 | EVAL_AST_RETURN_3: | |
360 | ||
361 | REM if error, return f/args for release by caller | |
362 | IF ER%<>0 THEN GOTO EVAL_RETURN | |
363 | ||
364 | REM push f/args for release after call | |
365 | ZL%=ZL%+1: ZZ%(ZL%)=R% | |
366 | ||
367 | F%=R%+1 | |
368 | ||
369 | AR%=Z%(R%,1): REM rest | |
370 | R%=F%: GOSUB DEREF_R: F%=R% | |
371 | ||
372 | IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION | |
373 | IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION | |
374 | ||
375 | REM if error, pop and return f/args for release by caller | |
376 | R%=ZZ%(ZL%): ZL%=ZL%-1 | |
377 | ER%=1: ER$="apply of non-function": GOTO EVAL_RETURN | |
378 | ||
379 | EVAL_DO_FUNCTION: | |
380 | GOSUB DO_FUNCTION | |
381 | ||
382 | REM pop and release f/args | |
383 | AY%=ZZ%(ZL%): ZL%=ZL%-1: GOSUB RELEASE | |
384 | GOTO EVAL_RETURN | |
385 | ||
386 | EVAL_DO_MAL_FUNCTION: | |
387 | E4%=E%: REM save the current environment for release | |
388 | ||
389 | REM create new environ using env stored with function | |
390 | EO%=Z%(F%+1,1): BI%=Z%(F%+1,0): EX%=AR%: GOSUB ENV_NEW_BINDS | |
391 | ||
392 | REM release previous env if it is not the top one on the | |
393 | REM stack (ZZ%(ZL%-2)) because our new env refers to it and | |
394 | REM we no longer need to track it (since we are TCO recurring) | |
395 | IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%: GOSUB RELEASE | |
396 | ||
397 | REM claim the AST before releasing the list containing it | |
398 | A%=Z%(F%,1): Z%(A%,0)=Z%(A%,0)+16 | |
399 | REM add AST to pending release queue to free as soon as EVAL | |
400 | REM actually returns (LV%+1) | |
401 | ZM%=ZM%+1: ZR%(ZM%,0)=A%: ZR%(ZM%,1)=LV%+1 | |
402 | ||
403 | REM pop and release f/args | |
404 | AY%=ZZ%(ZL%): ZL%=ZL%-1: GOSUB RELEASE | |
405 | ||
406 | REM A% set above | |
407 | E%=R%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
408 | ||
409 | EVAL_RETURN: | |
410 | REM AZ%=R%: PR%=1: GOSUB PR_STR | |
411 | REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%) | |
412 | ||
413 | REM release environment if not the top one on the stack | |
414 | IF E%<>ZZ%(ZL%-1) THEN AY%=E%: GOSUB RELEASE | |
415 | ||
416 | LV%=LV%-1: REM track basic return stack level | |
417 | ||
418 | REM release everything we couldn't release earlier | |
419 | GOSUB RELEASE_PEND | |
420 | ||
421 | REM trigger GC | |
422 | TA%=FRE(0) | |
423 | ||
424 | REM pop A% and E% off the stack | |
425 | E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 | |
426 | ||
427 | RETURN | |
428 | ||
429 | REM PRINT(A%) -> R$ | |
430 | MAL_PRINT: | |
431 | AZ%=A%: PR%=1: GOSUB PR_STR | |
432 | RETURN | |
433 | ||
434 | REM RE(A$) -> R% | |
435 | REM Assume RE% has repl_env | |
436 | REM caller must release result | |
437 | RE: | |
438 | R1%=0 | |
439 | GOSUB MAL_READ | |
440 | R1%=R% | |
441 | IF ER%<>0 THEN GOTO REP_DONE | |
442 | ||
443 | A%=R%: E%=RE%: GOSUB EVAL | |
444 | ||
445 | REP_DONE: | |
446 | REM Release memory from MAL_READ | |
447 | IF R1%<>0 THEN AY%=R1%: GOSUB RELEASE | |
448 | RETURN: REM caller must release result of EVAL | |
449 | ||
450 | REM REP(A$) -> R$ | |
451 | REM Assume RE% has repl_env | |
452 | REP: | |
453 | R1%=0: R2%=0 | |
454 | GOSUB MAL_READ | |
455 | R1%=R% | |
456 | IF ER%<>0 THEN GOTO REP_DONE | |
457 | ||
458 | A%=R%: E%=RE%: GOSUB EVAL | |
459 | R2%=R% | |
460 | IF ER%<>0 THEN GOTO REP_DONE | |
461 | ||
462 | A%=R%: GOSUB MAL_PRINT | |
463 | RT$=R$ | |
464 | ||
465 | REP_DONE: | |
466 | REM Release memory from MAL_READ and EVAL | |
467 | IF R2%<>0 THEN AY%=R2%: GOSUB RELEASE | |
468 | IF R1%<>0 THEN AY%=R1%: GOSUB RELEASE | |
469 | R$=RT$ | |
470 | RETURN | |
471 | ||
472 | REM MAIN program | |
473 | MAIN: | |
474 | GOSUB INIT_MEMORY | |
475 | ||
476 | LV%=0 | |
477 | ||
478 | REM create repl_env | |
479 | EO%=-1: GOSUB ENV_NEW: RE%=R% | |
480 | ||
481 | REM core.EXT: defined in Basic | |
482 | E%=RE%: GOSUB INIT_CORE_NS: REM set core functions in repl_env | |
483 | ||
484 | ZT%=ZI%: REM top of memory after base repl_env | |
485 | ||
486 | REM core.mal: defined using the language itself | |
487 | A$="(def! not (fn* (a) (if a false true)))": GOSUB RE: AY%=R%: GOSUB RELEASE | |
488 | ||
489 | A$="(def! load-file (fn* (f) (eval (read-string (str " | |
490 | A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) " | |
491 | A$=A$+CHR$(34)+")"+CHR$(34)+")))))" | |
492 | GOSUB RE: AY%=R%: GOSUB RELEASE | |
493 | ||
494 | REM load the args file | |
495 | A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))" | |
496 | GOSUB RE: AY%=R%: GOSUB RELEASE | |
497 | ||
498 | REM set the argument list | |
499 | A$="(def! *ARGV* (rest -*ARGS*-))": GOSUB RE: AY%=R%: GOSUB RELEASE | |
500 | ||
501 | REM get the first argument | |
502 | A$="(first -*ARGS*-)": GOSUB RE | |
503 | ||
504 | REM if there is an argument, then run it as a program | |
505 | IF R%<>0 THEN AY%=R%: GOSUB RELEASE: GOTO RUN_PROG | |
506 | REM no arguments, start REPL loop | |
507 | IF R%=0 THEN GOTO REPL_LOOP | |
508 | ||
509 | RUN_PROG: | |
510 | REM run a single mal program and exit | |
511 | A$="(load-file (first -*ARGS*-))": GOSUB RE | |
512 | IF ER%<>0 THEN GOSUB PRINT_ERROR | |
513 | END | |
514 | ||
515 | REPL_LOOP: | |
516 | A$="user> ": GOSUB READLINE: REM call input parser | |
517 | IF EOF=1 THEN GOTO QUIT | |
518 | ||
519 | A$=R$: GOSUB REP: REM call REP | |
520 | ||
521 | IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO REPL_LOOP | |
522 | PRINT R$ | |
523 | GOTO REPL_LOOP | |
524 | ||
525 | QUIT: | |
526 | REM P1%=ZT%: P2%=-1: GOSUB PR_MEMORY | |
527 | GOSUB PR_MEMORY_SUMMARY | |
528 | END | |
529 | ||
530 | PRINT_ERROR: | |
531 | PRINT "Error: "+ER$ | |
532 | ER%=0: ER$="" | |
533 | RETURN | |
534 |