Commit | Line | Data |
---|---|---|
25bb14c9 JB |
1 | readline = require './node_readline' |
2 | {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' | |
3 | {read_str} = require './reader' | |
4 | {pr_str} = require './printer' | |
5 | {Env} = require './env' | |
6 | {runtime-error, ns} = require './core' | |
7 | {list-to-pairs} = require './utils' | |
8 | ||
9 | ||
10 | defer-tco = (env, ast) -> | |
11 | type: \tco | |
12 | env: env | |
13 | ast: ast | |
14 | eval: -> eval_ast env, ast | |
15 | ||
16 | ||
17 | is-thruthy = ({type, value}) -> | |
18 | type != \const or value not in [\nil \false] | |
19 | ||
20 | ||
21 | fmap-ast = (fn, {type, value}: ast) --> | |
22 | {type: type, value: fn value} | |
23 | ||
24 | ||
25 | eval_simple = (env, {type, value}: ast) -> | |
26 | switch type | |
27 | | \symbol => env.get value | |
28 | | \list, \vector => ast |> fmap-ast map eval_ast env | |
29 | | \map => ast |> fmap-ast Obj.map eval_ast env | |
30 | | otherwise => ast | |
31 | ||
32 | ||
33 | eval_ast = (env, {type, value}: ast) --> | |
34 | loop | |
35 | if type != \list | |
36 | return eval_simple env, ast | |
37 | else if value.length == 0 | |
38 | return ast | |
39 | ||
40 | result = if value[0].type == \symbol | |
41 | params = value[1 to] | |
42 | switch value[0].value | |
43 | | 'def!' => eval_def env, params | |
44 | | 'let*' => eval_let env, params | |
45 | | 'do' => eval_do env, params | |
46 | | 'if' => eval_if env, params | |
47 | | 'fn*' => eval_fn env, params | |
48 | | otherwise => eval_apply env, value | |
49 | else | |
50 | eval_apply env, value | |
51 | ||
52 | if result.type == \tco | |
53 | env = result.env | |
54 | {type, value}: ast = result.ast | |
55 | else | |
56 | return result | |
57 | ||
58 | ||
59 | check_params = (name, params, expected) -> | |
60 | if params.length != expected | |
61 | runtime-error "'#{name}' expected #{expected} parameters, | |
62 | got #{params.length}" | |
63 | ||
64 | ||
65 | eval_def = (env, params) -> | |
66 | check_params 'def!', params, 2 | |
67 | ||
68 | # Name is in the first parameter, and is not evaluated. | |
69 | name = params[0] | |
70 | if name.type != \symbol | |
71 | runtime-error "expected a symbol for the first parameter | |
72 | of def!, got a #{name.type}" | |
73 | ||
74 | # Evaluate the second parameter and store | |
75 | # it under name in the env. | |
76 | env.set name.value, (eval_ast env, params[1]) | |
77 | ||
78 | ||
79 | eval_let = (env, params) -> | |
80 | check_params 'let*', params, 2 | |
81 | ||
82 | binding_list = params[0] | |
83 | if binding_list.type not in [\list \vector] | |
84 | runtime-error "expected 1st parameter of 'let*' to | |
85 | be a binding list (or vector), | |
86 | got a #{binding_list.type}" | |
87 | else if binding_list.value.length % 2 != 0 | |
88 | runtime-error "binding list of 'let*' must have an even | |
89 | number of parameters" | |
90 | ||
91 | # Make a new environment with the | |
92 | # current environment as outer. | |
93 | let_env = new Env env | |
94 | ||
95 | # Evaluate all binding values in the | |
96 | # new environment. | |
97 | binding_list.value | |
98 | |> list-to-pairs | |
99 | |> each ([binding_name, binding_value]) -> | |
100 | if binding_name.type != \symbol | |
101 | runtime-error "expected a symbol as binding name, | |
102 | got a #{binding_name.type}" | |
103 | ||
104 | let_env.set binding_name.value, (eval_ast let_env, binding_value) | |
105 | ||
106 | # Defer evaluation of let* body with TCO. | |
107 | defer-tco let_env, params[1] | |
108 | ||
109 | ||
110 | eval_do = (env, params) -> | |
111 | if params.length == 0 | |
112 | runtime-error "'do' expected at least one parameter" | |
113 | ||
114 | [...rest, last-param] = params | |
115 | rest |> each eval_ast env | |
116 | defer-tco env, last-param | |
117 | ||
118 | ||
119 | eval_if = (env, params) -> | |
120 | if params.length < 2 | |
121 | runtime-error "'if' expected at least 2 parameters" | |
122 | else if params.length > 3 | |
123 | runtime-error "'if' expected at most 3 parameters" | |
124 | ||
125 | cond = eval_ast env, params[0] | |
126 | if is-thruthy cond | |
127 | defer-tco env, params[1] | |
128 | else if params.length > 2 | |
129 | defer-tco env, params[2] | |
130 | else | |
131 | {type: \const, value: \nil} | |
132 | ||
133 | ||
134 | eval_fn = (env, params) -> | |
135 | check_params 'fn*', params, 2 | |
136 | ||
137 | if params[0].type not in [\list \vector] | |
138 | runtime-error "'fn*' expected first parameter to be a list or vector." | |
139 | ||
140 | if not all (.type == \symbol), params[0].value | |
141 | runtime-error "'fn*' expected only symbols in the parameters list." | |
142 | ||
143 | binds = params[0].value |> map (.value) | |
144 | vargs = null | |
145 | ||
146 | # Parse variadic bind. | |
147 | if binds.length >= 2 | |
148 | [...rest, amper, name] = binds | |
149 | if amper == '&' and name != '&' | |
150 | binds = rest | |
151 | vargs = name | |
152 | ||
153 | if elem-index '&', binds | |
154 | runtime-error "'fn*' invalid usage of variadic parameters." | |
155 | ||
156 | if (unique binds).length != binds.length | |
157 | runtime-error "'fn*' duplicate symbols in parameters list." | |
158 | ||
159 | body = params[1] | |
160 | ||
161 | fn_instance = (...values) -> | |
162 | if not vargs and values.length != binds.length | |
163 | runtime-error "function expected #{binds.length} parameters, | |
164 | got #{values.length}" | |
165 | else if vargs and values.length < binds.length | |
166 | runtime-error "function expected at least | |
167 | #{binds.length} parameters, | |
168 | got #{values.length}" | |
169 | ||
170 | # Set binds to values in the new env. | |
171 | fn_env = new Env env | |
172 | ||
173 | for [name, value] in (zip binds, values) | |
174 | fn_env.set name, value | |
175 | ||
176 | if vargs | |
177 | fn_env.set vargs, do | |
178 | type: \list | |
179 | value: values.slice binds.length | |
180 | ||
181 | # Defer evaluation of the function body to TCO. | |
182 | defer-tco fn_env, body | |
183 | ||
184 | {type: \function, value: fn_instance} | |
185 | ||
186 | ||
187 | eval_apply = (env, list) -> | |
188 | [fn, ...args] = list |> map eval_ast env | |
189 | if fn.type != \function | |
dd7a4f55 | 190 | runtime-error "#{fn.value} is not a function, got a #{fn.type}" |
25bb14c9 JB |
191 | |
192 | fn.value.apply env, args | |
193 | ||
194 | ||
195 | repl_env = new Env | |
196 | for symbol, value of ns | |
197 | repl_env.set symbol, value | |
198 | ||
199 | # Evil eval. | |
200 | repl_env.set 'eval', do | |
201 | type: \function | |
202 | value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). | |
203 | ||
204 | ||
205 | rep = (line) -> | |
206 | line | |
207 | |> read_str | |
208 | |> eval_ast repl_env | |
209 | |> (ast) -> pr_str ast, print_readably=true | |
210 | ||
f4495e1e NB |
211 | |
212 | # Define not. | |
213 | rep '(def! not (fn* (x) (if x false true)))' | |
214 | ||
25bb14c9 JB |
215 | # Define load-file. |
216 | rep ' | |
217 | (def! load-file | |
218 | (fn* (f) | |
219 | (eval | |
220 | (read-string | |
221 | (str "(do " (slurp f) ")")))))' | |
222 | ||
223 | # Parse program arguments. | |
224 | # The first two (exe and core-file) are, respectively, | |
225 | # the interpreter executable (nodejs or lsc) and the | |
226 | # source file being executed (stepX_*.(ls|js)). | |
227 | [exe, core-file, mal-file, ...argv] = process.argv | |
228 | ||
229 | repl_env.set '*ARGV*', do | |
230 | type: \list | |
231 | value: argv |> map (arg) -> | |
232 | type: \string | |
233 | value: arg | |
234 | ||
235 | if mal-file | |
236 | rep "(load-file \"#{mal-file}\")" | |
237 | else | |
238 | # REPL. | |
239 | loop | |
240 | line = readline.readline 'user> ' | |
241 | break if not line? or line == '' | |
242 | try | |
243 | console.log rep line | |
dd7a4f55 JM |
244 | catch error |
245 | if error.message | |
246 | then console.error error.message | |
247 | else console.error "Error:", pr_str error, print_readably=true |