Commit | Line | Data |
---|---|---|
ae4600c7 VS |
1 | FileStream fileIn: 'readline.st'. |
2 | FileStream fileIn: 'reader.st'. | |
3 | FileStream fileIn: 'printer.st'. | |
4 | FileStream fileIn: 'env.st'. | |
5 | FileStream fileIn: 'func.st'. | |
6 | FileStream fileIn: 'core.st'. | |
7 | ||
8 | Object subclass: MAL [ | |
9 | MAL class >> READ: input [ | |
10 | ^Reader readStr: input | |
11 | ] | |
12 | ||
13 | MAL class >> evalAst: sexp env: env [ | |
ae4600c7 VS |
14 | sexp type = #symbol ifTrue: [ |
15 | ^env get: sexp value | |
16 | ]. | |
17 | ||
18 | sexp type = #list ifTrue: [ | |
19 | ^self evalList: sexp env: env class: MALList | |
20 | ]. | |
21 | sexp type = #vector ifTrue: [ | |
22 | ^self evalList: sexp env: env class: MALVector | |
23 | ]. | |
24 | sexp type = #map ifTrue: [ | |
25 | ^self evalList: sexp env: env class: MALMap | |
26 | ]. | |
27 | ||
28 | ^sexp | |
29 | ] | |
30 | ||
31 | MAL class >> evalList: sexp env: env class: aClass [ | |
32 | | items | | |
33 | items := sexp value collect: | |
34 | [ :item | self EVAL: item env: env ]. | |
35 | ^aClass new: items | |
36 | ] | |
37 | ||
38 | MAL class >> quasiquote: ast [ | |
39 | | result a a0 a0_ a0_0 a0_1 rest | | |
40 | ast isPair ifFalse: [ | |
41 | result := {MALSymbol new: #quote. ast}. | |
42 | ^MALList new: (OrderedCollection from: result) | |
43 | ]. | |
44 | ||
45 | a := ast value. | |
46 | a0 := a first. | |
47 | ||
48 | (a0 type = #symbol and: [ a0 value = #unquote ]) ifTrue: [ ^a second ]. | |
49 | ||
50 | a0 isPair ifTrue: [ | |
51 | a0_ := a0 value. | |
52 | a0_0 := a0_ first. | |
53 | a0_1 := a0_ second. | |
54 | ||
55 | (a0_0 type = #symbol and: | |
56 | [ a0_0 value = #'splice-unquote' ]) ifTrue: [ | |
57 | rest := MALList new: a allButFirst. | |
58 | result := {MALSymbol new: #concat. a0_1. | |
59 | self quasiquote: rest}. | |
60 | ^MALList new: (OrderedCollection from: result) | |
61 | ] | |
62 | ]. | |
63 | ||
64 | rest := MALList new: a allButFirst. | |
65 | result := {MALSymbol new: #cons. self quasiquote: a0. | |
66 | self quasiquote: rest}. | |
67 | ^MALList new: (OrderedCollection from: result) | |
68 | ] | |
69 | ||
70 | MAL class >> isMacroCall: ast env: env [ | |
71 | | a0 a0_ f | | |
72 | ast type = #list ifTrue: [ | |
73 | a0 := ast value first. | |
74 | a0_ := a0 value. | |
75 | a0 type = #symbol ifTrue: [ | |
76 | f := env find: a0_. | |
aee373f3 | 77 | (f notNil and: [ f type = #func ]) ifTrue: [ |
ae4600c7 VS |
78 | ^f isMacro |
79 | ] | |
80 | ] | |
81 | ]. | |
82 | ^false | |
83 | ] | |
84 | ||
85 | MAL class >> macroexpand: aSexp env: env [ | |
86 | | sexp | | |
87 | ||
88 | "NOTE: redefinition of method arguments is not allowed" | |
89 | sexp := aSexp. | |
90 | ||
91 | [ self isMacroCall: sexp env: env ] whileTrue: [ | |
92 | | ast a0_ macro rest | | |
93 | ast := sexp value. | |
94 | a0_ := ast first value. | |
95 | macro := env find: a0_. | |
96 | rest := ast allButFirst. | |
97 | sexp := macro fn value: rest. | |
98 | ]. | |
99 | ||
100 | ^sexp | |
101 | ] | |
102 | ||
103 | MAL class >> EVAL: aSexp env: anEnv [ | |
104 | | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | | |
105 | ||
106 | "NOTE: redefinition of method arguments is not allowed" | |
107 | sexp := aSexp. | |
108 | env := anEnv. | |
109 | ||
110 | [ | |
111 | [ :continue | | |
58e44bbb | 112 | sexp type ~= #list ifTrue: [ |
ae4600c7 VS |
113 | ^self evalAst: sexp env: env |
114 | ]. | |
115 | sexp value isEmpty ifTrue: [ | |
116 | ^sexp | |
117 | ]. | |
118 | ||
119 | sexp := self macroexpand: sexp env: env. | |
120 | sexp type ~= #list ifTrue: [ | |
121 | ^self evalAst: sexp env: env | |
122 | ]. | |
123 | ||
124 | ast := sexp value. | |
125 | a0 := ast first. | |
126 | ||
58e44bbb VS |
127 | a0_ := ast first value. |
128 | a0_ = #'def!' ifTrue: [ | |
129 | | result | | |
130 | a1_ := ast second value. | |
131 | a2 := ast third. | |
132 | result := self EVAL: a2 env: env. | |
133 | env set: a1_ value: result. | |
134 | ^result | |
135 | ]. | |
ae4600c7 | 136 | |
58e44bbb VS |
137 | a0_ = #'defmacro!' ifTrue: [ |
138 | | result | | |
139 | a1_ := ast second value. | |
140 | a2 := ast third. | |
141 | result := self EVAL: a2 env: env. | |
142 | result isMacro: true. | |
143 | env set: a1_ value: result. | |
144 | ^result | |
145 | ]. | |
ae4600c7 | 146 | |
58e44bbb VS |
147 | a0_ = #'macroexpand' ifTrue: [ |
148 | a1 := ast second. | |
149 | ^self macroexpand: a1 env: env | |
150 | ]. | |
ae4600c7 | 151 | |
58e44bbb VS |
152 | a0_ = #'let*' ifTrue: [ |
153 | | env_ | | |
154 | env_ := Env new: env. | |
155 | a1_ := ast second value. | |
156 | a2 := ast third. | |
157 | 1 to: a1_ size by: 2 do: | |
158 | [ :i | env_ set: (a1_ at: i) value | |
159 | value: (self EVAL: (a1_ at: i + 1) | |
160 | env: env_) ]. | |
161 | env := env_. | |
162 | sexp := a2. | |
163 | continue value "TCO" | |
164 | ]. | |
ae4600c7 | 165 | |
58e44bbb VS |
166 | a0_ = #do ifTrue: [ |
167 | | forms last | | |
168 | ast size < 2 ifTrue: [ | |
169 | forms := {}. | |
170 | last := MALObject Nil. | |
171 | ] ifFalse: [ | |
172 | forms := ast copyFrom: 2 to: ast size - 1. | |
173 | last := ast last. | |
ae4600c7 VS |
174 | ]. |
175 | ||
58e44bbb VS |
176 | forms do: [ :form | self EVAL: form env: env ]. |
177 | sexp := last. | |
178 | continue value "TCO" | |
179 | ]. | |
ae4600c7 | 180 | |
58e44bbb VS |
181 | a0_ = #if ifTrue: [ |
182 | | condition | | |
183 | a1 := ast second. | |
184 | a2 := ast third. | |
185 | a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. | |
186 | condition := self EVAL: a1 env: env. | |
187 | ||
188 | (condition type = #false or: | |
189 | [ condition type = #nil ]) ifTrue: [ | |
190 | sexp := a3 | |
191 | ] ifFalse: [ | |
192 | sexp := a2 | |
193 | ]. | |
194 | continue value "TCO" | |
195 | ]. | |
ae4600c7 | 196 | |
58e44bbb VS |
197 | a0_ = #quote ifTrue: [ |
198 | a1 := ast second. | |
199 | ^a1 | |
200 | ]. | |
ae4600c7 | 201 | |
58e44bbb VS |
202 | a0_ = #quasiquote ifTrue: [ |
203 | | result | | |
204 | a1 := ast second. | |
205 | sexp := self quasiquote: a1. | |
206 | continue value "TCO" | |
207 | ]. | |
208 | ||
209 | a0_ = #'fn*' ifTrue: [ | |
210 | | binds env_ fn | | |
211 | a1_ := ast second value. | |
212 | binds := a1_ collect: [ :item | item value ]. | |
213 | a2 := ast third. | |
214 | fn := [ :args | | |
215 | self EVAL: a2 env: | |
216 | (Env new: env binds: binds exprs: args) ]. | |
217 | ^Func new: a2 params: binds env: env fn: fn | |
ae4600c7 VS |
218 | ]. |
219 | ||
220 | forms := (self evalAst: sexp env: env) value. | |
221 | function := forms first. | |
222 | args := forms allButFirst asArray. | |
223 | ||
aee373f3 VS |
224 | function type = #fn ifTrue: [ ^function fn value: args ]. |
225 | function type = #func ifTrue: [ | |
ae4600c7 VS |
226 | | env_ | |
227 | sexp := function ast. | |
228 | env_ := Env new: function env binds: function params | |
229 | exprs: args. | |
230 | env := env_. | |
231 | continue value "TCO" | |
232 | ] | |
233 | ] valueWithExit | |
234 | ] repeat. | |
235 | ] | |
236 | ||
237 | MAL class >> PRINT: sexp [ | |
238 | ^Printer prStr: sexp printReadably: true | |
239 | ] | |
240 | ||
241 | MAL class >> rep: input env: env [ | |
242 | ^self PRINT: (self EVAL: (self READ: input) env: env) | |
243 | ] | |
244 | ] | |
245 | ||
246 | | input historyFile replEnv argv | | |
247 | ||
248 | historyFile := '.mal_history'. | |
249 | ReadLine readHistory: historyFile. | |
250 | replEnv := Env new: nil. | |
251 | ||
252 | argv := Smalltalk arguments. | |
253 | argv notEmpty ifTrue: [ argv := argv allButFirst ]. | |
254 | argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). | |
255 | ||
256 | Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. | |
aee373f3 | 257 | replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). |
ae4600c7 VS |
258 | replEnv set: #'*ARGV*' value: (MALList new: argv). |
259 | ||
260 | MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. | |
261 | MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv. | |
262 | ||
263 | MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv. | |
264 | MAL rep: '(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))' env: replEnv. | |
265 | ||
266 | Smalltalk arguments notEmpty ifTrue: [ | |
267 | MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv | |
268 | ] ifFalse: [ | |
269 | [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ | |
270 | input isEmpty ifFalse: [ | |
271 | ReadLine addHistory: input. | |
272 | ReadLine writeHistory: historyFile. | |
273 | [ (MAL rep: input env: replEnv) displayNl ] | |
274 | on: MALEmptyInput do: [ #return ] | |
275 | on: MALError do: | |
276 | [ :err | ('error: ', err messageText) displayNl. #return ]. | |
277 | ] | |
278 | ]. | |
279 | ||
280 | '' displayNl. | |
281 | ] |