Commit | Line | Data |
---|---|---|
e3ce370c 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 [ | |
e3ce370c 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 >> EVAL: aSexp env: anEnv [ | |
243c27c3 | 39 | | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args | |
e3ce370c VS |
40 | |
41 | "NOTE: redefinition of method arguments is not allowed" | |
42 | sexp := aSexp. | |
43 | env := anEnv. | |
44 | ||
45 | [ | |
46 | [ :continue | | |
58e44bbb | 47 | sexp type ~= #list ifTrue: [ |
e3ce370c VS |
48 | ^self evalAst: sexp env: env |
49 | ]. | |
50 | sexp value isEmpty ifTrue: [ | |
51 | ^sexp | |
52 | ]. | |
53 | ||
54 | ast := sexp value. | |
55 | a0 := ast first. | |
56 | ||
58e44bbb VS |
57 | a0_ := ast first value. |
58 | a0_ = #'def!' ifTrue: [ | |
59 | | result | | |
60 | a1_ := ast second value. | |
61 | a2 := ast third. | |
62 | result := self EVAL: a2 env: env. | |
63 | env set: a1_ value: result. | |
64 | ^result | |
65 | ]. | |
e3ce370c | 66 | |
58e44bbb VS |
67 | a0_ = #'let*' ifTrue: [ |
68 | | env_ | | |
69 | env_ := Env new: env. | |
70 | a1_ := ast second value. | |
71 | a2 := ast third. | |
72 | 1 to: a1_ size by: 2 do: | |
73 | [ :i | env_ set: (a1_ at: i) value | |
74 | value: (self EVAL: (a1_ at: i + 1) | |
75 | env: env_) ]. | |
76 | env := env_. | |
77 | sexp := a2. | |
78 | continue value "TCO" | |
79 | ]. | |
e3ce370c | 80 | |
58e44bbb VS |
81 | a0_ = #do ifTrue: [ |
82 | | forms last | | |
83 | ast size < 2 ifTrue: [ | |
84 | forms := {}. | |
85 | last := MALObject Nil. | |
86 | ] ifFalse: [ | |
87 | forms := ast copyFrom: 2 to: ast size - 1. | |
88 | last := ast last. | |
e3ce370c VS |
89 | ]. |
90 | ||
58e44bbb VS |
91 | forms do: [ :form | self EVAL: form env: env ]. |
92 | sexp := last. | |
93 | continue value "TCO" | |
94 | ]. | |
95 | ||
96 | a0_ = #if ifTrue: [ | |
97 | | condition | | |
98 | a1 := ast second. | |
99 | a2 := ast third. | |
100 | a3 := ast at: 4 ifAbsent: [ MALObject Nil ]. | |
101 | condition := self EVAL: a1 env: env. | |
102 | ||
103 | (condition type = #false or: | |
104 | [ condition type = #nil ]) ifTrue: [ | |
105 | sexp := a3 | |
106 | ] ifFalse: [ | |
107 | sexp := a2 | |
108 | ]. | |
109 | continue value "TCO" | |
110 | ]. | |
e3ce370c | 111 | |
58e44bbb VS |
112 | a0_ = #'fn*' ifTrue: [ |
113 | | binds env_ fn | | |
114 | a1_ := ast second value. | |
115 | binds := a1_ collect: [ :item | item value ]. | |
116 | a2 := ast third. | |
117 | fn := [ :args | | |
118 | self EVAL: a2 env: | |
119 | (Env new: env binds: binds exprs: args) ]. | |
120 | ^Func new: a2 params: binds env: env fn: fn | |
e3ce370c VS |
121 | ]. |
122 | ||
123 | forms := (self evalAst: sexp env: env) value. | |
124 | function := forms first. | |
125 | args := forms allButFirst asArray. | |
126 | ||
aee373f3 VS |
127 | function type = #fn ifTrue: [ ^function fn value: args ]. |
128 | function type = #func ifTrue: [ | |
e3ce370c VS |
129 | | env_ | |
130 | sexp := function ast. | |
131 | env_ := Env new: function env binds: function params | |
132 | exprs: args. | |
133 | env := env_. | |
134 | continue value "TCO" | |
135 | ] | |
136 | ] valueWithExit | |
137 | ] repeat. | |
138 | ] | |
139 | ||
140 | MAL class >> PRINT: sexp [ | |
141 | ^Printer prStr: sexp printReadably: true | |
142 | ] | |
143 | ||
144 | MAL class >> rep: input env: env [ | |
145 | ^self PRINT: (self EVAL: (self READ: input) env: env) | |
146 | ] | |
147 | ] | |
148 | ||
149 | | input historyFile replEnv argv | | |
150 | ||
151 | historyFile := '.mal_history'. | |
152 | ReadLine readHistory: historyFile. | |
153 | replEnv := Env new: nil. | |
154 | ||
155 | argv := Smalltalk arguments. | |
156 | argv notEmpty ifTrue: [ argv := argv allButFirst ]. | |
157 | argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]). | |
158 | ||
159 | Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ]. | |
aee373f3 | 160 | replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]). |
e3ce370c VS |
161 | replEnv set: #'*ARGV*' value: (MALList new: argv). |
162 | ||
163 | MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv. | |
164 | MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv. | |
165 | ||
166 | Smalltalk arguments notEmpty ifTrue: [ | |
167 | MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv | |
168 | ] ifFalse: [ | |
169 | [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [ | |
170 | input isEmpty ifFalse: [ | |
171 | ReadLine addHistory: input. | |
172 | ReadLine writeHistory: historyFile. | |
173 | [ (MAL rep: input env: replEnv) displayNl ] | |
174 | on: MALEmptyInput do: [ #return ] | |
175 | on: MALError do: | |
176 | [ :err | ('error: ', err messageText) displayNl. #return ]. | |
177 | ] | |
178 | ]. | |
179 | ||
180 | '' displayNl. | |
181 | ] |