Commit | Line | Data |
---|---|---|
9da223a3 C |
1 | require reader.fs |
2 | require printer.fs | |
3 | ||
4 | : args-as-native { argv argc -- entry*argc... } | |
5 | argc 0 ?do | |
6 | argv i cells + @ as-native | |
7 | loop ; | |
8 | ||
975126be C |
9 | : env-assoc ( map sym-str-addr sym-str-len xt ) |
10 | -rot MalSymbol. swap MalNativeFn. rot assoc ; | |
11 | ||
9da223a3 | 12 | MalMap/Empty |
975126be C |
13 | s" +" :noname args-as-native + MalInt. ; env-assoc |
14 | s" -" :noname args-as-native - MalInt. ; env-assoc | |
15 | s" *" :noname args-as-native * MalInt. ; env-assoc | |
16 | s" /" :noname args-as-native / MalInt. ; env-assoc | |
17 | constant repl-env | |
9da223a3 | 18 | |
45c1894b C |
19 | : read read-str ; |
20 | : eval ( env obj ) mal-eval ; | |
21 | ||
22 | \ ." Type: " dup mal-type @ type-name safe-type cr | |
23 | pr-str ; | |
9da223a3 | 24 | |
45c1894b | 25 | MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself |
9da223a3 | 26 | |
69972a83 | 27 | MalKeyword |
45c1894b C |
28 | extend eval-invoke { env list kw -- val } |
29 | 0 kw env list MalList/start @ cell+ @ eval get | |
30 | ?dup 0= if | |
31 | \ compute not-found value | |
32 | list MalList/count @ 1 > if | |
33 | env list MalList/start @ 2 cells + @ eval | |
34 | else | |
35 | mal-nil | |
36 | endif | |
37 | endif ;; | |
69972a83 C |
38 | drop |
39 | ||
45c1894b C |
40 | \ eval all but the first item of list |
41 | : eval-rest { env list -- argv argc } | |
42 | list MalList/start @ cell+ { expr-start } | |
43 | list MalList/count @ 1- { argc } | |
44 | argc cells allocate throw { target } | |
45 | argc 0 ?do | |
46 | env expr-start i cells + @ eval | |
47 | target i cells + ! | |
48 | loop | |
49 | target argc ; | |
50 | ||
136ce7c9 | 51 | MalNativeFn |
45c1894b C |
52 | extend eval-invoke ( env list this -- list ) |
53 | MalNativeFn/xt @ { xt } | |
54 | eval-rest ( argv argc ) | |
55 | xt execute ( return-val ) ;; | |
69972a83 C |
56 | drop |
57 | ||
9da223a3 C |
58 | MalSymbol |
59 | extend mal-eval { env sym -- val } | |
60 | 0 sym env get | |
61 | dup 0= if | |
62 | drop | |
9e2a4ab0 | 63 | 0 0 s" ' not found" sym pr-str s" '" ...throw-str |
9da223a3 C |
64 | endif ;; |
65 | drop | |
66 | ||
45c1894b | 67 | : eval-ast { env list -- list } |
9da223a3 | 68 | here |
c05d35e8 C |
69 | list MalList/start @ { expr-start } |
70 | list MalList/count @ 0 ?do | |
45c1894b | 71 | env expr-start i cells + @ eval , |
9da223a3 | 72 | loop |
45c1894b C |
73 | here>MalList ; |
74 | ||
75 | MalList | |
76 | extend mal-eval { env list -- val } | |
efa2daef JM |
77 | list MalList/count @ 0= if |
78 | list | |
79 | else | |
80 | env list MalList/start @ @ eval | |
81 | env list rot eval-invoke | |
82 | endif ;; | |
9da223a3 C |
83 | drop |
84 | ||
85 | MalVector | |
86 | extend mal-eval ( env vector -- vector ) | |
45c1894b | 87 | MalVector/list @ eval-ast |
9da223a3 C |
88 | MalVector new swap over MalVector/list ! ;; |
89 | drop | |
90 | ||
91 | MalMap | |
92 | extend mal-eval ( env map -- map ) | |
45c1894b | 93 | MalMap/list @ eval-ast |
9da223a3 C |
94 | MalMap new swap over MalMap/list ! ;; |
95 | drop | |
96 | ||
45c1894b | 97 | : rep ( str-addr str-len -- str-addr str-len ) |
9da223a3 C |
98 | read |
99 | repl-env swap eval | |
100 | print ; | |
101 | ||
102 | create buff 128 allot | |
45c1894b | 103 | 77777777777 constant stack-leak-detect |
9da223a3 C |
104 | |
105 | : read-lines | |
106 | begin | |
107 | ." user> " | |
45c1894b | 108 | stack-leak-detect |
9da223a3 | 109 | buff 128 stdin read-line throw |
45c1894b | 110 | while ( num-bytes-read ) |
9e2a4ab0 JMC |
111 | dup 0 <> if |
112 | buff swap ( str-addr str-len ) | |
113 | ['] rep | |
114 | \ execute ['] nop \ uncomment to see stack traces | |
115 | catch ?dup 0= if | |
116 | safe-type cr | |
117 | stack-leak-detect <> if ." --stack leak--" cr endif | |
118 | else { errno } | |
119 | begin stack-leak-detect = until | |
120 | errno 1 <> if | |
121 | s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc | |
122 | to exception-object | |
123 | endif | |
124 | ." Uncaught exception: " | |
125 | exception-object pr-str safe-type cr | |
126 | endif | |
127 | endif | |
9da223a3 C |
128 | repeat ; |
129 | ||
130 | read-lines | |
131 | cr | |
132 | bye |