Commit | Line | Data |
---|---|---|
d38ab263 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 [ | |
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: [ |
d38ab263 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 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 | | |
112 | sexp type ~= #list ifTrue: [ | |
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 | ||
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 | ]. | |
136 | ||
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 | ]. | |
146 | ||
147 | a0_ = #'macroexpand' ifTrue: [ | |
148 | a1 := ast second. | |
149 | ^self macroexpand: a1 env: env | |
150 | ]. | |
151 | ||
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 | ]. | |
165 | ||
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. | |
174 | ]. | |
175 | ||
176 | forms do: [ :form | self EVAL: form env: env ]. | |
177 | sexp := last. | |
178 | continue value "TCO" | |
179 | ]. | |
180 | ||
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 | ]. | |
196 | ||
197 | a0_ = #quote ifTrue: [ | |
198 | a1 := ast second. | |
199 | ^a1 | |
200 | ]. | |
201 | ||
202 | a0_ = #quasiquote ifTrue: [ | |
203 | | result | | |
204 | a1 := ast second. | |
205 | sexp := self quasiquote: a1. | |
206 | continue value "TCO" | |
207 | ]. | |
208 | ||
209 | a0_ = #'try*' ifTrue: [ | |
210 | | A B C | | |
211 | A := ast second. | |
212 | a2_ := ast third value. | |
213 | B := a2_ second value. | |
214 | C := a2_ third. | |
215 | ^[ self EVAL: A env: env ] on: MALError do: | |
216 | [ :err | | |
217 | | data env_ result | | |
218 | data := err data. | |
219 | data isString ifTrue: [ | |
220 | data := MALString new: data | |
221 | ]. | |
222 | env_ := Env new: env binds: {B} exprs: {data}. | |
223 | err return: (self EVAL: C env: env_) | |
224 | ] | |
225 | ]. | |
226 | ||
227 | a0_ = #'fn*' ifTrue: [ | |
228 | | binds env_ fn | | |
229 | a1_ := ast second value. | |
230 | binds := a1_ collect: [ :item | item value ]. | |
231 | a2 := ast third. | |
232 | fn := [ :args | | |
233 | self EVAL: a2 env: | |
234 | (Env new: env binds: binds exprs: args) ]. | |
235 | ^Func new: a2 params: binds env: env fn: fn | |
236 | ]. | |
237 | ||
238 | forms := (self evalAst: sexp env: env) value. | |
239 | function := forms first. | |
240 | args := forms allButFirst asArray. | |
241 | ||
aee373f3 VS |
242 | function type = #fn ifTrue: [ ^function fn value: args ]. |
243 | function type = #func ifTrue: [ | |
d38ab263 VS |
244 | | env_ | |
245 | sexp := function ast. | |
246 | env_ := Env new: function env binds: function params | |
247 | exprs: args. | |
248 | env := env_. | |
249 | continue value "TCO" | |
250 | ] | |
251 | ] valueWithExit | |
252 | ] repeat. | |
253 | ] | |
254 | ||
255 | MAL class >> PRINT: sexp [ | |
256 | ^Printer prStr: sexp printReadably: true | |
257 | ] | |
258 | ||
259 | MAL class >> rep: input env: env [ | |
260 | ^self PRINT: (self EVAL: (self READ: input) env: env) | |
261 | ] | |
262 | ] | |
263 | ||
264 | | input historyFile replEnv argv | | |
265 | ||
266 | historyFile := '.mal_history'. | |
267 | ReadLine readHistory: historyFile. | |
268 | replEnv := Env new: nil. | |
269 | ||
270 | argv := Smalltalk arguments. | |
271 | argv notEmpty ifTrue: [ argv := argv allButFirst ]. | |
272 | argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). | |
273 | ||
274 | Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. | |
aee373f3 | 275 | replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). |
d38ab263 VS |
276 | replEnv set: #'*ARGV*' value: (MALList new: argv). |
277 | ||
278 | MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. | |
279 | MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv. | |
280 | ||
281 | 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. | |
282 | 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. | |
283 | ||
284 | Smalltalk arguments notEmpty ifTrue: [ | |
285 | MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv | |
286 | ] ifFalse: [ | |
287 | [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ | |
288 | input isEmpty ifFalse: [ | |
289 | ReadLine addHistory: input. | |
290 | ReadLine writeHistory: historyFile. | |
291 | [ (MAL rep: input env: replEnv) displayNl ] | |
292 | on: MALEmptyInput do: [ #return ] | |
293 | on: MALError do: | |
294 | [ :err | ('error: ', err messageText) displayNl. #return ]. | |
295 | ] | |
296 | ]. | |
297 | ||
298 | '' displayNl. | |
299 | ] |