jq/interp.jq

   1 include "utils";
   2 include "core";
   3 include "env";
   4 include "printer";
   5
   6 def arg_check(args):
   7     if .inputs < 0 then
   8         if (abs(.inputs) - 1) > (args | length) then
   9             jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))")
  10         else
  11             .
  12         end
  13     else if .inputs != (args|length) then
  14         jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))")
  15     else
  16         .
  17     end end;
  18
  19 def extractReplEnv(env):
  20     env | .replEnv // .;
  21
  22 def extractEnv(env):
  23     env | .currentEnv // .;
  24
  25 def updateReplEnv(renv):
  26     def findpath:
  27         if .env.parent then
  28             .path += ["parent"] |
  29             .env |= .parent |
  30             findpath
  31         else
  32             .path
  33         end;
  34     ({ env: ., path: [] } | findpath) as $path |
  35     setpath($path; renv);
  36
  37 def extractCurrentReplEnv(env):
  38     def findpath:
  39         if .env.parent then
  40             .path += ["parent"] |
  41             .env |= .parent |
  42             findpath
  43         else
  44             .path
  45         end;
  46     if env.currentEnv != null then
  47         ({ env: env.currentEnv, path: [] } | findpath) as $path |
  48             env.currentEnv | getpath($path)
  49     else
  50         env
  51     end;
  52
  53 def extractAtoms(env):
  54     env.atoms // {};
  55
  56 def addFrees(newEnv; frees):
  57     . as $env
  58     | reduce frees[] as $free (
  59         $env;
  60         . as $dot
  61         | extractEnv(newEnv) as $env
  62         | env_req($env; $free) as $lookup
  63         | if $lookup != null then
  64             env_set_(.; $free; $lookup)
  65           else
  66             .
  67           end)
  68     | . as $env
  69     | $env;
  70
  71 def interpret(arguments; env; _eval):
  72     extractReplEnv(env) as $replEnv |
  73     extractAtoms(env) as $envAtoms |
  74     (if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) |
  75     (select(.kind == "fn") |
  76         arg_check(arguments) |
  77             (select(.function == "eval") |
  78                 # special function
  79                 { expr: arguments[0], env: $replEnv|wrapEnv($replEnv; $envAtoms) }
  80                 | _eval
  81                 | .env as $xenv
  82                 | extractReplEnv($xenv) as $xreplenv
  83                 | setpath(
  84                     ["env", "currentEnv"];
  85                     extractEnv(env) | updateReplEnv($xreplenv))
  86             ) //
  87             (select(.function == "reset!") |
  88                 # env modifying function
  89                 arguments[0].identity as $id |
  90                 ($envAtoms | setpath([$id]; arguments[1])) as $envAtoms |
  91                 arguments[1] | addEnv(env | setpath(["atoms"]; $envAtoms))
  92             ) //
  93             (select(.function == "swap!") |
  94                 # env modifying function
  95                 arguments[0].identity as $id |
  96                 $envAtoms[$id] as $initValue |
  97                 arguments[1] as $function |
  98                 ([$initValue] + arguments[2:]) as $args |
  99                 ($function | interpret($args; env; _eval)) as $newEnvValue |
 100                 ($envAtoms | setpath([$id]; $newEnvValue.expr)) as $envAtoms |
 101                 $newEnvValue.expr | addEnv(env | setpath(["atoms"]; $envAtoms))
 102             ) // (select(.function == "atom") |
 103                 (now|tostring) as $id |
 104                 {kind: "atom", identity: $id} as $value |
 105                 ($envAtoms | setpath([$id]; arguments[0])) as $envAtoms |
 106                 $value | addEnv(env | setpath(["atoms"]; $envAtoms))
 107             ) // (select(.function == "deref") |
 108                 $envAtoms[arguments[0].identity] | addEnv(env)
 109             ) //
 110             (select(.function  == "apply") |
 111                 # (apply F ...T A) -> (F ...T ...A)
 112                 arguments as $args
 113                 | ($args|first) as $F
 114                 | ($args|last.value) as $A
 115                 | $args[1:-1] as $T
 116                 | $F | interpret([$T[], $A[]]; env; _eval)
 117             ) //
 118             (select(.function  == "map") |
 119                 arguments
 120                 | first as $F
 121                 | last.value as $L
 122                 | (reduce $L[] as $elem (
 123                     {env: env, val: []};
 124                     . as $dot |
 125                     ($F | interpret([$elem]; $dot.env; _eval)) as $val |
 126                     {
 127                         val: (.val + [$val.expr]),
 128                         env: (.env | setpath(["atoms"]; $val.env.atoms))
 129                     }
 130                   )) as $ex
 131                 | $ex.val | wrap("list") | addEnv($ex.env)
 132             ) //
 133                 (core_interp(arguments; env) | addEnv(env))
 134     ) //
 135     (select(.kind == "function") as $fn |
 136         # todo: arg_check
 137         (.body | pr_str(env)) as $src |
 138         # _debug("INTERP " + $src) |
 139         # _debug("FREES " + ($fn.free_referencess | tostring)) |
 140         env_setfallback(extractEnv(.env | addFrees(env; $fn.free_referencess)); extractEnv(env)) | childEnv($fn.binds; arguments) as $fnEnv |
 141             # tell it about its surroundings
 142             (reduce $fn.free_referencess[] as $name (
 143                 $fnEnv;
 144                 . as $env | try env_set_(
 145                     .;
 146                     $name;
 147                     $name | env_get(env) | . as $xvalue
 148                     | if $xvalue.kind == "function" then
 149                         setpath(["free_referencess"]; $fn.free_referencess)
 150                     else
 151                         $xvalue
 152                     end
 153                 ) catch $env)) as $fnEnv |
 154             # tell it about itself
 155             env_multiset($fnEnv; $fn.names; $fn) as $fnEnv |
 156             {
 157                 env: env_multiset($fnEnv; $fn.names; $fn)
 158                      | wrapEnv($replEnv; $envAtoms),
 159                 expr: $fn.body
 160             }
 161             | . as $dot
 162             # | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str))
 163             | _eval
 164             | . as $envexp
 165             | (extractReplEnv($envexp.env)) as $xreplenv
 166             |
 167             {
 168                 expr: .expr,
 169                 env: extractEnv(env)
 170                     | updateReplEnv($xreplenv)
 171                     | wrapEnv($xreplenv; $envexp.env.atoms)
 172             }
 173             # | . as $dot
 174             # | _debug("FNPOST " + (.expr | pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) | pr_str))
 175             # | _debug("INTERP " + $src + " = " + (.expr|pr_str))
 176     ) //
 177         jqmal_error("Unsupported function kind \(.kind)");
 178