{
parent: .,
fallback: null,
+ dirty_atoms: .dirty_atoms,
environment: [binds, exprs] | transpose | (
. as $dot | reduce .[] as $item (
{ value: [], seen: false, name: null, idx: 0 };
{
parent: .,
environment: {},
- fallback: null
+ fallback: null,
+ dirty_atoms: .dirty_atoms
};
def rootEnv:
{
parent: null,
fallback: null,
- environment: {}
+ environment: {},
+ dirty_atoms: []
};
def inform_function(name):
parent: .parent,
environment: (
.environment + (reduce keys[] as $key(.environment; .[$key] |= value))
- )
+ ),
+ fallback: .fallback,
+ dirty_atoms: .dirty_atoms
};
def env_multiset(env; keys; value):
$value
end) as $value | {
parent: .parent,
- environment: (.environment + (.environment | .[$key] |= $value)) # merge together, as .environment[key] |= value does not work
+ environment: (.environment + (.environment | .[$key] |= $value)), # merge together, as .environment[key] |= value does not work
+ fallback: .fallback,
+ dirty_atoms: .dirty_atoms
};
-def env_dump_keys:
- def _dump:
+def env_dump_keys(atoms):
+ def _dump0:
+ [ .environment // {} | to_entries[] | select(.value.kind != "atom") | .key ];
+ def _dump1:
.environment // {} | keys;
-
- if .parent == null then
- _dump
- else
- (.parent | env_dump_keys + _dump) | unique
+ if . == null then [] else
+ if .parent == null then
+ (if atoms then _dump1 else _dump0 end + (.fallback | env_dump_keys(atoms))) | unique
+ else
+ (.parent | env_dump_keys(atoms) + (if atoms then _dump1 else _dump0 end) + (.fallback | env_dump_keys(atoms))) | unique
+ end
end;
+def env_dump_keys:
+ env_dump_keys(false);
+
def env_set(env; $key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
$value
end) as $value | {
parent: env.parent,
- environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)) # merge together, as env.environment[key] |= value does not work
+ environment: ((env.environment // jqmal_error("Environment empty in \(env | keys)")) + (env.environment | .[$key] |= $value)), # merge together, as env.environment[key] |= value does not work
+ fallback: env.fallback,
+ dirty_atoms: env.dirty_atoms
};
def env_find(env):
{
parent: env.parent,
fallback: fallback,
- environment: env.environment
+ environment: env.environment,
+ dirty_atoms: env.dirty_atoms
};
def env_get(env):
env: env_set_(envexp.env; name; envexp.expr)
} end;
+def _env_remove_references(refs):
+ if . != null then
+ {
+ environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries),
+ parent: (.parent | _env_remove_references(refs)),
+ fallback: (.fallback | _env_remove_references(refs)),
+ dirty_atoms: (.dirty_atoms | map(select(. as $dot | refs | contains([$dot]) | not)))
+ }
+ else . end;
+
+def env_remove_references(refs):
+ . as $env
+ | if has("replEnv") then
+ .currentEnv |= _env_remove_references(refs)
+ else
+ _env_remove_references(refs)
+ end;
+
# for step2
def lookup(env):
env.environment[.] //
include "utils";
include "core";
include "env";
+include "printer";
def arg_check(args):
if .inputs == -1 then
.
end;
-def updateAtoms(newEnv):
+def cUpdateAtoms(newEnv; cond):
. as $env
- | reduce (newEnv | env_dump_keys | map(env_get(newEnv) as $value | select($value.kind == "atom") | $value))[] as $atom (
+ | (reduce (extractEnv(newEnv)|.dirty_atoms)[] as $atom (
$env;
. as $e | reduce $atom.names[] as $name (
$e;
- env_set_(.; $name; $atom)));
+ . as $env | env_set_($env; $name; $atom)))) as $resEnv
+ | $resEnv | if cond then setpath(["currentEnv", "dirty_atoms"]; []) else . end
+ ;
+
+def addFrees(newEnv; frees):
+ . as $env
+ | reduce frees[] as $free (
+ $env;
+ . as $dot
+ | extractEnv(newEnv) as $env
+ | env_req($env; $free) as $lookup
+ | if $lookup != null then
+ env_set_(.; $free; $lookup)
+ else
+ .
+ end)
+ | . as $env
+ | $env;
def interpret(arguments; env; _eval):
extractReplEnv(env) as $replEnv |
env;
. as $env | env_set_($env; $name; $value)
)) as $env |
- $value.value | addEnv($env)
+ $value.value | addEnv($env | setpath(["currentEnv", "dirty_atoms"]; ($env.currentEnv.dirty_atoms + [$value])|unique))
) //
(select(.function == "swap!") |
# env modifying function
$newEnv;
. as $env | env_set_($env; $name; $newValue)
)) as $newEnv |
- $newValue.value | addEnv($newEnv)
- ) //
+ $newValue.value | addEnv($newEnv | setpath(["currentEnv", "dirty_atoms"]; ($newEnv.currentEnv.dirty_atoms + [$newValue])|unique))
+ )//
(core_interp(arguments; env) | addEnv(env))
) //
(select(.kind == "function") as $fn |
# todo: arg_check
- env_setfallback(extractEnv(.env); extractEnv(env)) | childEnv($fn.binds; arguments) as $fnEnv |
+ (.body | pr_str) as $src |
+ # _debug("INTERP " + $src) |
+ # _debug("FREES " + ($fn.free_referencess | tostring)) |
+ env_setfallback(extractEnv(.env | addFrees(env; $fn.free_referencess)); extractEnv(env)) | childEnv($fn.binds; arguments) as $fnEnv |
# tell it about its surroundings
(reduce $fn.free_referencess[] as $name (
$fnEnv;
| cWrapEnv($replEnv; $hasReplEnv),
expr: $fn.body
}
+ | . as $dot
+ # | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str))
| _eval
| . as $envexp
| (extractReplEnv($envexp.env)) as $xreplenv
env: extractEnv(env)
| cUpdateReplEnv($xreplenv; $hasReplEnv)
| cWrapEnv($xreplenv; $hasReplEnv)
- | updateAtoms(extractEnv($envexp.env))
+ | cUpdateAtoms(extractEnv($envexp.env); $hasReplEnv)
}
+ # | . as $dot
+ # | _debug("FNPOST " + (.expr | pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) | pr_str))
+ # | _debug("INTERP " + $src + " = " + (.expr|pr_str))
) //
jqmal_error("Unsupported function kind \(.kind)");
\ No newline at end of file
def read_str:
tokenize;
+def escape_control:
+ (select(. == "\u0000") | "\\u0000") //
+ (select(. == "\u0001") | "\\u0001") //
+ (select(. == "\u0002") | "\\u0002") //
+ (select(. == "\u0003") | "\\u0003") //
+ (select(. == "\u0004") | "\\u0004") //
+ (select(. == "\u0005") | "\\u0005") //
+ (select(. == "\u0006") | "\\u0006") //
+ (select(. == "\u0007") | "\\u0007") //
+ (select(. == "\u0008") | "\\u0008") //
+ (select(. == "\u0009") | "\\u0009") //
+ (select(. == "\u0010") | "\\u0010") //
+ (select(. == "\u0011") | "\\u0011") //
+ (select(. == "\u0012") | "\\u0012") //
+ (select(. == "\u0013") | "\\u0013") //
+ (select(. == "\u0014") | "\\u0014") //
+ (select(. == "\u0015") | "\\u0015") //
+ (select(. == "\u0016") | "\\u0016") //
+ (select(. == "\u0017") | "\\u0017") //
+ (select(. == "\u0018") | "\\u0018") //
+ (select(. == "\u0019") | "\\u0019") //
+ (select(. == "\u0020") | "\\u0020") //
+ (select(. == "\u0021") | "\\u0021") //
+ (select(. == "\u0022") | "\\u0022") //
+ (select(. == "\u0023") | "\\u0023") //
+ (select(. == "\u0024") | "\\u0024") //
+ (select(. == "\u0025") | "\\u0025") //
+ (select(. == "\u0026") | "\\u0026") //
+ (select(. == "\u0027") | "\\u0027") //
+ (select(. == "\u0028") | "\\u0028") //
+ (select(. == "\u0029") | "\\u0029") //
+ (select(. == "\u0030") | "\\u0030") //
+ (select(. == "\u0031") | "\\u0031") //
+ (select(. == "\n") | "\\n") //
+ .;
+
def read_string:
- fromjson;
+ gsub("(?<z>[\u0000-\u001f])"; "\(.z | escape_control)") | fromjson;
def extract_string:
. as $val | if ["keyword", "symbol", "string"] | contains([$val.kind]) then
# let's do some sorcery to bestow IO upon jq
runjq() {
- mkfifo jqmal-si.pipe || true
- trap "rm -f jqmal-si.pipe" EXIT
+ pipe_name=$(mktemp)
+ rm -f $pipe_name $ipipe_name
+ mkfifo $pipe_name || true
+ xstdout=$(readlink /proc/self/fd/1)
+ stdin=$(readlink /proc/self/fd/0)
+ trap "rm -f $pipe_name" EXIT SIGINT SIGHUP
(
- while true; do cat jqmal-si.pipe; done&
- pid=$!
- trap "kill $pid" EXIT
- cat -
- ) |\
- jq -nrRM -f "$(dirname "$0")/${STEP:-stepA_mal}.jq" --args "${@}" |&\
+ while [[ -e $pipe_name ]]; do
+ timeout 1 cat $pipe_name
+ done&
+ ) | jq -nrRM -f "$(dirname "$0")/${STEP:-stepA_mal}.jq" --args "${@}" |&\
tee \
>(jq -Rr 'try fromjson[1]|if type == "string" then . else empty end') \
>(while read -r line; do
# echo ">>> " $command
cmd=$(echo "$command" | jq -rMc 'try .cmd catch "ignore"')
case "$cmd" in
+ readline)
+ data=$(jq -nR input < $stdin)
+ size=${#data}
+ # echo "read $size bytes '$data'"
+ echo "$data" | pv -q -B $size > $pipe_name
+ ;;
read)
filename=$(echo "$command" | jq -Mrc '.args[0]')
tmp=$(mktemp)
jq -rRnc --rawfile content "$filename" '$content|tojson' > $tmp
# echo "dump $tmp to pipe"
size=$(du -k $tmp)
- cat $tmp | pv -q -B $size > jqmal-si.pipe #>/dev/null 2>&1
+ cat $tmp | pv -q -B $size > $pipe_name #>/dev/null 2>&1
rm $tmp
;;
fwrite)
esac
fi
done) > /dev/null
+ rm -f $pipe_name
}
+my_pid=$$
+trap 'kill -INT $my_pid' EXIT SIGINT
runjq "${@}"
\ No newline at end of file
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
.;
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
# 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 recurseflip(x; y):
recurse(y; x);
inputs: 2,
function: "number_div"
},
- } + core_identify)
+ } + core_identify),
+ dirty_atoms: [],
+ fallback: null
};
def repl(env):
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
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 recurseflip(x; y):
recurse(y; x);
inputs: 2,
function: "number_div"
},
- } + core_identify)
+ } + core_identify),
+ dirty_atoms: [],
+ fallback: null
};
def repl(env):
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
-def special_forms:
- [ "if", "def!", "let*", "fn*", "do" ];
-
-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 + special_forms))
- else if "vector" == $dot.kind then
- ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + special_forms))
- else
- []
- end end end;
- _refs | unique;
-
def recurseflip(x; y):
recurse(y; x);
# 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 | {
+ $value[1].value | map(.value) as $binds |
+ ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | {
kind: "function",
binds: $binds,
- env: env,
+ env: (env | env_remove_references($free_referencess)),
body: $value[2],
names: [], # we can't do that circular reference this
- free_referencess: $value[2] | find_free_references($currentEnv | env_dump_keys + $binds) # for dynamically scoped variables
+ free_referencess: $free_referencess # for dynamically scoped variables
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
inputs: 1,
function: "eval"
}
- } + core_identify)
+ } + core_identify),
+ dirty_atoms: [],
+ fallback: null,
};
def repl(env):
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
- env_set_($env; "*ARGV*"; $ARGS.positional[1:] | wrap("list")) |
- eval_val("(load-file \($ARGS.positional[0] | tojson))")
+ env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
+ eval_val("(load-file \($ARGS.positional[0] | tojson))")
else
repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
end;
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
-def special_forms:
- [ "if", "def!", "let*", "fn*", "do" ];
-
-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 + special_forms))
- else if "vector" == $dot.kind then
- ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + special_forms))
- else
- []
- end end end;
- _refs | unique;
-
def recurseflip(x; y):
recurse(y; x);
# 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 | {
+ $value[1].value | map(.value) as $binds |
+ ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | {
kind: "function",
binds: $binds,
- env: env,
+ env: (env | env_remove_references($free_referencess)),
body: $value[2],
names: [], # we can't do that circular reference this
- free_referencess: $value[2] | find_free_references($currentEnv | env_dump_keys + $binds) # for dynamically scoped variables
+ free_referencess: $free_referencess # for dynamically scoped variables
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
inputs: 1,
function: "eval"
}
- } + core_identify)
+ } + core_identify),
+ dirty_atoms: [],
+ fallback: null
};
def repl(env):
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
- env_set_($env; "*ARGV*"; $ARGS.positional[1:] | wrap("list")) |
+ env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
eval_val("(load-file \($ARGS.positional[0] | tojson))")
else
repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
end;
-main
\ No newline at end of file
+main
+
+# ( ( (fn* (a) (fn* (b) (+ a b))) 5) 7)
\ No newline at end of file
def read_line:
. as $in
| label $top
- | input;
+ | _readline;
def READ:
read_str | read_form | .value;
-def special_forms:
- [ "if", "def!", "defmacro!", "let*", "fn*", "do", "quote", "unquote", "splice-unquote", "macroexpand" ];
-
-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 + special_forms))
- else if "vector" == $dot.kind then
- ($dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)) + ($dot.value[0] | find_free_references(keys + special_forms))
- else
- []
- end end end;
- _refs | unique;
-
def recurseflip(x; y):
recurse(y; x);
# 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($currentEnv | env_dump_keys + $binds), # for dynamically scoped variables
- is_macro: false
- } | TCOWrap($_menv; $_orig_retenv; false)
+ $value[1].value | map(.value) as $binds |
+ ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | {
+ kind: "function",
+ binds: $binds,
+ env: (env | env_remove_references($free_referencess)),
+ body: $value[2],
+ names: [], # we can't do that circular reference this
+ free_referencess: $free_referencess, # for dynamically scoped variables
+ is_macro: false
+ } | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quote") as $value |
inputs: 1,
function: "eval"
}
- } + core_identify)
+ } + core_identify),
+ dirty_atoms: [],
+ fallback: null
};
def repl(env):
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
- env_set_($env; "*ARGV*"; $ARGS.positional[1:] | wrap("list")) |
+ env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
eval_val("(load-file \($ARGS.positional[0] | tojson))")
else
repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
def isPair(x):
x | isPair;
+def find_free_references(keys):
+ def _refs:
+ if . == null then [] else
+ . as $dot
+ | if .kind == "symbol" then
+ if keys | contains([$dot.value]) then [] else [$dot.value] end
+ else if "list" == $dot.kind then
+ # if - scan args
+ # def! - scan body
+ # let* - add keys sequentially, scan body
+ # fn* - add keys, scan body
+ # quote - []
+ # quasiquote - ???
+ $dot.value[0] as $head
+ | if $head.kind == "symbol" then
+ (
+ select($head.value == "if") | $dot.value[1:] | map(_refs) | reduce .[] as $x ([]; . + $x)
+ ) // (
+ select($head.value == "def!") | $dot.value[2] | _refs
+ ) // (
+ select($head.value == "let*") | $dot.value[2] | find_free_references(($dot.value[1].value | map(.value[0].value)) + keys)
+ ) // (
+ select($head.value == "fn*") | $dot.value[2] | find_free_references(($dot.value[1].value | map(.value)) + keys)
+ ) // (
+ select($head.value == "quote") | []
+ ) // (
+ select($head.value == "quasiquote") | []
+ ) // ($dot.value | map(_refs) | reduce .[] as $x ([]; . + $x))
+ else
+ [ $dot.values[1:][] | _refs ]
+ end
+ else if "vector" == $dot.kind then
+ ($dot.value | map(_refs) | reduce .[] as $x ([]; . + $x))
+ else if "hashmap" == $dot.kind then
+ ([$dot.value | from_entries | map({kind: .value.kkind, value: .key}, .value.value)] | map(_refs) | reduce .[] as $x ([]; . + $x))
+ else
+ []
+ end end end end
+ end;
+ _refs | unique;
+
def tomal:
(
select(type == "array") | (
def _print:
debug;
+def _readline:
+ []
+ | issue_extern("readline"; {nowait: false})
+ ;
+
def _write_to_file(name):
. as $value
| [(name|tojson), (.|tojson), (false|tojson)]
HCoop / jackhill / mal.git / commitdiff