1
1
mirror of https://github.com/kanaka/mal.git synced 2024-09-11 13:55:55 +03:00

add atoms

+ fix lists (lists do not behave like let*)
+ add file io
This commit is contained in:
AnotherTest 2020-01-07 00:25:22 +03:30
parent 7650046a50
commit eedfbb43d8
10 changed files with 141 additions and 50 deletions

View File

@ -83,6 +83,31 @@ def core_identify:
kind: "fn",
function: "slurp",
inputs: 1
},
"atom": {
kind: "fn",
function: "atom",
inputs: 1
},
"atom?": {
kind: "fn",
function: "atom?",
inputs: 1
},
"deref": {
kind: "fn",
function: "deref",
inputs: 1
},
"reset!": { # defined in interp
kind: "fn",
function: "reset!",
inputs: 2
},
"swap!": { # defined in interp
kind: "fn",
function: "swap!",
inputs: -1
}
};
@ -147,4 +172,10 @@ def core_interp(arguments; env):
select(.function == "slurp") | arguments | map(.value) | issue_extern("read") | wrap("string")
) // (
select(.function == "read-string") | arguments | first.value | read_str | read_form.value
) // (
select(.function == "atom") | arguments | first | wrap2("atom"; {names: []})
) // (
select(.function == "atom?") | null | wrap(arguments | first.kind == "atom" | tostring)
) // (
select(.function == "deref") | arguments | first.value
) // jqmal_error("Unknown native function \(.function)");

View File

@ -81,7 +81,7 @@ def env_multiset(env; keys; value):
env | env_multiset(keys; value);
def env_set($key; $value):
(if $value.kind == "function" then
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function of its names
$value | inform_function($key)
else
@ -93,23 +93,23 @@ def env_set($key; $value):
def env_dump_keys:
def _dump:
.environment | keys;
.environment // {} | keys;
if .parent == null then
_dump
else
.parent | env_dump_keys + _dump
(.parent | env_dump_keys + _dump) | unique
end;
def env_set(env; $key; $value):
(if $value.kind == "function" then
# inform the function of its names
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
$value | (.names += [$key]) | (.names |= unique)
else
$value
end) as $value | {
parent: env.parent,
environment: (env.environment + (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
};
def env_find(env):
@ -173,13 +173,20 @@ def env_set6(env; key; value):
env_set(env.currentEnv; key; value) | wrapEnv(env.replEnv)
end;
def env_set_(env; key; value):
if env.currentEnv != null then
env_set6(env; key; value)
else
env_set(env; key; value)
end;
def addToEnv6(envexp; name):
envexp.expr as $value
| envexp.env as $rawEnv
| (if $rawEnv.isReplEnv then
env_set($rawEnv.currentEnv; name; $value) | wrapEnv
env_set_($rawEnv.currentEnv; name; $value) | wrapEnv
else
env_set($rawEnv.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv)
env_set_($rawEnv.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv)
end) as $newEnv
| {
expr: $value,
@ -191,7 +198,7 @@ def addToEnv(envexp; name):
addToEnv6(envexp; name)
else {
expr: envexp.expr,
env: env_set(envexp.env; name; envexp.expr)
env: env_set_(envexp.env; name; envexp.expr)
} end;
# for step2

View File

@ -74,6 +74,14 @@ def cWithReplEnv(renv; cond):
.
end;
def updateAtoms(newEnv):
. as $env
| reduce (newEnv | env_dump_keys | map(env_get(newEnv) as $value | select($value.kind == "atom") | $value))[] as $atom (
$env;
. as $e | reduce $atom.names[] as $name (
$e;
env_set_(.; $name; $atom)));
def interpret(arguments; env; _eval):
extractReplEnv(env) as $replEnv |
hasReplEnv(env) as $hasReplEnv |
@ -88,6 +96,31 @@ def interpret(arguments; env; _eval):
| setpath(
["env", "currentEnv"];
extractEnv(env) | cUpdateReplEnv($xreplenv; $hasReplEnv))
) //
(select(.function == "reset!") |
# env modifying function
arguments[0].names as $names |
arguments[1]|wrap2("atom"; {names: $names}) as $value |
(reduce $names[] as $name (
env;
. as $env | env_set_($env; $name; $value)
)) as $env |
$value.value | addEnv($env)
) //
(select(.function == "swap!") |
# env modifying function
arguments[0].names as $names |
arguments[0].value as $initValue |
arguments[1] as $function |
([$initValue] + arguments[2:]) as $args |
($function | interpret($args; env; _eval)) as $newEnvValue |
$newEnvValue.expr|wrap2("atom"; {names: $names}) as $newValue |
$newEnvValue.env as $newEnv |
(reduce $names[] as $name (
$newEnv;
. as $env | env_set_($env; $name; $newValue)
)) as $newEnv |
$newValue.value | addEnv($newEnv)
) //
(core_interp(arguments; env) | addEnv(env))
) //
@ -97,7 +130,7 @@ def interpret(arguments; env; _eval):
# tell it about its surroundings
(reduce $fn.free_referencess[] as $name (
$fnEnv;
. as $env | try env_set(
. as $env | try env_set_(
.;
$name;
$name | env_get(env) | . as $xvalue
@ -114,15 +147,16 @@ def interpret(arguments; env; _eval):
| cWrapEnv($replEnv; $hasReplEnv),
expr: $fn.body
}
| _eval
| _eval
| . as $envexp
| extractReplEnv($envexp.env) as $xreplenv
| (extractReplEnv($envexp.env)) as $xreplenv
|
{
expr: .expr,
env: extractEnv(env)
| cUpdateReplEnv($xreplenv; $hasReplEnv)
| cWrapEnv($xreplenv; $hasReplEnv)
| updateAtoms(extractEnv($envexp.env))
}
) //
jqmal_error("Unsupported function kind \(.kind)");

View File

@ -19,6 +19,7 @@ def pr_str(opt):
(select(.kind == "false") | "false") //
(select(.kind == "fn") | "#<fn>") //
(select(.kind == "function")| "#<function \([":anon"] + .names | join(", "))>") //
(select(.kind == "atom")| "(atom \(.value | pr_str(opt)))") //
"#<Unknown \(.kind) in \(.)>";
def pr_str:

15
jq/run
View File

@ -30,10 +30,17 @@ runjq() {
rm $tmp
;;
fwrite)
filename=$(echo "$command" | jq -Mrc ".args[0]|fromjson")
content=$(echo "$command" | jq -Mrc ".args[1]|fromjson")
echo "Writing stuff to $filename"
echo "$content" > "$filename"
tmp=$(mktemp)
echo "$command" > $tmp
filename=$(cat $tmp | jq -Mrc ".args[0]|fromjson")
content=$(cat $tmp | jq -Mrc ".args[1]|fromjson")
app=$(cat $tmp | jq -Mrc ".args[2]|fromjson")
echo "'$app': Writing stuff to $filename"
if [[ $res == false ]]; then
echo "$content" > "$filename"
else
echo "$content" >> "$filename"
fi
;;
*)
echo $cmd

View File

@ -58,13 +58,10 @@ def EVAL(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
[];
. as $dot | $elem | EVAL(env) as $eval_env |
($dot + [$eval_env.expr])
) | { expr: ., env: env } as $ev
| $ev.expr | first |
interpret($ev.expr[1:]; $ev.env; _eval_here)
) //

View File

@ -124,13 +124,10 @@ def EVAL(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
[];
. as $dot | $elem | EVAL(env) as $eval_env |
($dot + [$eval_env.expr])
) | { expr: ., env: env } as $ev
| $ev.expr | first |
interpret($ev.expr[1:]; $ev.env; _eval_here)
) //

View File

@ -124,13 +124,10 @@ def EVAL(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
[];
. as $dot | $elem | EVAL(env) as $eval_env |
($dot + [$eval_env.expr])
) | { expr: ., env: env } as $ev
| $ev.expr | first |
interpret($ev.expr[1:]; $ev.env; _eval_here)
) //

