jq/step5_tco.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     | input;
  12
  13 def READ:
  14     read_str | read_form | .value;
  15
  16 # def eval_ast(env):
  17 #         (select(.kind == "symbol") | .value | env_get(env) | addEnv(env)) //
  18 #         (select(.kind == "list") | reduce .value[] as $elem (
  19 #             {value: [], env: env};
  20 #             . as $dot | $elem | EVAL($dot.env) as $eval_env |
  21 #                 {
  22 #                     value: ($dot.value + [$eval_env.expr]),
  23 #                     env: $eval_env.env
  24 #                 }
  25 #         ) | { expr: .value, env: .env }) // (addEnv(env));
  26
  27 # def patch_with_env(env):
  28 #     . as $dot | (reduce .[] as $fnv (
  29 #         [];
  30 #         . + [$fnv | setpath([1, "free_referencess"]; ($fnv[1].free_referencess + $dot) | unique)]
  31 #     )) as $functions | reduce $functions[] as $function (
  32 #         env;
  33 #         env_set(.; $function[0]; $function[1])
  34 #     ) | { functions: $functions, env: . };
  35
  36 def find_free_references(keys):
  37     def _refs:
  38         . as $dot
  39         | if .kind == "symbol" then
  40             if keys | contains([$dot.value]) then [] else [$dot.value] end
  41         else if "list" == $dot.kind then
  42             ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + ["if", "def!", "let*", "fn*"]))
  43         else if "vector" == $dot.kind then
  44             ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + ["if", "def!", "let*", "fn*"]))
  45         else
  46             []
  47         end end end;
  48     _refs | unique;
  49
  50 def recurseflip(x; y):
  51     recurse(y; x);
  52
  53 def TCOWrap(env; retenv; continue):
  54     {
  55         ast: .,
  56         env: env,
  57         ret_env: retenv,
  58         finish: (continue | not),
  59         cont: true # set inside
  60     };
  61
  62 def EVAL(env):
  63     def _eval_here:
  64         .env as $env | .expr | EVAL($env);
  65
  66     def hmap_with_env:
  67         .env as $env | .list as $list |
  68             if $list|length == 0 then
  69                 empty
  70             else
  71                 $list[0] as $elem |
  72                 $list[1:] as $rest |
  73                     $elem[1] | EVAL($env) as $resv |
  74                         { value: [$elem[0], $resv.expr], env: env },
  75                         ({env: $resv.env, list: $rest} | hmap_with_env)
  76             end;
  77     def map_with_env:
  78         .env as $env | .list as $list |
  79             if $list|length == 0 then
  80                 empty
  81             else
  82                 $list[0] as $elem |
  83                 $list[1:] as $rest |
  84                     $elem | EVAL($env) as $resv |
  85                         { value: $resv.expr, env: env },
  86                         ({env: $resv.env, list: $rest} | map_with_env)
  87             end;
  88     . as $ast
  89     | { env: env, ast: ., cont: true, finish: false, ret_env: null }
  90     | [ recurseflip(.cont;
  91         .env as $_menv
  92         | if .finish then
  93             .cont |= false
  94         else
  95             (.ret_env//.env) as $_retenv
  96             | .ret_env as $_orig_retenv
  97             | .ast
  98             |
  99             (select(.kind == "list") |
 100                 if .value | length == 0 then
 101                     . | TCOWrap($_menv; $_orig_retenv; false)
 102                 else
 103                     (
 104                         (
 105                             .value | select(.[0].value == "def!") as $value |
 106                                 ($value[2] | EVAL($_menv)) as $evval |
 107                                     addToEnv($evval; $value[1].value) as $val |
 108                                     $val.expr | TCOWrap($val.env; $_orig_retenv; false)
 109                         ) //
 110                         (
 111                             .value | select(.[0].value == "let*") as $value |
 112                                 ($_menv | pureChildEnv) as $subenv |
 113                                     (reduce ($value[1].value | nwise(2)) as $xvalue (
 114                                         $subenv;
 115                                         . as $env | $xvalue[1] | EVAL($env) as $expenv |
 116                                             env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
 117                                                 | $value[2] | TCOWrap($env; $_retenv; true)
 118                         ) //
 119                         (
 120                             .value | select(.[0].value == "do") as $value |
 121                                 (reduce ($value[1:][]) as $xvalue (
 122                                     { env: $_menv, expr: {kind:"nil"} };
 123                                     .env as $env | $xvalue | EVAL($env)
 124                                 )) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
 125                         ) //
 126                         (
 127                             .value | select(.[0].value == "if") as $value |
 128                                 $value[1] | EVAL(env) as $condenv |
 129                                     (if (["false", "nil"] | contains([$condenv.expr.kind])) then
 130                                         ($value[3] // {kind:"nil"})
 131                                     else
 132                                         $value[2]
 133                                     end) | TCOWrap($condenv.env; $_orig_retenv; true)
 134                         ) //
 135                         (
 136                             .value | select(.[0].value == "fn*") as $value |
 137                                 # we can't do what the guide says, so we'll skip over this
 138                                 # and ues the later implementation
 139                                 # (fn* args body)
 140                                 $value[1].value | map(.value) as $binds | {
 141                                     kind: "function",
 142                                     binds: $binds,
 143                                     env: $_menv,
 144                                     body: $value[2],
 145                                     names: [], # we can't do that circular reference this
 146                                     free_referencess: $value[2] | find_free_references($_menv | env_dump_keys + $binds) # for dynamically scoped variables
 147                                 } | TCOWrap($_menv; $_orig_retenv; false)
 148                         ) //
 149                         (
 150                             reduce .value[] as $elem (
 151                                 [];
 152                                 . as $dot | $elem | EVAL($_menv) as $eval_env |
 153                                     ($dot + [$eval_env.expr])
 154                             ) | . as $expr | first |
 155                                     interpret($expr[1:]; $_menv; _eval_here) as $exprenv |
 156                                     $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
 157                         ) //
 158                             TCOWrap($_menv; $_orig_retenv; false)
 159                     )
 160                 end
 161             ) //
 162             (select(.kind == "vector") |
 163                 if .value|length == 0 then
 164                     {
 165                         kind: "vector",
 166                         value: []
 167                     } | TCOWrap($_menv; $_orig_retenv; false)
 168                 else
 169                     [ { env: $_menv, list: .value } | map_with_env ] as $res |
 170                     {
 171                         kind: "vector",
 172                         value: $res | map(.value)
 173                     } | TCOWrap($res | last.env; $_orig_retenv; false)
 174                 end
 175             ) //
 176             (select(.kind == "hashmap") |
 177                 [ { env: $_menv, list: .value | to_entries } | hmap_with_env ] as $res |
 178                 {
 179                     kind: "hashmap",
 180                     value: $res | map(.value) | from_entries
 181                 } | TCOWrap($res | last.env; $_orig_retenv; false)
 182             ) //
 183             (select(.kind == "function") |
 184                 . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to
 185             ) //
 186             (select(.kind == "symbol") |
 187                 .value | env_get($_menv) | TCOWrap($_menv; null; false)
 188             ) // TCOWrap($_menv; $_orig_retenv; false)
 189         end
 190     ) ]
 191     | last as $result
 192     | ($result.ret_env // $result.env) as $env
 193     | $result.ast
 194     | addEnv($env);
 195
 196 def PRINT:
 197     pr_str;
 198
 199 def rep(env):
 200     READ | EVAL(env) as $expenv |
 201         if $expenv.expr != null then
 202             $expenv.expr | PRINT
 203         else
 204             null
 205         end | addEnv($expenv.env);
 206
 207 def repl_(env):
 208     ("user> " | _print) |
 209     (read_line | rep(env));
 210
 211 # we don't have no indirect functions, so we'll have to interpret the old way
 212 def replEnv:
 213     {
 214         parent: null,
 215         environment: ({
 216             "+": {
 217                 kind: "fn", # native function
 218                 inputs: 2,
 219                 function: "number_add"
 220             },
 221             "-": {
 222                 kind: "fn", # native function
 223                 inputs: 2,
 224                 function: "number_sub"
 225             },
 226             "*": {
 227                 kind: "fn", # native function
 228                 inputs: 2,
 229                 function: "number_mul"
 230             },
 231             "/": {
 232                 kind: "fn", # native function
 233                 inputs: 2,
 234                 function: "number_div"
 235             },
 236         } + core_identify)
 237     };
 238
 239 def repl(env):
 240     def xrepl:
 241         (.env as $env | try repl_($env) catch addEnv($env)) as $expenv |
 242             {
 243                 value: $expenv.expr,
 244                 stop: false,
 245                 env: ($expenv.env // .env)
 246             } | ., xrepl;
 247     {stop: false, env: env} | xrepl | if .value then (.value | _print) else empty end;
 248
 249 repl(
 250     "(def! not (fn* (a) (if a false true)))" | rep(replEnv) | .env
 251 )