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'.
9 MAL class >>
READ: input
[
10 ^Reader readStr: input
13 MAL class >>
evalAst: sexp
env: env
[
14 sexp type
= #symbol ifTrue: [
18 sexp type
= #list ifTrue: [
19 ^self evalList: sexp
env: env
class: MALList
21 sexp type
= #vector ifTrue: [
22 ^self evalList: sexp
env: env
class: MALVector
24 sexp type
= #map ifTrue: [
25 ^self evalList: sexp
env: env
class: MALMap
31 MAL class >>
evalList: sexp
env: env
class: aClass
[
33 items
:= sexp value
collect:
34 [ :item |
self EVAL: item
env: env
].
38 MAL class >>
quasiquote: ast
[
39 | result a a0 a0_ a0_0 a0_1 rest |
41 result
:= {MALSymbol new: #quote. ast
}.
42 ^MALList new: (OrderedCollection from: result
)
48 (a0 type
= #symbol and: [ a0 value
= #unquote ]) ifTrue: [ ^a second
].
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
)
64 rest
:= MALList new: a allButFirst
.
65 result
:= {MALSymbol new: #cons. self quasiquote: a0
.
66 self quasiquote: rest
}.
67 ^MALList new: (OrderedCollection from: result
)
70 MAL class >>
isMacroCall: ast
env: env
[
72 ast type
= #list ifTrue: [
73 a0
:= ast value first
.
75 a0 type
= #symbol ifTrue: [
77 (f notNil
and: [ f class
= Func ]) ifTrue: [
85 MAL class >>
macroexpand: aSexp
env: env
[
88 "NOTE: redefinition of method arguments is not allowed"
91 [ self isMacroCall: sexp
env: env
] whileTrue: [
92 | ast a0_ macro rest |
94 a0_
:= ast first value
.
95 macro
:= env
find: a0_
.
96 rest
:= ast allButFirst
.
97 sexp
:= macro fn
value: rest
.
103 MAL class >>
EVAL: aSexp
env: anEnv
[
104 | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 forms function args |
106 "NOTE: redefinition of method arguments is not allowed"
112 sexp type ~
= #list ifTrue: [
113 ^self evalAst: sexp
env: env
115 sexp value isEmpty
ifTrue: [
119 sexp
:= self macroexpand: sexp
env: env
.
120 sexp type ~
= #list ifTrue: [
121 ^self evalAst: sexp
env: env
127 a0_
:= ast first value
.
128 a0_
= #'def!' ifTrue: [
130 a1_
:= ast second value
.
132 result
:= self EVAL: a2
env: env
.
133 env
set: a1_
value: result
.
137 a0_
= #'defmacro!' ifTrue: [
139 a1_
:= ast second value
.
141 result
:= self EVAL: a2
env: env
.
142 result
isMacro: true.
143 env
set: a1_
value: result
.
147 a0_
= #'macroexpand' ifTrue: [
149 ^self macroexpand: a1
env: env
152 a0_
= #'let*' ifTrue: [
154 env_
:= Env new: env
.
155 a1_
:= ast second value
.
157 1 to: a1_ size
by: 2 do:
158 [ :i | env_
set: (a1_
at: i
) value
159 value: (self EVAL: (a1_
at: i
+ 1)
168 ast size <
2 ifTrue: [
170 last
:= MALObject Nil.
172 forms
:= ast
copyFrom: 2 to: ast size
- 1.
176 forms
do: [ :form |
self EVAL: form
env: env
].
185 a3
:= ast
at: 4 ifAbsent: [ MALObject Nil ].
186 condition
:= self EVAL: a1
env: env
.
188 (condition type
= #false or:
189 [ condition type
= #nil ]) ifTrue: [
197 a0_
= #quote ifTrue: [
202 a0_
= #quasiquote ifTrue: [
205 sexp
:= self quasiquote: a1
.
209 a0_
= #'try*' ifTrue: [
212 a2_
:= ast third value
.
213 B := a2_ second value
.
215 ^[ self EVAL: A env: env
] on: MALError do:
219 data isString
ifTrue: [
220 data
:= MALString new: data
222 env_
:= Env new: env
binds: {B} exprs: {data
}.
223 err
return: (self EVAL: C env: env_
)
227 a0_
= #'fn*' ifTrue: [
229 a1_
:= ast second value
.
230 binds
:= a1_
collect: [ :item | item value
].
234 (Env new: env
binds: binds
exprs: args
) ].
235 ^Func new: a2
params: binds
env: env
fn: fn
238 forms
:= (self evalAst: sexp
env: env
) value
.
239 function
:= forms first
.
240 args
:= forms allButFirst asArray
.
242 function class
= BlockClosure ifTrue: [ ^function
value: args
].
243 function class
= Func ifTrue: [
245 sexp
:= function ast
.
246 env_
:= Env new: function env
binds: function params
255 MAL class >>
PRINT: sexp
[
256 ^Printer prStr: sexp
printReadably: true
259 MAL class >>
rep: input
env: env
[
260 ^self PRINT: (self EVAL: (self READ: input
) env: env
)
264 | input historyFile replEnv argv |
266 historyFile
:= '.mal_history'.
267 ReadLine readHistory: historyFile
.
268 replEnv
:= Env new: nil.
270 argv
:= Smalltalk arguments
.
271 argv notEmpty
ifTrue: [ argv
:= argv allButFirst
].
272 argv
:= OrderedCollection from: (argv
collect: [ :arg |
MALString new: arg
]).
274 Core Ns keysAndValuesDo: [ :op :block | replEnv
set: op
value: block
].
275 replEnv
set: #eval value: [ :args |
MAL EVAL: args first
env: replEnv
].
276 replEnv
set: #'*ARGV*' value: (MALList new: argv
).
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
.
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
.
284 Smalltalk arguments notEmpty
ifTrue: [
285 MAL rep: '(load-file "',
Smalltalk arguments first,
'")' env: replEnv
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 ]
294 [ :err |
('error: ', err messageText
) displayNl
. #return ].