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