jq/step8_macros.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                                         (reduce ($value[1].value | nwise(2)) as $xvalue (
 215                                             $_menv;
 216                                             . as $env | $xvalue[1] | EVAL($env) as $expenv |
 217                                                 env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
 218                                                     | $value[2] | TCOWrap($env; $_retenv; true)
 219                             ) //
 220                             (
 221                                 .value | select(.[0].value == "do") as $value |
 222                                     (reduce ($value[1:][]) as $xvalue (
 223                                         { env: $_menv, expr: {kind:"nil"} };
 224                                         .env as $env | $xvalue | EVAL($env)
 225                                     )) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
 226                             ) //
 227                             (
 228                                 .value | select(.[0].value == "if") as $value |
 229                                     $value[1] | EVAL($_menv) as $condenv |
 230                                         (if (["false", "nil"] | contains([$condenv.expr.kind])) then
 231                                             ($value[3] // {kind:"nil"})
 232                                         else
 233                                             $value[2]
 234                                         end) | TCOWrap($condenv.env; $_orig_retenv; true)
 235                             ) //
 236                             (
 237                                 .value | select(.[0].value == "fn*") as $value |
 238                                     # we can't do what the guide says, so we'll skip over this
 239                                     # and ues the later implementation
 240                                     # (fn* args body)
 241                                     $value[1].value | map(.value) as $binds |
 242                                 ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | {
 243                                     kind: "function",
 244                                     binds: $binds,
 245                                     env: (env | env_remove_references($free_referencess)),
 246                                     body: $value[2],
 247                                     names: [], # we can't do that circular reference this
 248                                     free_referencess: $free_referencess,  # for dynamically scoped variables
 249                                     is_macro: false
 250                                 } | TCOWrap($_menv; $_orig_retenv; false)
 251                             ) //
 252                             (
 253                                 .value | select(.[0].value == "quote") as $value |
 254                                     $value[1] | TCOWrap($_menv; $_orig_retenv; false)
 255                             ) //
 256                             (
 257                                 .value | select(.[0].value == "quasiquote") as $value |
 258                                     $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
 259                             ) //
 260                             (
 261                                 .value | select(.[0].value == "macroexpand") as $value |
 262                                     $value[1] | macroexpand(env) | TCOWrap($_menv; $_orig_retenv; false)
 263                             ) //
 264                             (
 265                                 . as $dot | _interpret($_menv) as $exprenv |
 266                                         $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
 267                             ) //
 268                                 TCOWrap($_menv; $_orig_retenv; false)
 269                         )
 270                     end
 271                 end
 272             ) //
 273                 (eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false))
 274         end
 275     ) ]
 276     | last as $result
 277     | ($result.ret_env // $result.env) as $env
 278     | $result.ast
 279     | addEnv($env);
 280
 281 def PRINT(env):
 282     pr_str(env);
 283
 284 def rep(env):
 285     READ | EVAL(env) as $expenv |
 286         if $expenv.expr != null then
 287             $expenv.expr | PRINT($expenv.env)
 288         else
 289             null
 290         end | addEnv($expenv.env);
 291
 292 def repl_(env):
 293     ("user> " | _print) |
 294     (read_line | rep(env));
 295
 296 # we don't have no indirect functions, so we'll have to interpret the old way
 297 def replEnv:
 298     {
 299         parent: null,
 300         environment: ({
 301             "+": {
 302                 kind: "fn", # native function
 303                 inputs: 2,
 304                 function: "number_add"
 305             },
 306             "-": {
 307                 kind: "fn", # native function
 308                 inputs: 2,
 309                 function: "number_sub"
 310             },
 311             "*": {
 312                 kind: "fn", # native function
 313                 inputs: 2,
 314                 function: "number_mul"
 315             },
 316             "/": {
 317                 kind: "fn", # native function
 318                 inputs: 2,
 319                 function: "number_div"
 320             },
 321             "eval": {
 322                 kind: "fn",
 323                 inputs: 1,
 324                 function: "eval"
 325             }
 326         } + core_identify),
 327         fallback: null
 328     };
 329
 330 def repl(env):
 331     def xrepl:
 332         (.env as $env | try repl_($env) catch addEnv($env)) as $expenv |
 333             {
 334                 value: $expenv.expr,
 335                 stop: false,
 336                 env: ($expenv.env // .env)
 337             } | ., xrepl;
 338     {stop: false, env: env} | xrepl | if .value then (.value | _print) else empty end;
 339
 340 def eval_ign(expr):
 341     . as $env | expr | rep($env) | .env;
 342
 343 def eval_val(expr):
 344     . as $env | expr | rep($env) | .expr;
 345
 346 def getEnv:
 347     replEnv
 348     | wrapEnv({})
 349     | eval_ign("(def! not (fn* (a) (if a false true)))")
 350     | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))")
 351     | 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)))))))")
 352     ;
 353
 354 def main:
 355     if $ARGS.positional|length > 0 then
 356         getEnv as $env |
 357         env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
 358         eval_val("(load-file \($ARGS.positional[0] | tojson))")
 359     else
 360         repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
 361     end;
 362
 363 main