def childEnv(binds; exprs):
{
parent: .,
+ fallback: null,
environment: [binds, exprs] | transpose | (
. as $dot | reduce .[] as $item (
{ value: [], seen: false, name: null, idx: 0 };
def pureChildEnv:
{
parent: .,
- environment: {}
+ environment: {},
+ fallback: null
};
def rootEnv:
{
parent: null,
+ fallback: null,
environment: {}
};
environment: (.environment + (.environment | .[$key] |= $value)) # merge together, as .environment[key] |= value does not work
};
+def env_dump_keys:
+ def _dump:
+ .environment | keys;
+
+ if .parent == null then
+ _dump
+ else
+ .parent | env_dump_keys + _dump
+ end;
+
def env_set(env; $key; $value):
(if $value.kind == "function" then
# inform the function of its names
- $value | (.names += [$key])
+ $value | (.names += [$key]) | (.names |= unique)
else
$value
end) as $value | {
def env_find(env):
if env.environment[.] == null then
if env.parent then
- env_find(env.parent)
+ env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end
else
null
end
env
end;
+def env_setfallback(env; fallback):
+ {
+ parent: env.parent,
+ fallback: fallback,
+ environment: env.environment
+ };
+
def env_get(env):
. as $key | env_find(env).environment[$key] // jqmal_error("Symbol \($key) not found");
((select(.kind == "fn") | (
arg_check(arguments) | core_interp(arguments; env)
)) //
- jqmal_error("Unsupported native function kind \(.kind)")) | addEnv(env);
+ jqmal_error("Unsupported native function kind \(.kind)"));
def interpret(arguments; env; _eval):
(select(.kind == "fn") | (
)) //
(select(.kind == "function") as $fn |
# todo: arg_check
- .env as $oenv | .env | childEnv($fn.binds; arguments) as $fnEnv |
+ .env as $oenv | env_setfallback(.env; env) | childEnv($fn.binds; arguments) as $fnEnv |
# tell it about its surroundings
- (reduce $fn.corecursives[] as $name (
+ (reduce $fn.free_referencess[] as $name (
$fnEnv;
- env_set(.; $name[0]; $name[1] | setpath(["corecursives"]; $fn.corecursives)))) as $fnEnv |
+ . as $env | try env_set(
+ .;
+ $name;
+ $name | env_get(env) | . as $xvalue
+ | if $xvalue.kind == "function" then
+ setpath(["free_referencess"]; $fn.free_referencess)
+ else
+ $xvalue
+ end
+ ) catch $env)) as $fnEnv |
# tell it about itself
env_multiset($fnEnv; $fn.names; $fn) as $fnEnv |
{ env: env_multiset($fnEnv; $fn.names; $fn), expr: $fn.body } | _eval | { expr: .expr, env: env }
) //
jqmal_error("Unsupported function kind \(.kind)");
-
#!/bin/bash
-exec jq -nrRM -f "$(dirname "$0")/${STEP:-stepA_mal}.jq" "${@}" |& jq -RrM -c 'try fromjson[1]'
+exec jq -nrRM -f "$(dirname "$0")/${STEP:-stepA_mal}.jq" "${@}" |& jq -Rr 'try fromjson[1]'
+include "utils";
def read_line:
. as $in
.;
def rep:
- READ | EVAL | PRINT;
+ READ | EVAL | PRINT | _print;
def repl_:
- ("user> " | stderr) |
+ ("user> " | _print) |
(read_line | rep);
def repl:
end;
def repl_:
- ("user> " | stderr) |
+ ("user> " | _print) |
(read_line | rep);
def repl:
{value: "Error: \(.)", continue: true}
else
{value: ., continue: false}
- end) | if .value then .value else empty end;
+ end) | if .value then .value|_print else empty end;
repl
end;
def repl_(env):
- ("user> " | stderr) |
+ ("user> " | _print) |
(read_line | rep(env));
# we don't have no indirect functions, so we'll have to interpret the old way
{value: "Error: \(.)", continue: true}
else
{value: ., continue: false}
- end) | if .value then .value else empty end;
+ end) | if .value then .value|_print else empty end;
repl(replEnv)
\ No newline at end of file
read_str | read_form | .value;
def EVAL(env):
+ def _eval_here:
+ .env as $env | .expr | EVAL($env);
def hmap_with_env:
.env as $env | .list as $list |
if $list|length == 0 then
}
) | { expr: .value, env: .env } as $ev
| $ev.expr | first |
- interpret($ev.expr[1:]; $ev.env) | addEnv($ev.env)
+ interpret($ev.expr[1:]; $ev.env; _eval_here)
) //
addEnv(env)
)
end | addEnv($expenv.env);
def repl_(env):
- ("user> " | stderr) |
+ ("user> " | _print) |
(read_line | rep(env));
def childEnv(binds; value):
stop: false,
env: ($expenv.env // .env)
} | ., xrepl;
- {stop: false, env: env} | xrepl | if .value then .value else empty end;
+ {stop: false, env: env} | xrepl | if .value then (.value | _print) else empty end;
repl(replEnv)
\ No newline at end of file
# env: $eval_env.env
# }
# ) | { expr: .value, env: .env }) // (addEnv(env));
-# (let* (f (fn* (n) (if (= n 0) 0 (g (- n 1)))) g (fn* (n) (f n))) (f 2))
-def patch_with_env(env):
- . as $dot | (reduce .[] as $fnv (
- [];
- . + [$fnv | setpath([1, "corecursives"]; ($fnv[1].corecursives + $dot) | unique)]
- )) as $functions | reduce $functions[] as $function (
- env;
- env_set(.; $function[0]; $function[1])
- ) | { functions: $functions, env: . };
+# def patch_with_env(env):
+# . as $dot | (reduce .[] as $fnv (
+# [];
+# . + [$fnv | setpath([1, "free_referencess"]; ($fnv[1].free_referencess + $dot) | unique)]
+# )) as $functions | reduce $functions[] as $function (
+# env;
+# env_set(.; $function[0]; $function[1])
+# ) | { functions: $functions, env: . };
+
+def find_free_references(keys):
+ def _refs:
+ . as $dot
+ | if .kind == "symbol" then
+ if keys | contains([$dot.value]) then [] else [$dot.value] end
+ else if "list" == $dot.kind then
+ ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + ["if", "def!", "let*", "fn*"]))
+ else if "vector" == $dot.kind then
+ ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + ["if", "def!", "let*", "fn*"]))
+ else
+ []
+ end end end;
+ _refs | unique;
def EVAL(env):
def _eval_here:
.value | select(.[0].value == "let*") as $value |
(env | pureChildEnv) as $subenv |
(reduce ($value[1].value | nwise(2)) as $xvalue (
- { functions: [], env: $subenv };
- . as $dot | .env as $env | $xvalue[1] | EVAL($env) as $expenv |
- env_set($expenv.env; $xvalue[0].value; $expenv.expr) as $newenv |
- ($dot.functions + [if $expenv.expr.kind == "function" then [($xvalue[0].value), ($xvalue[0].value | env_get($newenv))] else empty end]) | patch_with_env($newenv) as $funcenv |
- {
- functions: $funcenv.functions,
- env: $funcenv.env
- }) | .env) as $env
+ $subenv;
+ . as $env | $xvalue[1] | EVAL($env) as $expenv |
+ env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
| $value[2] | { expr: EVAL($env).expr, env: env }
) //
(
# we can't do what the guide says, so we'll skip over this
# and ues the later implementation
# (fn* args body)
- {
+ $value[1].value | map(.value) as $binds | {
kind: "function",
- binds: $value[1].value | map(.value),
+ binds: $binds,
env: env,
body: $value[2],
names: [], # we can't do that circular reference this
- corecursives: [] # for equirecursive functions defined in let*
+ free_referencess: $value[2] | find_free_references(env | env_dump_keys + $binds) # for dynamically scoped variables
} | addEnv(env)
) //
(
--- /dev/null
+include "reader";
+include "printer";
+include "utils";
+include "interp";
+include "env";
+include "core";
+
+def read_line:
+ . as $in
+ | label $top
+ | input;
+
+def READ:
+ read_str | read_form | .value;
+
+# def eval_ast(env):
+# (select(.kind == "symbol") | .value | env_get(env) | addEnv(env)) //
+# (select(.kind == "list") | reduce .value[] as $elem (
+# {value: [], env: env};
+# . as $dot | $elem | EVAL($dot.env) as $eval_env |
+# {
+# value: ($dot.value + [$eval_env.expr]),
+# env: $eval_env.env
+# }
+# ) | { expr: .value, env: .env }) // (addEnv(env));
+
+# def patch_with_env(env):
+# . as $dot | (reduce .[] as $fnv (
+# [];
+# . + [$fnv | setpath([1, "free_referencess"]; ($fnv[1].free_referencess + $dot) | unique)]
+# )) as $functions | reduce $functions[] as $function (
+# env;
+# env_set(.; $function[0]; $function[1])
+# ) | { functions: $functions, env: . };
+
+def find_free_references(keys):
+ def _refs:
+ . as $dot
+ | if .kind == "symbol" then
+ if keys | contains([$dot.value]) then [] else [$dot.value] end
+ else if "list" == $dot.kind then
+ ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + ["if", "def!", "let*", "fn*"]))
+ else if "vector" == $dot.kind then
+ ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + ["if", "def!", "let*", "fn*"]))
+ else
+ []
+ end end end;
+ _refs | unique;
+
+def EVAL(env):
+ def _eval_here:
+ .env as $env | .expr | EVAL($env);
+
+ def hmap_with_env:
+ .env as $env | .list as $list |
+ if $list|length == 0 then
+ empty
+ else
+ $list[0] as $elem |
+ $list[1:] as $rest |
+ $elem[1] | EVAL($env) as $resv |
+ { value: [$elem[0], $resv.expr], env: env },
+ ({env: $resv.env, list: $rest} | hmap_with_env)
+ end;
+ def map_with_env:
+ .env as $env | .list as $list |
+ if $list|length == 0 then
+ empty
+ else
+ $list[0] as $elem |
+ $list[1:] as $rest |
+ $elem | EVAL($env) as $resv |
+ { value: $resv.expr, env: env },
+ ({env: $resv.env, list: $rest} | map_with_env)
+ end;
+ (select(.kind == "list") |
+ if .value | length == 0 then
+ .
+ else
+ (
+ (
+ .value | select(.[0].value == "def!") as $value |
+ ($value[2] | EVAL(env)) as $evval |
+ addToEnv($evval; $value[1].value)
+ ) //
+ (
+ .value | select(.[0].value == "let*") as $value |
+ (env | pureChildEnv) as $subenv |
+ (reduce ($value[1].value | nwise(2)) as $xvalue (
+ $subenv;
+ . as $env | $xvalue[1] | EVAL($env) as $expenv |
+ env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
+ | $value[2] | { expr: EVAL($env).expr, env: env }
+ ) //
+ (
+ .value | select(.[0].value == "do") as $value |
+ (reduce ($value[1:][]) as $xvalue (
+ { env: env, expr: {kind:"nil"} };
+ .env as $env | $xvalue | EVAL($env)
+ ))
+ ) //
+ (
+ .value | select(.[0].value == "if") as $value |
+ $value[1] | EVAL(env) as $condenv |
+ if (["false", "nil"] | contains([$condenv.expr.kind])) then
+ ($value[3] // {kind:"nil"}) | EVAL($condenv.env)
+ else
+ $value[2] | EVAL($condenv.env)
+ end
+ ) //
+ (
+ .value | select(.[0].value == "fn*") as $value |
+ # we can't do what the guide says, so we'll skip over this
+ # and ues the later implementation
+ # (fn* args body)
+ $value[1].value | map(.value) as $binds | {
+ kind: "function",
+ binds: $binds,
+ env: env,
+ body: $value[2],
+ names: [], # we can't do that circular reference this
+ free_referencess: $value[2] | find_free_references(env | env_dump_keys + $binds) # for dynamically scoped variables
+ } | addEnv(env)
+ ) //
+ (
+ reduce .value[] as $elem (
+ {value: [], env: env};
+ . as $dot | $elem | EVAL($dot.env) as $eval_env |
+ {
+ value: ($dot.value + [$eval_env.expr]),
+ env: $eval_env.env
+ }
+ ) | { expr: .value, env: .env } as $ev
+ | $ev.expr | first |
+ interpret($ev.expr[1:]; $ev.env; _eval_here)
+ ) //
+ addEnv(env)
+ )
+ end
+ ) //
+ (select(.kind == "vector") |
+ if .value|length == 0 then
+ {
+ kind: "vector",
+ value: []
+ } | addEnv(env)
+ else
+ [ { env: env, list: .value } | map_with_env ] as $res |
+ {
+ kind: "vector",
+ value: $res | map(.value)
+ } | addEnv($res | last.env)
+ end
+ ) //
+ (select(.kind == "hashmap") |
+ [ { env: env, list: .value | to_entries } | hmap_with_env ] as $res |
+ {
+ kind: "hashmap",
+ value: $res | map(.value) | from_entries
+ } | addEnv($res | last.env)
+ ) //
+ (select(.kind == "function") |
+ . | addEnv(env) # return this unchanged, since it can only be applied to
+ ) //
+ (select(.kind == "symbol") |
+ .value | env_get(env) | addEnv(env)
+ ) // addEnv(env);
+
+def PRINT:
+ pr_str;
+
+def rep(env):
+ READ | EVAL(env) as $expenv |
+ if $expenv.expr != null then
+ $expenv.expr | PRINT
+ else
+ null
+ end | addEnv($expenv.env);
+
+def repl_(env):
+ ("user> " | _print) |
+ (read_line | rep(env));
+
+# we don't have no indirect functions, so we'll have to interpret the old way
+def replEnv:
+ {
+ parent: null,
+ environment: ({
+ "+": {
+ kind: "fn", # native function
+ inputs: 2,
+ function: "number_add"
+ },
+ "-": {
+ kind: "fn", # native function
+ inputs: 2,
+ function: "number_sub"
+ },
+ "*": {
+ kind: "fn", # native function
+ inputs: 2,
+ function: "number_mul"
+ },
+ "/": {
+ kind: "fn", # native function
+ inputs: 2,
+ function: "number_div"
+ },
+ } + core_identify)
+ };
+
+def repl(env):
+ def xrepl:
+ (.env as $env | try repl_($env) catch addEnv($env)) as $expenv |
+ {
+ value: $expenv.expr,
+ stop: false,
+ env: ($expenv.env // .env)
+ } | ., xrepl;
+ {stop: false, env: env} | xrepl | if .value then (.value | _print) else empty end;
+
+repl(
+ "(def! not (fn* (a) (if a false true)))" | rep(replEnv) | .env
+)
\ No newline at end of file
HCoop / jackhill / mal.git / commitdiff