View File

@ -58,8 +58,14 @@ def EVAL(env):
else
$list[0] as $elem |
$list[1:] as $rest |
$elem[1] | EVAL($env) as $resv |
{ value: [$elem[0], $resv.expr], env: env },
$elem.value.value | EVAL($env) as $resv |
{
value: {
key: $elem.key,
value: { kkind: $elem.value.kkind, value: $resv.expr }
},
env: env
},
({env: $resv.env, list: $rest} | hmap_with_env)
end;
def map_with_env:
@ -93,7 +99,7 @@ def EVAL(env):
(reduce ($value[1].value | nwise(2)) as $xvalue (
$subenv;
. as $env | $xvalue[1] | EVAL($env) as $expenv |
env_set6($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
| $value[2] | { expr: EVAL($env).expr, env: env }
) //
(
@ -128,13 +134,10 @@ def EVAL(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
[];
. as $dot | $elem | EVAL(env) as $eval_env |
($dot + [$eval_env.expr])
) | { expr: ., env: env } as $ev
| $ev.expr | first |
interpret($ev.expr[1:]; $ev.env; _eval_here)
) //
@ -157,7 +160,7 @@ def EVAL(env):
end
) //
(select(.kind == "hashmap") |
[ { env: env, list: .value | to_entries } | hmap_with_env ] as $res |
[ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
@ -236,4 +239,6 @@ repl(
| wrapEnv
| eval_ign("(def! not (fn* (a) (if a false true)))")
| eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))")
| . as $env
| env_set_($env; "*ARGV*"; $ARGS.positional | wrap("list"))
)

View File

@ -19,6 +19,12 @@ def wrap(kind):
value: .
};
def wrap2(kind; opts):
opts + {
kind: kind,
value: .
};
def _extern(options):
{command: .}
| debug
@ -41,6 +47,15 @@ def _print:
def _write_to_file(name):
. as $value
| [name, .|tojson]
| [(name|tojson), (.|tojson), (false|tojson)]
| issue_extern("fwrite"; {nowait: true})
| $value;
| $value;
def _append_to_file(name):
. as $value
| [(name|tojson), (.|tojson), (true|tojson)]
| issue_extern("fwrite"; {nowait: true})
| $value;
def trap:
_write_to_file("trap_reason.json") | jqmal_error("trap");