jq/step9_try.jq

   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     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
  62 def 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
  69 def 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
  85 def EVAL(env):
  86     def _eval_here:
  87         .env as $env | .expr | EVAL($env);
  88
  89     def _interpret($_menv):
  90         reduce .value[] as $elem (
  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);
  97
  98     def macroexpand(env):
  99         . as $dot |
 100         $dot |
 101         [ while(is_macro_call(env | unwrapCurrentEnv);
 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
 108         | if is_macro_call(env | unwrapCurrentEnv) then
 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
 114           else
 115             .
 116           end
 117         ;
 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 .finish then
 181             .cont |= false
 182         else
 183             (.ret_env//.env) as  $_retenv
 184             | .ret_env as $_orig_retenv
 185             | .ast
 186             | . as $init
 187             | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
 188             | $_menv | unwrapReplEnv    as $replEnv    # -
 189             | $init
 190             |
 191             (select(.kind == "list") |
 192                 macroexpand($_menv) |
 193                 if .kind != "list" then
 194                     eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)
 195                 else
 196                     if .value | length == 0 then
 197                         . | TCOWrap($_menv; $_orig_retenv; false)
 198                     else
 199                         (
 200                             (
 201                                 .value | select(.[0].value == "def!") as $value |
 202                                     ($value[2] | EVAL($_menv)) as $evval |
 203                                         addToEnv($evval; $value[1].value) as $val |
 204                                         $val.expr | TCOWrap($val.env; $_orig_retenv; false)
 205                             ) //
 206                             (
 207                                 .value | select(.[0].value == "defmacro!") as $value |
 208                                     ($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) 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 == "let*") as $value |
 214                                         ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv |
 215                                         (reduce ($value[1].value | nwise(2)) as $xvalue (
 216                                             $_menv;
 217                                             . as $env | $xvalue[1] | EVAL($env) as $expenv |
 218                                                 env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
 219                                                     | $value[2] | TCOWrap($env; $_retenv; true)
 220                             ) //
 221                             (
 222                                 .value | select(.[0].value == "do") as $value |
 223                                     (reduce ($value[1:][]) as $xvalue (
 224                                         { env: $_menv, expr: {kind:"nil"} };
 225                                         .env as $env | $xvalue | EVAL($env)
 226                                     )) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
 227                             ) //
 228                             (
 229                                 .value | select(.[0].value == "try*") as $value |
 230                                     try (
 231                                         $value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false)
 232                                     ) catch ( . as $exc |
 233                                         if $value[2] then
 234                                             if ($value[2].value[0] | _symbol_v("catch*")) then
 235                                                 (if ($exc | is_jqmal_error) then
 236                                                     $exc[19:] as $ex |
 237                                                         try (
 238                                                             $ex
 239                                                             | fromjson
 240                                                         ) catch (
 241                                                             $ex |
 242                                                             wrap("string")
 243                                                         )
 244                                                 else
 245                                                     $exc|wrap("string")
 246                                                 end) as $exc |
 247                                                 $value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex |
 248                                                 $ex.expr | TCOWrap($ex.env; $_retenv; false)
 249                                             else
 250                                                 error($exc)
 251                                             end
 252                                         else
 253                                             error($exc)
 254                                         end
 255                                     )
 256                             ) //
 257                             (
 258                                 .value | select(.[0].value == "if") as $value |
 259                                     $value[1] | EVAL($_menv) as $condenv |
 260                                         (if (["false", "nil"] | contains([$condenv.expr.kind])) then
 261                                             ($value[3] // {kind:"nil"})
 262                                         else
 263                                             $value[2]
 264                                         end) | TCOWrap($condenv.env; $_orig_retenv; true)
 265                             ) //
 266                             (
 267                                 .value | select(.[0].value == "fn*") as $value |
 268                                     # (fn* args body)
 269                                     $value[1].value | map(.value) as $binds |
 270                                 ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | {
 271                                     kind: "function",
 272                                     binds: $binds,
 273                                     env: ($_menv | env_remove_references($free_referencess)),
 274                                     body: $value[2],
 275                                     names: [], # we can't do that circular reference thing
 276                                     free_referencess: $free_referencess,  # for dynamically scoped variables
 277                                     is_macro: false
 278                                 } | TCOWrap($_menv; $_orig_retenv; false)
 279                             ) //
 280                             (
 281                                 .value | select(.[0].value == "quote") as $value |
 282                                     $value[1] | TCOWrap($_menv; $_orig_retenv; false)
 283                             ) //
 284                             (
 285                                 .value | select(.[0].value == "quasiquote") as $value |
 286                                     $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
 287                             ) //
 288                             (
 289                                 .value | select(.[0].value == "macroexpand") as $value |
 290                                     $value[1] | macroexpand(env) | TCOWrap($_menv; $_orig_retenv; false)
 291                             ) //
 292                             (
 293                                 . as $dot | _interpret($_menv) as $exprenv |
 294                                         $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
 295                             ) //
 296                                 TCOWrap($_menv; $_orig_retenv; false)
 297                         )
 298                     end
 299                 end
 300             ) //
 301                 (eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false))
 302         end
 303     ) ]
 304     | last as $result
 305     | ($result.ret_env // $result.env) as $env
 306     | $result.ast
 307     | addEnv($env);
 308
 309 def PRINT(env):
 310     pr_str(env);
 311
 312 def rep(env):
 313     READ | EVAL(env) as $expenv |
 314         if $expenv.expr != null then
 315             $expenv.expr | PRINT($expenv.env)
 316         else
 317             null
 318         end | addEnv($expenv.env);
 319
 320 def repl_(env):
 321     ("user> " | _print) |
 322     (read_line | rep(env));
 323
 324 # we don't have no indirect functions, so we'll have to interpret the old way
 325 def replEnv:
 326     {
 327         parent: null,
 328         environment: ({
 329             "+": {
 330                 kind: "fn", # native function
 331                 inputs: 2,
 332                 function: "number_add"
 333             },
 334             "-": {
 335                 kind: "fn", # native function
 336                 inputs: 2,
 337                 function: "number_sub"
 338             },
 339             "*": {
 340                 kind: "fn", # native function
 341                 inputs: 2,
 342                 function: "number_mul"
 343             },
 344             "/": {
 345                 kind: "fn", # native function
 346                 inputs: 2,
 347                 function: "number_div"
 348             },
 349             "eval": {
 350                 kind: "fn",
 351                 inputs: 1,
 352                 function: "eval"
 353             }
 354         } + core_identify),
 355         fallback: null
 356     };
 357
 358 def repl(env):
 359     def xrepl:
 360         (.env as $env | try repl_($env) catch addEnv($env)) as $expenv |
 361             {
 362                 value: $expenv.expr,
 363                 stop: false,
 364                 env: ($expenv.env // .env)
 365             } | ., xrepl;
 366     {stop: false, env: env} | xrepl | if .value then (.value | _display) else empty end;
 367
 368 def eval_ign(expr):
 369     . as $env | expr | rep($env) | .env;
 370
 371 def eval_val(expr):
 372     . as $env | expr | rep($env) | .expr;
 373
 374 def getEnv:
 375     replEnv
 376     | wrapEnv({})
 377     | eval_ign("(def! not (fn* (a) (if a false true)))")
 378     | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))")
 379     | 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)))))))")
 380     ;
 381
 382 def main:
 383     if $ARGS.positional|length > 0 then
 384         getEnv as $env |
 385         env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
 386         eval_val("(load-file \($ARGS.positional[0] | tojson))") |
 387         ""
 388     else
 389         repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
 390     end;
 391
 392 [ main ] | _halt