ada.2: typo
[jackhill/mal.git] / impls / jq / stepA_mal.jq
CommitLineData
b103f95e
A
1include "reader";
2include "printer";
3include "utils";
4include "interp";
5include "env";
6include "core";
7
8def read_line:
9 . as $in
10 | label $top
11 | _readline;
12
13def READ:
14 read_str | read_form | .value;
15
16def recurseflip(x; y):
17 recurse(y; x);
18
19def TCOWrap(env; retenv; continue):
20 {
21 ast: .,
22 env: env,
fed3ca50 23 ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end),
b103f95e
A
24 finish: (continue | not),
25 cont: true # set inside
26 };
27
28def _symbol(name):
29 {
30 kind: "symbol",
31 value: name
32 };
33
34def _symbol_v(name):
35 if .kind == "symbol" then
36 .value == name
37 else
38 false
39 end;
40
41def quasiquote:
42 if isPair then
43 .value as $value | null |
44 if ($value[0] | _symbol_v("unquote")) then
45 $value[1]
46 else
47 if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then
48 [_symbol("concat")] +
49 [$value[0].value[1]] +
50 [($value[1:] | wrap("list") | quasiquote)] | wrap("list")
51 else
52 [_symbol("cons")] +
53 [($value[0] | quasiquote)] +
54 [($value[1:] | wrap("list") | quasiquote)] | wrap("list")
55 end
56 end
57 else
58 [_symbol("quote")] +
59 [.] | wrap("list")
60 end;
61
62def set_macro_function:
63 if .kind != "function" then
64 jqmal_error("expected a function to be defined by defmacro!")
65 else
66 .is_macro |= true
67 end;
68
69def is_macro_call(env):
70 if .kind != "list" then
71 false
72 else
73 if (.value|first.kind == "symbol") then
74 env_req(env; .value|first.value)
75 | if .kind != "function" then
76 false
77 else
78 .is_macro
79 end
80 else
81 false
82 end
83 end;
84
85def EVAL(env):
86 def _eval_here:
87 .env as $env | .expr | EVAL($env);
88
89 def _interpret($_menv):
90 reduce .value[] as $elem (
fed3ca50
A
91 {env: $_menv, val: []};
92 . as $dot | $elem | EVAL($dot.env) as $eval_env |
93 ($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv |
94 {env: $_menv, val: ($dot.val + [$eval_env.expr])}
95 ) | . as $expr | $expr.val | first |
96 interpret($expr.val[1:]; $expr.env; _eval_here);
b103f95e
A
97
98 def macroexpand(env):
832abfbd
A
99 . as $dot |
100 $dot |
b103f95e 101 [ while(is_macro_call(env | unwrapCurrentEnv);
832abfbd
A
102 . as $dot
103 | ($dot.value[0] | EVAL(env).expr) as $fn
104 | $dot.value[1:] as $args
105 | $fn
106 | interpret($args; env; _eval_here).expr) // . ]
107 | last
b103f95e 108 | if is_macro_call(env | unwrapCurrentEnv) then
832abfbd
A
109 . as $dot
110 | ($dot.value[0] | EVAL(env).expr) as $fn
111 | $dot.value[1:] as $args
112 | $fn
113 | interpret($args; env; _eval_here).expr
b103f95e
A
114 else
115 .
832abfbd
A
116 end
117 ;
b103f95e
A
118
119 def hmap_with_env:
120 .env as $env | .list as $list |
121 if $list|length == 0 then
122 empty
123 else
124 $list[0] as $elem |
125 $list[1:] as $rest |
126 $elem.value.value | EVAL($env) as $resv |
127 {
128 value: {
129 key: $elem.key,
130 value: { kkind: $elem.value.kkind, value: $resv.expr }
131 },
132 env: env
133 },
134 ({env: $resv.env, list: $rest} | hmap_with_env)
135 end;
136 def map_with_env:
137 .env as $env | .list as $list |
138 if $list|length == 0 then
139 empty
140 else
141 $list[0] as $elem |
142 $list[1:] as $rest |
143 $elem | EVAL($env) as $resv |
144 { value: $resv.expr, env: env },
145 ({env: $resv.env, list: $rest} | map_with_env)
146 end;
147 def eval_ast(env):
148 (select(.kind == "vector") |
149 if .value|length == 0 then
150 {
151 kind: "vector",
152 value: []
153 }
154 else
155 [ { env: env, list: .value } | map_with_env ] as $res |
156 {
157 kind: "vector",
158 value: $res | map(.value)
159 }
160 end
161 ) //
162 (select(.kind == "hashmap") |
163 [ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
164 {
165 kind: "hashmap",
166 value: $res | map(.value) | from_entries
167 }
168 ) //
169 (select(.kind == "function") |
170 .# return this unchanged, since it can only be applied to
171 ) //
172 (select(.kind == "symbol") |
173 .value | env_get(env | unwrapCurrentEnv)
174 ) // .;
175
176 . as $ast
177 | { env: env, ast: ., cont: true, finish: false, ret_env: null }
178 | [ recurseflip(.cont;
179 .env as $_menv
180 | (if $DEBUG then _debug("EVAL: \($ast | pr_str($_menv))") else . end)
fed3ca50 181 | (if $DEBUG then _debug("ATOMS: \($_menv.atoms)") else . end)
b103f95e
A
182 | if .finish then
183 .cont |= false
184 else
185 (.ret_env//.env) as $_retenv
186 | .ret_env as $_orig_retenv
187 | .ast
188 | . as $init
189 | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
190 | $_menv | unwrapReplEnv as $replEnv # -
191 | $init
192 |
193 (select(.kind == "list") |
194 macroexpand($_menv) |
195 if .kind != "list" then
196 eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)
197 else
198 if .value | length == 0 then
199 . | TCOWrap($_menv; $_orig_retenv; false)
200 else
201 (
fed3ca50
A
202 (
203 .value | select(.[0].value == "atoms??") as $value |
204 $_menv.atoms | keys | map(wrap("string")) | wrap("list") | TCOWrap($_menv; $_orig_retenv; false)
205 ) //
b103f95e
A
206 (
207 .value | select(.[0].value == "def!") as $value |
208 ($value[2] | EVAL($_menv)) as $evval |
209 addToEnv($evval; $value[1].value) as $val |
210 $val.expr | TCOWrap($val.env; $_orig_retenv; false)
211 ) //
212 (
213 .value | select(.[0].value == "defmacro!") as $value |
214 ($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval |
215 addToEnv($evval; $value[1].value) as $val |
216 $val.expr | TCOWrap($val.env; $_orig_retenv; false)
217 ) //
218 (
219 .value | select(.[0].value == "let*") as $value |
2ce3c78e 220 ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv |
b103f95e 221 (reduce ($value[1].value | nwise(2)) as $xvalue (
fed3ca50 222 $_menv;
b103f95e
A
223 . as $env | $xvalue[1] | EVAL($env) as $expenv |
224 env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
225 | $value[2] | TCOWrap($env; $_retenv; true)
226 ) //
227 (
228 .value | select(.[0].value == "do") as $value |
229 (reduce ($value[1:][]) as $xvalue (
230 { env: $_menv, expr: {kind:"nil"} };
231 .env as $env | $xvalue | EVAL($env)
232 )) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
233 ) //
234 (
235 .value | select(.[0].value == "try*") as $value |
236 try (
237 $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false)
238 ) catch ( . as $exc |
239 if $value[2] then
240 if ($value[2].value[0] | _symbol_v("catch*")) then
241 (if ($exc | is_jqmal_error) then
242 $exc[19:] as $ex |
243 try (
244 $ex
245 | fromjson
246 ) catch (
247 $ex |
248 wrap("string")
249 )
250 else
251 $exc|wrap("string")
252 end) as $exc |
fed3ca50 253 $value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex |
b103f95e
A
254 $ex.expr | TCOWrap($ex.env; $_retenv; false)
255 else
256 error($exc)
257 end
258 else
259 error($exc)
260 end
261 )
262 ) //
263 (
264 .value | select(.[0].value == "if") as $value |
265 $value[1] | EVAL($_menv) as $condenv |
266 (if (["false", "nil"] | contains([$condenv.expr.kind])) then
267 ($value[3] // {kind:"nil"})
268 else
269 $value[2]
270 end) | TCOWrap($condenv.env; $_orig_retenv; true)
271 ) //
272 (
273 .value | select(.[0].value == "fn*") as $value |
b103f95e
A
274 # (fn* args body)
275 $value[1].value | map(.value) as $binds |
276 ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | {
277 kind: "function",
278 binds: $binds,
6b0d8c8d 279 env: ($_menv | env_remove_references($free_referencess)),
b103f95e 280 body: $value[2],
597522fa 281 names: [], # we can't do that circular reference thing
b103f95e
A
282 free_referencess: $free_referencess, # for dynamically scoped variables
283 is_macro: false
284 } | TCOWrap($_menv; $_orig_retenv; false)
285 ) //
286 (
287 .value | select(.[0].value == "quote") as $value |
288 $value[1] | TCOWrap($_menv; $_orig_retenv; false)
289 ) //
290 (
291 .value | select(.[0].value == "quasiquote") as $value |
292 $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
293 ) //
294 (
295 .value | select(.[0].value == "macroexpand") as $value |
832abfbd 296 $value[1] | macroexpand($_menv) | TCOWrap($_menv; $_orig_retenv; false)
b103f95e
A
297 ) //
298 (
299 . as $dot | _interpret($_menv) as $exprenv |
300 $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
301 ) //
302 TCOWrap($_menv; $_orig_retenv; false)
303 )
304 end
305 end
306 ) //
307 (eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false))
308 end
832abfbd 309 | (if $DEBUG then _debug("POSTEVAL: \($ast | pr_str($_menv)) = \(.ast | pr_str($_menv))") else . end)
b103f95e
A
310 ) ]
311 | last as $result
312 | ($result.ret_env // $result.env) as $env
313 | $result.ast
314 | addEnv($env);
315
316def PRINT(env):
317 pr_str(env);
318
319def rep(env):
320 READ | EVAL(env) as $expenv |
321 if $expenv.expr != null then
322 $expenv.expr | PRINT($expenv.env)
323 else
324 null
325 end | addEnv($expenv.env);
326
327def repl_(env):
328 ("user> " | _print) |
329 (read_line | rep(env));
330
331# we don't have no indirect functions, so we'll have to interpret the old way
332def replEnv:
333 {
334 parent: null,
335 environment: ({
336 "+": {
337 kind: "fn", # native function
338 inputs: 2,
339 function: "number_add"
340 },
341 "-": {
342 kind: "fn", # native function
343 inputs: 2,
344 function: "number_sub"
345 },
346 "*": {
347 kind: "fn", # native function
348 inputs: 2,
349 function: "number_mul"
350 },
351 "/": {
352 kind: "fn", # native function
353 inputs: 2,
354 function: "number_div"
355 },
356 "eval": {
357 kind: "fn",
358 inputs: 1,
359 function: "eval"
360 }
361 } + core_identify),
b103f95e
A
362 fallback: null
363 };
364
365def repl(env):
366 def xrepl:
367 (.env as $env | try repl_($env) catch addEnv($env)) as $expenv |
368 {
369 value: $expenv.expr,
370 stop: false,
371 env: ($expenv.env // .env)
372 } | ., xrepl;
83b974c5 373 {stop: false, env: env} | xrepl | if .value then (.value | _display) else empty end;
b103f95e
A
374
375def eval_ign(expr):
376 . as $env | expr | rep($env) | .env;
377
378def eval_val(expr):
379 . as $env | expr | rep($env) | .expr;
380
381def getEnv:
382 replEnv
fed3ca50 383 | wrapEnv({})
b103f95e
A
384 | eval_ign("(def! *host-language* \"jq\")")
385 | eval_ign("(def! not (fn* (a) (if a false true)))")
386 | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))")
387 | eval_ign("(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)))))))")
388 ;
389
390def main:
391 if $ARGS.positional|length > 0 then
392 try (
393 getEnv as $env |
394 env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
83b974c5
A
395 eval_val("(load-file \($ARGS.positional[0] | tojson))") |
396 ""
b103f95e
A
397 ) catch (
398 _print
399 )
400 else
401 repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
402 end;
403
597522fa 404[ main ] | _halt