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 | |
63 | ." Symbol '" | |
a631063f | 64 | sym pr-str safe-type |
9da223a3 C |
65 | ." ' not found." cr |
66 | 1 throw | |
67 | endif ;; | |
68 | drop | |
69 | ||
45c1894b | 70 | : eval-ast { env list -- list } |
9da223a3 | 71 | here |
c05d35e8 C |
72 | list MalList/start @ { expr-start } |
73 | list MalList/count @ 0 ?do | |
45c1894b | 74 | env expr-start i cells + @ eval , |
9da223a3 | 75 | loop |
45c1894b C |
76 | here>MalList ; |
77 | ||
78 | MalList | |
79 | extend mal-eval { env list -- val } | |
80 | env list MalList/start @ @ eval | |
81 | env list rot eval-invoke ;; | |
9da223a3 C |
82 | drop |
83 | ||
84 | MalVector | |
85 | extend mal-eval ( env vector -- vector ) | |
45c1894b | 86 | MalVector/list @ eval-ast |
9da223a3 C |
87 | MalVector new swap over MalVector/list ! ;; |
88 | drop | |
89 | ||
90 | MalMap | |
91 | extend mal-eval ( env map -- map ) | |
45c1894b | 92 | MalMap/list @ eval-ast |
9da223a3 C |
93 | MalMap new swap over MalMap/list ! ;; |
94 | drop | |
95 | ||
45c1894b | 96 | : rep ( str-addr str-len -- str-addr str-len ) |
9da223a3 C |
97 | read |
98 | repl-env swap eval | |
99 | print ; | |
100 | ||
101 | create buff 128 allot | |
45c1894b | 102 | 77777777777 constant stack-leak-detect |
9da223a3 C |
103 | |
104 | : read-lines | |
105 | begin | |
106 | ." user> " | |
45c1894b | 107 | stack-leak-detect |
9da223a3 | 108 | buff 128 stdin read-line throw |
45c1894b C |
109 | while ( num-bytes-read ) |
110 | buff swap ( str-addr str-len ) | |
9da223a3 C |
111 | ['] rep |
112 | \ execute safe-type | |
45c1894b | 113 | catch ?dup 0= if safe-type else ." Caught error " . endif |
9da223a3 | 114 | cr |
45c1894b | 115 | stack-leak-detect <> if ." --stack leak--" cr endif |
9da223a3 C |
116 | repeat ; |
117 | ||
118 | read-lines | |
119 | cr | |
120 | bye |