kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-08-16 09:10:48 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #488 from alimpfard/main+jq

Browse Source 
Add Jq implementation
This commit is contained in:
Joel Martin 2020-01-13 16:48:46 -06:00 committed by GitHub
commit 95458d69c5
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
24 changed files with 4874 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.travis.yml
View File

@ -46,6 +46,7 @@ matrix:
- {env: IMPL=hy, services: [docker]}
- {env: IMPL=io NO_SELF_HOST_PERF=1, services: [docker]} # perf OOM
- {env: IMPL=java, services: [docker]}
- {env: IMPL=jq, services: [docker]}
- {env: IMPL=js, services: [docker]}
- {env: IMPL=julia, services: [docker]}
- {env: IMPL=kotlin, services: [docker]}

3
Makefile
View File

@ -91,7 +91,7 @@ DOCKERIZE =
IMPLS = ada ada.2 awk bash basic bbc-basic c chuck clojure coffee common-lisp cpp crystal cs d dart \
elisp elixir elm erlang es6 factor fantom forth fsharp go groovy gnu-smalltalk \
guile haskell haxe hy io java js julia kotlin livescript logo lua make mal \
guile haskell haxe hy io java js jq julia kotlin livescript logo lua make mal \
matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \
plsql powershell ps python python.2 r racket rexx rpython ruby rust scala scheme skew \
swift swift3 swift4 swift5 tcl ts vala vb vhdl vimscript wasm wren yorick zig
@ -218,6 +218,7 @@ hy_STEP_TO_PROG = hy/$($(1)).hy
io_STEP_TO_PROG = io/$($(1)).io
java_STEP_TO_PROG = java/target/classes/mal/$($(1)).class
js_STEP_TO_PROG = js/$($(1)).js
jq_STEP_PROG = jq/$($(1)).jq
julia_STEP_TO_PROG = julia/$($(1)).jl
kotlin_STEP_TO_PROG = kotlin/$($(1)).jar
livescript_STEP_TO_PROG = livescript/$($(1)).js

14
README.md
View File

@ -6,7 +6,7 @@
**1. Mal is a Clojure inspired Lisp interpreter**
**2. Mal is implemented in 80 languages (83 different implementations and 103 runtime modes)**
**2. Mal is implemented in 81 languages (84 different implementations and 104 runtime modes)**
| Language | Creator |
| -------- | ------- |
@ -45,6 +45,7 @@
| [Io](#io) | [Dov Murik](https://github.com/dubek) |
| [Java](#java-17) | [Joel Martin](https://github.com/kanaka) |
| [JavaScript](#javascriptnode) ([Demo](http://kanaka.github.io/mal)) | [Joel Martin](https://github.com/kanaka) |
| [Jq](#jq) | [Ali MohammadPur](https://github.com/alimpfard) |
| [Julia](#julia) | [Joel Martin](https://github.com/kanaka) |
| [Kotlin](#kotlin) | [Javier Fernandez-Ivern](https://github.com/ivern) |
| [LiveScript](#livescript) | [Jos van Bakel](https://github.com/c0deaddict) |
@ -604,6 +605,17 @@ cd julia
julia stepX_YYY.jl
```
### Jq
Tested against version 1.6, with a lot of cheating in the IO department
```
cd jq
STEP=stepA_YYY ./run
# with Debug
DEBUG=true STEP=stepA_YYY ./run
```
### Kotlin
The Kotlin implementation of mal has been tested with Kotlin 1.0.

32
jq/Dockerfile Normal file
View File

@ -0,0 +1,32 @@
FROM ubuntu:bionic
MAINTAINER Joel Martin <github@martintribe.org>
##########################################################
# General requirements for testing or common across many
# implementations
##########################################################
RUN apt-get -y update
# Required for running tests
RUN apt-get -y install make python
# Some typical implementation and test requirements
RUN apt-get -y install curl libreadline-dev libedit-dev libpcre3-dev
RUN mkdir -p /mal
WORKDIR /mal
#########################################################
# Specific implementation requirements
#########################################################
RUN apt-get -y install python3.8 wget
RUN update-alternatives --install /usr/bin/python python /usr/bin/python3.8 10
# grab jq 1.6 from github releases
RUN wget https://github.com/stedolan/jq/releases/download/jq-1.6/jq-linux64
RUN chmod +x jq-linux64
# a bit ugly, but it'll do?
RUN mv jq-linux64 /usr/bin/jq

1
jq/Makefile Normal file
View File

@ -0,0 +1 @@
all:

485
jq/core.jq Normal file
View File

@ -0,0 +1,485 @@
include "utils";
include "printer";
include "reader";
def core_identify:
{
"env": {
kind: "fn",
function: "env",
inputs: 0
},
"prn": {
kind: "fn",
function: "prn",
inputs: -1
},
"pr-str": {
kind: "fn",
function: "pr-str",
inputs: -1
},
"str": {
kind: "fn",
function: "str",
inputs: -1
},
"println": {
kind: "fn",
function: "println",
inputs: -1
},
"list": {
kind: "fn",
function: "list",
inputs: -1
},
"list?": {
kind: "fn",
function: "list?",
inputs: 1
},
"empty?": {
kind: "fn",
function: "empty?",
inputs: 1
},
"count": {
kind: "fn",
function: "count",
inputs: 1
},
"=": {
kind: "fn",
function: "=",
inputs: 2
},
"<": {
kind: "fn",
function: "<",
inputs: 2
},
"<=": {
kind: "fn",
function: "<=",
inputs: 2
},
">": {
kind: "fn",
function: ">",
inputs: 2
},
">=": {
kind: "fn",
function: ">=",
inputs: 2
},
"read-string": {
kind: "fn",
function: "read-string",
inputs: 1
},
"slurp": {
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: -3
},
"cons": {
kind: "fn",
function: "cons",
inputs: 2
},
"concat": {
kind: "fn",
function: "concat",
inputs: -1
},
"nth": {
kind: "fn",
function: "nth",
inputs: 2
},
"first": {
kind: "fn",
function: "first",
inputs: 1
},
"rest": {
kind: "fn",
function: "rest",
inputs: 1
},
"throw": {
kind: "fn",
function: "throw",
inputs: 1
},
"apply": { # defined in interp
kind: "fn",
function: "apply",
inputs: -3
},
"map": { # defined in interp
kind: "fn",
function: "map",
inputs: 2
},
"nil?": {
kind: "fn",
function: "nil?",
inputs: 1
},
"true?": {
kind: "fn",
function: "true?",
inputs: 1
},
"false?": {
kind: "fn",
function: "false?",
inputs: 1
},
"symbol": {
kind: "fn",
function: "symbol",
inputs: 1
},
"symbol?": {
kind: "fn",
function: "symbol?",
inputs: 1
},
"keyword": {
kind: "fn",
function: "keyword",
inputs: 1
},
"keyword?": {
kind: "fn",
function: "keyword?",
inputs: 1
},
"vector": {
kind: "fn",
function: "vector",
inputs: -1
},
"vector?": {
kind: "fn",
function: "vector?",
inputs: 1
},
"sequential?": {
kind: "fn",
function: "sequential?",
inputs: 1
},
"hash-map": {
kind: "fn",
function: "hash-map",
inputs: -1
},
"map?": {
kind: "fn",
function: "map?",
inputs: 1
},
"assoc": {
kind: "fn",
function: "assoc",
inputs: -2
},
"dissoc": {
kind: "fn",
function: "dissoc",
inputs: -2
},
"get": {
kind: "fn",
function: "get",
inputs: 2
},
"contains?": {
kind: "fn",
function: "contains?",
inputs: 2
},
"keys": {
kind: "fn",
function: "keys",
inputs: 1
},
"vals": {
kind: "fn",
function: "vals",
inputs: 1
},
"string?": {
kind: "fn",
function: "string?",
inputs: 1
},
"fn?": {
kind: "fn",
function: "fn?",
inputs: 1
},
"number?": {
kind: "fn",
function: "number?",
inputs: 1
},
"macro?": {
kind: "fn",
function: "macro?",
inputs: 1
},
"readline": {
kind: "fn",
function: "readline",
inputs: 1
},
"time-ms": {
kind: "fn",
function: "time-ms",
inputs: 0
},
"meta": {
kind: "fn",
function: "meta",
inputs: 1
},
"with-meta": {
kind: "fn",
function: "with-meta",
inputs: 2
},
"seq": {
kind: "fn",
function: "seq",
inputs: 1
},
"conj": {
kind: "fn",
function: "conj",
inputs: -3
}
};
def vec2list(obj):
if obj.kind == "list" then
obj.value | map(vec2list(.)) | wrap("list")
else
if obj.kind == "vector" then
obj.value | map(vec2list(.)) | wrap("list")
else
if obj.kind == "hashmap" then
obj.value | map_values(.value |= vec2list(.)) | wrap("hashmap")
else
obj
end
end
end;
def make_sequence:
. as $dot
| if .value|length == 0 then null | wrap("nil") else
(
select(.kind == "string") | .value | split("") | map(wrap("string"))
) // (
select(.kind == "list" or .kind == "vector") | .value
) // jqmal_error("cannot make sequence from \(.kind)") | wrap("list")
end;
def core_interp(arguments; env):
(
select(.function == "number_add") |
arguments | map(.value) | .[0] + .[1] | wrap("number")
) // (
select(.function == "number_sub") |
arguments | map(.value) | .[0] - .[1] | wrap("number")
) // (
select(.function == "number_mul") |
arguments | map(.value) | .[0] * .[1] | wrap("number")
) // (
select(.function == "number_div") |
arguments | map(.value) | .[0] / .[1] | wrap("number")
) // (
select(.function == "env") |
env | tojson | wrap("string")
) // (
select(.function == "prn") |
arguments | map(pr_str(env; {readable: true})) | join(" ") | _display | null | wrap("nil")
) // (
select(.function == "pr-str") |
arguments | map(pr_str(env; {readable: true})) | join(" ") | wrap("string")
) // (
select(.function == "str") |
arguments | map(pr_str(env; {readable: false})) | join("") | wrap("string")
) // (
select(.function == "println") |
arguments | map(pr_str(env; {readable: false})) | join(" ") | _display | null | wrap("nil")
) // (
select(.function == "list") |
arguments | wrap("list")
) // (
select(.function == "list?") | null | wrap(arguments | first.kind == "list" | tostring)
) // (
select(.function == "empty?") | null | wrap(arguments|first.value | length == 0 | tostring)
) // (
select(.function == "count") | arguments|first.value | length | wrap("number")
) // (
select(.function == "=") | null | wrap(vec2list(arguments[0]) == vec2list(arguments[1]) | tostring)
) // (
select(.function == "<") | null | wrap(arguments[0].value < arguments[1].value | tostring)
) // (
select(.function == "<=") | null | wrap(arguments[0].value <= arguments[1].value | tostring)
) // (
select(.function == ">") | null | wrap(arguments[0].value > arguments[1].value | tostring)
) // (
select(.function == ">=") | null | wrap(arguments[0].value >= arguments[1].value | tostring)
) // (
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?") | null | wrap(arguments | first.kind == "atom" | tostring)
) // (
select(.function == "cons") | ([arguments[0]] + arguments[1].value) | wrap("list")
) // (
select(.function == "concat") | arguments | map(.value) | (add//[]) | wrap("list")
) // (
select(.function == "nth")
| _debug(arguments)
| arguments[0].value as $lst
| arguments[1].value as $idx
| if ($lst|length < $idx) or ($idx < 0) then
jqmal_error("index out of range")
else
$lst[$idx]
end
) // (
select(.function == "first") | arguments[0].value | first // {kind:"nil"}
) // (
select(.function == "rest") | arguments[0]?.value?[1:]? // [] | wrap("list")
) // (
select(.function == "throw") | jqmal_error(arguments[0] | tojson)
) // (
select(.function == "nil?") | null | wrap((arguments[0].kind == "nil") | tostring)
) // (
select(.function == "true?") | null | wrap((arguments[0].kind == "true") | tostring)
) // (
select(.function == "false?") | null | wrap((arguments[0].kind == "false") | tostring)
) // (
select(.function == "symbol?") | null | wrap((arguments[0].kind == "symbol") | tostring)
) // (
select(.function == "symbol") | arguments[0].value | wrap("symbol")
) // (
select(.function == "keyword") | arguments[0].value | wrap("keyword")
) // (
select(.function == "keyword?") | null | wrap((arguments[0].kind == "keyword") | tostring)
) // (
select(.function == "vector") | arguments | wrap("vector")
) // (
select(.function == "vector?") | null | wrap((arguments[0].kind == "vector") | tostring)
) // (
select(.function == "sequential?") | null | wrap((arguments[0].kind == "vector" or arguments[0].kind == "list") | tostring)
) // (
select(.function == "hash-map") |
if (arguments|length) % 2 == 1 then
jqmal_error("Odd number of arguments to hash-map")
else
[ arguments |
nwise(2) |
try {
key: (.[0] | extract_string),
value: {
kkind: .[0].kind,
value: .[1]
}
}
] | from_entries | wrap("hashmap")
end
) // (
select(.function == "map?") | null | wrap((arguments[0].kind == "hashmap") | tostring)
) // (
select(.function == "assoc") |
if (arguments|length) % 2 == 0 then
jqmal_error("Odd number of key-values to assoc")
else
arguments[0].value + ([ arguments[1:] |
nwise(2) |
try {
key: (.[0] | extract_string),
value: {
kkind: .[0].kind,
value: .[1]
}
}
] | from_entries) | wrap("hashmap")
end
) // (
select(.function == "dissoc") |
arguments[1:] | map(.value) as $keynames |
arguments[0].value | with_entries(select(.key as $k | $keynames | contains([$k]) | not)) | wrap("hashmap")
) // (
select(.function == "get") | arguments[0].value[arguments[1].value].value // {kind:"nil"}
) // (
select(.function == "contains?") | null | wrap((arguments[0].value | has(arguments[1].value)) | tostring)
) // (
select(.function == "keys") | arguments[0].value | with_entries(.value as $v | .key as $k | {key: $k, value: {value: $k, kind: $v.kkind}}) | to_entries | map(.value) | wrap("list")
) // (
select(.function == "vals") | arguments[0].value | map(.value) | to_entries | map(.value) | wrap("list")
) // (
select(.function == "string?") | null | wrap((arguments[0].kind == "string") | tostring)
) // (
select(.function == "fn?") | null | wrap((arguments[0].kind == "fn" or (arguments[0].kind == "function" and (arguments[0].is_macro|not))) | tostring)
) // (
select(.function == "number?") | null | wrap((arguments[0].kind == "number") | tostring)
) // (
select(.function == "macro?") | null | wrap((arguments[0].is_macro == true) | tostring)
) // (
select(.function == "readline") | arguments[0].value | __readline | wrap("string")
) // (
select(.function == "time-ms") | now * 1000 | wrap("number")
) // (
select(.function == "meta") | arguments[0].meta // {kind:"nil"}
) // (
select(.function == "with-meta") | arguments[0] | .meta |= arguments[1]
) // (
select(.function == "seq") | arguments[0] | make_sequence
) // (
select(.function == "conj")
| arguments[0] as $orig
| arguments[1:] as $stuff
| if $orig.kind == "list" then
[ $stuff|reverse[], $orig.value[] ] | wrap("list")
else
[ $orig.value[], $stuff[] ] | wrap("vector")
end
) // jqmal_error("Unknown native function \(.function)");

284
jq/env.jq Normal file
View File

@ -0,0 +1,284 @@
include "utils";
def childEnv(binds; exprs):
{
parent: .,
fallback: null,
environment: [binds, exprs] | transpose | (
. as $dot | reduce .[] as $item (
{ value: [], seen: false, name: null, idx: 0 };
if $item[1] != null then
if .seen then
{
value: (.value[1:-1] + (.value|last[1].value += [$item[1]])),
seen: true,
name: .name
}
else
if $item[0] == "&" then
$dot[.idx+1][0] as $name | {
value: (.value + [[$name, {kind:"list", value: [$item[1]]}]]),
seen: true,
name: $name
}
else
{
value: (.value + [$item]),
seen: false,
name: null
}
end
end | (.idx |= .idx + 1)
else
if $item[0] == "&" then
$dot[.idx+1][0] as $name | {
value: (.value + [[$name, {kind:"list", value: []}]]),
seen: true,
name: $name
}
else . end
end
)
) | .value | map({(.[0]): .[1]}) | add
};
def pureChildEnv:
{
parent: .,
environment: {},
fallback: null
};
def rootEnv:
{
parent: null,
fallback: null,
environment: {}
};
def inform_function(name):
(.names += [name]) | (.names |= unique);
def inform_function_multi(names):
. as $dot | reduce names[] as $name(
$dot;
inform_function($name)
);
def env_multiset(keys; value):
(if value.kind == "function" then # multiset not allowed on atoms
value | inform_function_multi(keys)
else
value
end) as $value | {
parent: .parent,
environment: (
.environment + (reduce keys[] as $key(.environment; .[$key] |= value))
),
fallback: .fallback
};
def env_multiset(env; keys; value):
env | env_multiset(keys; value);
def env_set($key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
($value |
if $value.kind == "atom" then
# check if the one we have is newer
env_req(env; key) as $ours |
if $ours.last_modified > $value.last_modified then
$ours
else
# update modification timestamp
$value | .last_modified |= now
end
else
.
end) | inform_function($key)
else
$value
end) as $value | {
parent: .parent,
environment: (.environment + (.environment | .[$key] |= $value)), # merge together, as .environment[key] |= value does not work
fallback: .fallback
};
def env_dump_keys:
def _dump1:
.environment // {} | keys;
if . == null then [] else
if .parent == null then
(
_dump1 +
(.fallback | env_dump_keys)
)
else
(
_dump1 +
(.parent | env_dump_keys) +
(.fallback | env_dump_keys)
)
end | unique
end;
def env_find(env):
if env.environment[.] == null then
if env.parent then
env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end
else
null
end
else
env
end;
def env_get(env):
. as $key | $key | env_find(env).environment[$key] as $value |
if $value == null then
jqmal_error("'\($key)' not found")
else
if $value.kind == "atom" then
$value.identity as $id |
$key | env_find(env.parent).environment[$key] as $possibly_newer |
if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
$possibly_newer
else
$value
end
else
$value
end
end;
def env_get(env; key):
key | env_get(env);
def env_req(env; key):
key as $key | key | env_find(env).environment[$key] as $value |
if $value == null then
null
else
if $value.kind == "atom" then
$value.identity as $id |
$key | env_find(env.parent).environment[$key] as $possibly_newer |
if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
$possibly_newer
else
$value
end
else
$value
end
end;
def env_set(env; $key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
$value | (.names += [$key]) | (.names |= unique) |
if $value.kind == "atom" then
# check if the one we have is newer
env_req(env; $key) as $ours |
if $ours.last_modified > $value.last_modified then
$ours
else
# update modification timestamp
$value | .last_modified |= now
end
else
.
end
else
$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
fallback: env.fallback
};
def env_setfallback(env; fallback):
{
parent: env.parent,
fallback: fallback,
environment: env.environment
};
def addEnv(env):
{
expr: .,
env: env
};
def addToEnv(env; name; expr):
{
expr: expr,
env: env_set(env; name; expr)
};
def wrapEnv(atoms):
{
replEnv: .,
currentEnv: .,
atoms: atoms,
isReplEnv: true
};
def wrapEnv(replEnv; atoms):
{
replEnv: replEnv,
currentEnv: .,
atoms: atoms, # id -> value
isReplEnv: (replEnv == .) # should we allow separate copies?
};
def unwrapReplEnv:
.replEnv;
def unwrapCurrentEnv:
.currentEnv;
def env_set6(env; key; value):
if env.isReplEnv then
env_set(env.currentEnv; key; value) | wrapEnv(env.atoms)
else
env_set(env.currentEnv; key; value) | wrapEnv(env.replEnv; env.atoms)
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 addToEnv(envexp; name):
envexp.expr as $value
| envexp.env as $rawEnv
| (if $rawEnv.isReplEnv then
env_set_($rawEnv.currentEnv; name; $value) | wrapEnv($rawEnv.atoms)
else
env_set_($rawEnv.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv; $rawEnv.atoms)
end) as $newEnv
| {
expr: $value,
env: $newEnv
};
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))
}
else . end;
def env_remove_references(refs):
. as $env
| if has("replEnv") then
.currentEnv |= _env_remove_references(refs)
else
_env_remove_references(refs)
end;

178
jq/interp.jq Normal file
View File

@ -0,0 +1,178 @@
include "utils";
include "core";
include "env";
include "printer";
def arg_check(args):
if .inputs < 0 then
if (abs(.inputs) - 1) > (args | length) then
jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))")
else
.
end
else if .inputs != (args|length) then
jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))")
else
.
end end;
def extractReplEnv(env):
env | .replEnv // .;
def extractEnv(env):
env | .currentEnv // .;
def updateReplEnv(renv):
def findpath:
if .env.parent then
.path += ["parent"] |
.env |= .parent |
findpath
else
.path
end;
({ env: ., path: [] } | findpath) as $path |
setpath($path; renv);
def extractCurrentReplEnv(env):
def findpath:
if .env.parent then
.path += ["parent"] |
.env |= .parent |
findpath
else
.path
end;
if env.currentEnv != null then
({ env: env.currentEnv, path: [] } | findpath) as $path |
env.currentEnv | getpath($path)
else
env
end;
def extractAtoms(env):
env.atoms // {};
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 |
extractAtoms(env) as $envAtoms |
(if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) |
(select(.kind == "fn") |
arg_check(arguments) |
(select(.function == "eval") |
# special function
{ expr: arguments[0], env: $replEnv|wrapEnv($replEnv; $envAtoms) }
| _eval
| .env as $xenv
| extractReplEnv($xenv) as $xreplenv
| setpath(
["env", "currentEnv"];
extractEnv(env) | updateReplEnv($xreplenv))
) //
(select(.function == "reset!") |
# env modifying function
arguments[0].identity as $id |
($envAtoms | setpath([$id]; arguments[1])) as $envAtoms |
arguments[1] | addEnv(env | setpath(["atoms"]; $envAtoms))
) //
(select(.function == "swap!") |
# env modifying function
arguments[0].identity as $id |
$envAtoms[$id] as $initValue |
arguments[1] as $function |
([$initValue] + arguments[2:]) as $args |
($function | interpret($args; env; _eval)) as $newEnvValue |
($envAtoms | setpath([$id]; $newEnvValue.expr)) as $envAtoms |
$newEnvValue.expr | addEnv(env | setpath(["atoms"]; $envAtoms))
) // (select(.function == "atom") |
(now|tostring) as $id |
{kind: "atom", identity: $id} as $value |
($envAtoms | setpath([$id]; arguments[0])) as $envAtoms |
$value | addEnv(env | setpath(["atoms"]; $envAtoms))
) // (select(.function == "deref") |
$envAtoms[arguments[0].identity] | addEnv(env)
) //
(select(.function == "apply") |
# (apply F ...T A) -> (F ...T ...A)
arguments as $args
| ($args|first) as $F
| ($args|last.value) as $A
| $args[1:-1] as $T
| $F | interpret([$T[], $A[]]; env; _eval)
) //
(select(.function == "map") |
arguments
| first as $F
| last.value as $L
| (reduce $L[] as $elem (
{env: env, val: []};
. as $dot |
($F | interpret([$elem]; $dot.env; _eval)) as $val |
{
val: (.val + [$val.expr]),
env: (.env | setpath(["atoms"]; $val.env.atoms))
}
)) as $ex
| $ex.val | wrap("list") | addEnv($ex.env)
) //
(core_interp(arguments; env) | addEnv(env))
) //
(select(.kind == "function") as $fn |
# todo: arg_check
(.body | pr_str(env)) 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;
. 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)
| wrapEnv($replEnv; $envAtoms),
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
|
{
expr: .expr,
env: extractEnv(env)
| updateReplEnv($xreplenv)
| wrapEnv($xreplenv; $envexp.env.atoms)
}
# | . 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)");

29
jq/printer.jq Normal file
View File

@ -0,0 +1,29 @@
# {key: string, value: {kkind: kind, value: value}} -> [{kind: value.kkind, value: key}, value.value]
def _reconstruct_hash:
map([{
kind: .value.kkind,
value: .key
},
.value.value]);
def pr_str(env; opt):
(select(.kind == "symbol") | .value) //
(select(.kind == "string") | .value | if opt.readable then tojson else . end) //
(select(.kind == "keyword") | ":\(.value)") //
(select(.kind == "number") | .value | tostring) //
(select(.kind == "list") | .value | map(pr_str(env; opt)) | join(" ") | "(\(.))") //
(select(.kind == "vector") | .value | map(pr_str(env; opt)) | join(" ") | "[\(.)]") //
(select(.kind == "hashmap") | .value | to_entries | _reconstruct_hash | add // [] | map(pr_str(env; opt)) | join(" ") | "{\(.)}") //
(select(.kind == "nil") | "nil") //
(select(.kind == "true") | "true") //
(select(.kind == "false") | "false") //
(select(.kind == "fn") | "#<fn \(.function)>") //
(select(.kind == "function")| "#<function \([":anon"] + .names | join(", "))>") //
(select(.kind == "atom") | "(atom \(env.atoms[.identity] | pr_str(env; opt)))") //
"#<Unknown \(.kind) in \(.)>";
def pr_str(env):
pr_str(env; {readable: true});
def pr_str:
pr_str(null); # for stepX where X<6

311
jq/reader.jq Normal file
View File

@ -0,0 +1,311 @@
include "utils";
def tokenize:
[ . | scan("[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;.*|[^\\s\\[\\]{}('\"`,;)]*)") | select(.|length > 0)[0] | select(.[0:1] != ";") ];
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:
gsub("(?<z>[\u0000-\u001f])"; "\(.z | escape_control)") | fromjson;
def extract_string:
. as $val | if ["keyword", "symbol", "string"] | contains([$val.kind]) then
$val.value
else
jqmal_error("assoc called with non-string key of type \($val.kind)")
end;
# stuff comes in as {tokens: [...], <stuff unrelated to us>}
def read_atom:
(.tokens | first) as $lookahead | . | (
if $lookahead == "nil" then
{
tokens: .tokens[1:],
value: {
kind: "nil"
}
}
else if $lookahead == "true" then
{
tokens: .tokens[1:],
value: {
kind: "true"
}
}
else if $lookahead == "false" then
{
tokens: .tokens[1:],
value: {
kind: "false"
}
}
else if $lookahead | test("^\"") then
if $lookahead | test("^\"(?:\\\\.|[^\\\\\"])*\"$") then
{
tokens: .tokens[1:],
value: {
kind: "string",
value: $lookahead | read_string
}
}
else
jqmal_error("EOF while reading string")
end
else if $lookahead | test("^:") then
{
tokens: .tokens[1:],
value: {
kind: "keyword",
value: $lookahead[1:]
}
}
else if $lookahead | test("^-?[0-9]+(?:\\.[0-9]+)?$") then
{
tokens: .tokens[1:],
value: {
kind: "number",
value: $lookahead | tonumber
}
}
else if [")", "]", "}"] | contains([$lookahead]) then # this isn't our business
empty
else
{
tokens: .tokens[1:],
value: {
kind: "symbol",
value: $lookahead
}
}
end end end end end end end
);
def read_form_(depth):
(.tokens | first) as $lookahead | . | (
if $lookahead == null then
null
# read_list
else
if $lookahead | test("^\\(") then
[ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish;
if try (.tokens | first | test("^\\)")) catch true then
.finish |= true
else
. as $orig | read_form_(depth+1) as $res | {
tokens: $res.tokens,
value: ($orig.value + [$res.value]),
finish: $orig.finish
}
end)) ] | map(select(.tokens)) | last as $result |
if $result.tokens | first != ")" then
jqmal_error("unbalanced parentheses in \($result.tokens)")
else
{
tokens: $result.tokens[1:],
value: {
kind: "list",
value: $result.value
},
}
end
# read_list '['
else if $lookahead | test("^\\[") then
[ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish;
if try (.tokens | first | test("^\\]")) catch true then
.finish |= true
else
. as $orig | read_form_(depth+1) as $res | {
tokens: $res.tokens,
value: ($orig.value + [$res.value]),
finish: $orig.finish
}
end)) ] | map(select(.tokens)) | last as $result |
if $result.tokens | first != "]" then
jqmal_error("unbalanced brackets in \($result.tokens)")
else
{
tokens: $result.tokens[1:],
value: {
kind: "vector",
value: $result.value
},
}
end
# read_list '{'
else if $lookahead | test("^\\{") then
[ (.tokens |= .[1:]) | {tokens: .tokens, value: [], finish: false} | (until(.finish;
if try (.tokens | first | test("^\\}")) catch true then
.finish |= true
else
. as $orig | read_form_(depth+1) as $res | {
tokens: $res.tokens,
value: ($orig.value + [$res.value]),
finish: $orig.finish
}
end)) ] | map(select(.tokens)) | last as $result |
if $result.tokens | first != "}" then
jqmal_error("unbalanced braces in \($result.tokens)")
else
if $result.value | length % 2 == 1 then
# odd number of elements not allowed
jqmal_error("Odd number of parameters to assoc")
else
{
tokens: $result.tokens[1:],
value: {
kind: "hashmap",
value:
[ $result.value |
nwise(2) |
try {
key: (.[0] | extract_string),
value: {
kkind: .[0].kind,
value: .[1]
}
}
] | from_entries
}
}
end
end
# quote
else if $lookahead == "'" then
(.tokens |= .[1:]) | read_form_(depth+1) | (
{
tokens: .tokens,
value: {
kind: "list",
value: [
{
kind: "symbol",
value: "quote"
},
.value
]
}
})
# quasiquote
else if $lookahead == "`" then
(.tokens |= .[1:]) | read_form_(depth+1) | (
{
tokens: .tokens,
value: {
kind: "list",
value: [
{
kind: "symbol",
value: "quasiquote"
},
.value
]
}
})
# unquote
else if $lookahead == "~" then
(.tokens |= .[1:]) | read_form_(depth+1) | (
{
tokens: .tokens,
value: {
kind: "list",
value: [
{
kind: "symbol",
value: "unquote"
},
.value
]
}
})
# split-unquote
else if $lookahead == "~@" then
(.tokens |= .[1:]) | read_form_(depth+1) | (
{
tokens: .tokens,
value: {
kind: "list",
value: [
{
kind: "symbol",
value: "splice-unquote"
},
.value
]
}
})
# deref
else if $lookahead == "@" then
(.tokens |= .[1:]) | read_form_(depth+1) | (
{
tokens: .tokens,
value: {
kind: "list",
value: [
{
kind: "symbol",
value: "deref"
},
.value
]
}
})
# with-meta
else if $lookahead == "^" then
(.tokens |= .[1:]) | read_form_(depth+1) as $meta | $meta | read_form_(depth+1) as $value | (
{
tokens: $value.tokens,
value: {
kind: "list",
value: [
{
kind: "symbol",
value: "with-meta"
},
$value.value,
$meta.value
]
}
})
else
. as $prev | read_atom
end end end end end end end end end end);
def read_form:
{tokens: .} | read_form_(0);

112
jq/rts.py Normal file
View File

@ -0,0 +1,112 @@
import os
from os import fork, execv, pipe, close, dup2, kill, read, write
from select import select
import json
from os.path import dirname, realpath
from os import environ
import signal
from sys import argv
import fcntl
DEBUG = False
HALT = False
# Bestow IO upon jq
def _read(fname, out=None):
with open(fname, "r") as f:
data = json.dumps(f.read()) + "\n"
# print("data =", data)
write(out, bytes(data, 'utf-8'))
def _readline(prompt="", out=None):
data = json.dumps(input(prompt)) + "\n"
# print("data =", data)
write(out, bytes(data, 'utf-8'))
def _fwrite(fname, data, out=None):
return
def _halt(out=None):
global HALT
HALT = True
def stub(*args, out=None):
raise Exception("command not understood")
rts = {
"read": _read,
"readline": _readline,
"fwrite": _fwrite,
"halt": _halt,
}
def process(cmd, fout):
if type(cmd) == str:
print(cmd, end="")
elif type(cmd) == dict:
cmd = cmd['command']
command = cmd['cmd']
args = cmd['args']
fn = rts.get(command, stub)
fn(*args, out=fout)
def get_one(fd):
s = b""
while True:
x = read(fd, 1)
if x == b'\n':
break
if x == b'':
break
s += x
if s == "":
return None
return s.decode('utf-8')
def main(args):
args = [
"jq", "--argjson", "DEBUG", json.dumps(DEBUG), "-nrRM",
"-f",
dirname(realpath(__file__)) + "/" + environ.get("STEP", "stepA_mal") + ".jq",
"--args",
*args
]
# print(args)
sin_pipe = pipe()
sout_pipe = pipe()
pid = fork()
if pid == 0:
# jq
close(sin_pipe[1])
close(sout_pipe[0])
dup2(sin_pipe[0], 0)
dup2(sout_pipe[1], 2) # bind to stderr, as we write there
dup2(sout_pipe[1], 1)
execv("/usr/bin/jq", args)
else:
close(sin_pipe[0])
close(sout_pipe[1])
msout = sin_pipe[1]
msin = sout_pipe[0]
while True:
try:
if HALT:
break
cmd = get_one(msin)
# print(cmd)
if cmd:
process(json.loads(cmd)[1], msout)
except KeyboardInterrupt:
exit()
except Exception as e:
print("RTS Error:", e)
main(argv[1:])

3
jq/run Executable file
View File

@ -0,0 +1,3 @@
#!/bin/sh
exec python rts.py "${@}"

27
jq/step0_repl.jq Normal file
View File

@ -0,0 +1,27 @@
include "utils";
def read_line:
. as $in
| label $top
| _readline;
def READ:
.;
def EVAL:
.;
def PRINT:
.;
def rep:
READ | EVAL | PRINT | _display;
def repl_:
("user> " | _print) |
(read_line | rep);
def repl:
while(true; repl_);
repl

42
jq/step1_read_print.jq Normal file
View File

@ -0,0 +1,42 @@
include "reader";
include "printer";
include "utils";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def EVAL:
.;
def PRINT:
pr_str;
def rep:
READ | EVAL |
if . != null then
PRINT
else
null
end;
def repl_:
("user> " | _print) |
(read_line | rep);
def repl:
{continue: true} | while(
.continue;
try {value: repl_, continue: true}
catch
if is_jqmal_error then
{value: "Error: \(.)", continue: true}
else
{value: ., continue: false}
end) | if .value then .value|_display else empty end;
repl

121
jq/step2_eval.jq Normal file
View File

@ -0,0 +1,121 @@
include "reader";
include "printer";
include "utils";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def lookup(env):
env[.] //
jqmal_error("'\(.)' not found");
def arg_check(args):
if .inputs != (args|length) then
jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))")
else
.
end;
def interpret(arguments; env):
(select(.kind == "fn") |
arg_check(arguments) |
(
select(.function == "number_add") |
arguments | map(.value) | .[0] + .[1] | wrap("number")
) // (
select(.function == "number_sub") |
arguments | map(.value) | .[0] - .[1] | wrap("number")
) // (
select(.function == "number_mul") |
arguments | map(.value) | .[0] * .[1] | wrap("number")
) // (
select(.function == "number_div") |
arguments | map(.value) | .[0] / .[1] | wrap("number")
)
) //
jqmal_error("Unsupported native function kind \(.kind)");
def EVAL(env):
def eval_ast:
(select(.kind == "symbol") | .value | lookup(env)) //
(select(.kind == "list") | {
kind: "list",
value: .value | map(EVAL(env))
}) // .;
(select(.kind == "list") |
if .value | length == 0 then
.
else
eval_ast|.value as $evald | $evald | first | interpret($evald[1:]; env)
end
) //
(select(.kind == "vector") |
{
kind: "vector",
value: .value|map(EVAL(env))
}
) //
(select(.kind == "hashmap") |
{
kind: "hashmap",
value: .value|map_values(.value |= EVAL(env))
}
) // eval_ast;
def PRINT:
pr_str;
def rep(env):
READ | EVAL(env) |
if . != null then
PRINT
else
null
end;
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:
{
"+": {
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"
},
};
def repl(env):
{continue: true} | while(
.continue;
try {value: repl_(env), continue: true}
catch
if is_jqmal_error then
{value: "Error: \(.)", continue: true}
else
{value: ., continue: false}
end) | if .value then .value|_display else empty end;
repl(replEnv)

218
jq/step3_env.jq Normal file
View File

@ -0,0 +1,218 @@
include "reader";
include "printer";
include "utils";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
# Environment functions
def pureChildEnv:
{
parent: .,
environment: {}
};
def env_set(env; $key; $value):
{
parent: env.parent,
environment: (env.environment + (env.environment | .[$key] |= $value)) # merge together, as .environment[key] |= value does not work
};
def env_find(env):
if env.environment[.] == null then
if env.parent then
env_find(env.parent)
else
null
end
else
env
end;
def addToEnv(envexp; name):
{
expr: envexp.expr,
env: env_set(envexp.env; name; envexp.expr)
};
def env_get(env):
. as $key | $key | env_find(env).environment[$key] as $value |
if $value == null then
jqmal_error("'\($key)' not found")
else
$value
end;
def addEnv(env):
{
expr: .,
env: env
};
# Evaluation
def arg_check(args):
if .inputs != (args|length) then
jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))")
else
.
end;
def interpret(arguments; env):
(select(.kind == "fn") |
arg_check(arguments) |
(
select(.function == "number_add") |
arguments | map(.value) | .[0] + .[1] | wrap("number")
) // (
select(.function == "number_sub") |
arguments | map(.value) | .[0] - .[1] | wrap("number")
) // (
select(.function == "number_mul") |
arguments | map(.value) | .[0] * .[1] | wrap("number")
) // (
select(.function == "number_div") |
arguments | map(.value) | .[0] / .[1] | wrap("number")
)
) | addEnv(env) //
jqmal_error("Unsupported native function kind \(.kind)");
def 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 }
) //
(
reduce .value[] as $elem (
[];
. 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)
) //
addEnv(env)
)
end
) //
(select(.kind == "vector") |
[ { env: env, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
} | addEnv($res | last.env)
) //
(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 == "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));
def childEnv(binds; value):
{
parent: .,
environment: [binds, value] | transpose | map({(.[0]): .[1]}) | from_entries
};
# 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"
},
}
};
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 | _display) else empty end;
repl(replEnv)

566
jq/step4_if_fn_do.jq Normal file
View File

@ -0,0 +1,566 @@
include "reader";
include "printer";
include "utils";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
# Environment Functions
def childEnv(binds; exprs):
{
parent: .,
fallback: null,
environment: [binds, exprs] | transpose | (
. as $dot | reduce .[] as $item (
{ value: [], seen: false, name: null, idx: 0 };
if $item[1] != null then
if .seen then
{
value: (.value[1:-1] + (.value|last[1].value += [$item[1]])),
seen: true,
name: .name
}
else
if $item[0] == "&" then
$dot[.idx+1][0] as $name | {
value: (.value + [[$name, {kind:"list", value: [$item[1]]}]]),
seen: true,
name: $name
}
else
{
value: (.value + [$item]),
seen: false,
name: null
}
end
end | (.idx |= .idx + 1)
else
if $item[0] == "&" then
$dot[.idx+1][0] as $name | {
value: (.value + [[$name, {kind:"list", value: []}]]),
seen: true,
name: $name
}
else . end
end
)
) | .value | map({(.[0]): .[1]}) | add
};
def pureChildEnv:
{
parent: .,
environment: {},
fallback: null
};
def rootEnv:
{
parent: null,
fallback: null,
environment: {}
};
def inform_function(name):
(.names += [name]) | (.names |= unique);
def inform_function_multi(names):
. as $dot | reduce names[] as $name(
$dot;
inform_function($name)
);
def env_multiset(keys; value):
(if value.kind == "function" then # multiset not allowed on atoms
value | inform_function_multi(keys)
else
value
end) as $value | {
parent: .parent,
environment: (
.environment + (reduce keys[] as $key(.environment; .[$key] |= value))
),
fallback: .fallback
};
def env_multiset(env; keys; value):
env | env_multiset(keys; value);
def env_set($key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
($value |
if $value.kind == "atom" then
# check if the one we have is newer
env_req(env; key) as $ours |
if $ours.last_modified > $value.last_modified then
$ours
else
# update modification timestamp
$value | .last_modified |= now
end
else
.
end) | inform_function($key)
else
$value
end) as $value | {
parent: .parent,
environment: (.environment + (.environment | .[$key] |= $value)), # merge together, as .environment[key] |= value does not work
fallback: .fallback
};
def env_dump_keys:
def _dump1:
.environment // {} | keys;
if . == null then [] else
if .parent == null then
(
_dump1 +
(.fallback | env_dump_keys)
)
else
(
_dump1 +
(.parent | env_dump_keys) +
(.fallback | env_dump_keys)
)
end | unique
end;
def env_find(env):
if env.environment[.] == null then
if env.parent then
env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end
else
null
end
else
env
end;
def env_get(env):
. as $key | $key | env_find(env).environment[$key] as $value |
if $value == null then
jqmal_error("'\($key)' not found")
else
if $value.kind == "atom" then
$value.identity as $id |
$key | env_find(env.parent).environment[$key] as $possibly_newer |
if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
$possibly_newer
else
$value
end
else
$value
end
end;
def env_get(env; key):
key | env_get(env);
def env_req(env; key):
key as $key | key | env_find(env).environment[$key] as $value |
if $value == null then
null
else
if $value.kind == "atom" then
$value.identity as $id |
$key | env_find(env.parent).environment[$key] as $possibly_newer |
if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
$possibly_newer
else
$value
end
else
$value
end
end;
def env_set(env; $key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
$value | (.names += [$key]) | (.names |= unique) |
if $value.kind == "atom" then
# check if the one we have is newer
env_req(env; $key) as $ours |
if $ours.last_modified > $value.last_modified then
$ours
else
# update modification timestamp
$value | .last_modified |= now
end
else
.
end
else
$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
fallback: env.fallback
};
def env_setfallback(env; fallback):
{
parent: env.parent,
fallback: fallback,
environment: env.environment
};
def addEnv(env):
{
expr: .,
env: env
};
def addToEnv(env; name; expr):
{
expr: expr,
env: env_set(env; name; expr)
};
def wrapEnv(atoms):
{
replEnv: .,
currentEnv: .,
atoms: atoms,
isReplEnv: true
};
def wrapEnv(replEnv; atoms):
{
replEnv: replEnv,
currentEnv: .,
atoms: atoms, # id -> value
isReplEnv: (replEnv == .) # should we allow separate copies?
};
def unwrapReplEnv:
.replEnv;
def unwrapCurrentEnv:
.currentEnv;
def env_set6(env; key; value):
if env.isReplEnv then
env_set(env.currentEnv; key; value) | wrapEnv(env.atoms)
else
env_set(env.currentEnv; key; value) | wrapEnv(env.replEnv; env.atoms)
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($rawEnv.atoms)
else
env_set_($rawEnv.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv; $rawEnv.atoms)
end) as $newEnv
| {
expr: $value,
env: $newEnv
};
def addToEnv(envexp; name):
if envexp.env.replEnv != null then
addToEnv6(envexp; name)
else {
expr: envexp.expr,
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))
}
else . end;
def env_remove_references(refs):
. as $env
| if has("replEnv") then
.currentEnv |= _env_remove_references(refs)
else
_env_remove_references(refs)
end;
# Evaluation
def arg_check(args):
if .inputs < 0 then
if (abs(.inputs) - 1) > (args | length) then
jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))")
else
.
end
else if .inputs != (args|length) then
jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))")
else
.
end end;
def addFrees(newEnv; frees):
. as $env
| reduce frees[] as $free (
$env;
. as $dot
| env_req(newEnv; $free) as $lookup
| if $lookup != null then
env_set_(.; $free; $lookup)
else
.
end)
| . as $env
| $env;
def interpret(arguments; env; _eval):
(if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) |
(select(.kind == "fn") |
arg_check(arguments) |
(core_interp(arguments; env) | addEnv(env))
) //
(select(.kind == "function") as $fn |
# todo: arg_check
(.body | pr_str(env)) as $src |
# _debug("INTERP " + $src) |
# _debug("FREES " + ($fn.free_referencess | tostring)) |
env_setfallback((.env | addFrees(env; $fn.free_referencess)); env) | childEnv($fn.binds; arguments) as $fnEnv |
# tell it about its surroundings
(reduce $fn.free_referencess[] as $name (
$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
}
| . as $dot
# | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str))
| _eval
| . as $envexp
|
{
expr: .expr,
env: env
}
# | . 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)");
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: retenv,
finish: (continue | not),
cont: true # set inside
};
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 thing
free_referencess: $value[2] | find_free_references(env | env_dump_keys + $binds) # for dynamically scoped variables
} | addEnv(env)
) //
(
reduce .value[] as $elem (
[];
. 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)
) //
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),
fallback: null
};
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 | _display) else empty end;
repl(
"(def! not (fn* (a) (if a false true)))" | rep(replEnv) | .env
)

582
jq/step5_tco.jq Normal file
View File

@ -0,0 +1,582 @@
include "reader";
include "printer";
include "utils";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
# Environment Functions
def childEnv(binds; exprs):
{
parent: .,
fallback: null,
environment: [binds, exprs] | transpose | (
. as $dot | reduce .[] as $item (
{ value: [], seen: false, name: null, idx: 0 };
if $item[1] != null then
if .seen then
{
value: (.value[1:-1] + (.value|last[1].value += [$item[1]])),
seen: true,
name: .name
}
else
if $item[0] == "&" then
$dot[.idx+1][0] as $name | {
value: (.value + [[$name, {kind:"list", value: [$item[1]]}]]),
seen: true,
name: $name
}
else
{
value: (.value + [$item]),
seen: false,
name: null
}
end
end | (.idx |= .idx + 1)
else
if $item[0] == "&" then
$dot[.idx+1][0] as $name | {
value: (.value + [[$name, {kind:"list", value: []}]]),
seen: true,
name: $name
}
else . end
end
)
) | .value | map({(.[0]): .[1]}) | add
};
def pureChildEnv:
{
parent: .,
environment: {},
fallback: null
};
def rootEnv:
{
parent: null,
fallback: null,
environment: {}
};
def inform_function(name):
(.names += [name]) | (.names |= unique);
def inform_function_multi(names):
. as $dot | reduce names[] as $name(
$dot;
inform_function($name)
);
def env_multiset(keys; value):
(if value.kind == "function" then # multiset not allowed on atoms
value | inform_function_multi(keys)
else
value
end) as $value | {
parent: .parent,
environment: (
.environment + (reduce keys[] as $key(.environment; .[$key] |= value))
),
fallback: .fallback
};
def env_multiset(env; keys; value):
env | env_multiset(keys; value);
def env_set($key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
($value |
if $value.kind == "atom" then
# check if the one we have is newer
env_req(env; key) as $ours |
if $ours.last_modified > $value.last_modified then
$ours
else
# update modification timestamp
$value | .last_modified |= now
end
else
.
end) | inform_function($key)
else
$value
end) as $value | {
parent: .parent,
environment: (.environment + (.environment | .[$key] |= $value)), # merge together, as .environment[key] |= value does not work
fallback: .fallback
};
def env_dump_keys:
def _dump1:
.environment // {} | keys;
if . == null then [] else
if .parent == null then
(
_dump1 +
(.fallback | env_dump_keys)
)
else
(
_dump1 +
(.parent | env_dump_keys) +
(.fallback | env_dump_keys)
)
end | unique
end;
def env_find(env):
if env.environment[.] == null then
if env.parent then
env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end
else
null
end
else
env
end;
def env_get(env):
. as $key | $key | env_find(env).environment[$key] as $value |
if $value == null then
jqmal_error("'\($key)' not found")
else
if $value.kind == "atom" then
$value.identity as $id |
$key | env_find(env.parent).environment[$key] as $possibly_newer |
if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
$possibly_newer
else
$value
end
else
$value
end
end;
def env_get(env; key):
key | env_get(env);
def env_req(env; key):
key as $key | key | env_find(env).environment[$key] as $value |
if $value == null then
null
else
if $value.kind == "atom" then
$value.identity as $id |
$key | env_find(env.parent).environment[$key] as $possibly_newer |
if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
$possibly_newer
else
$value
end
else
$value
end
end;
def env_set(env; $key; $value):
(if $value.kind == "function" or $value.kind == "atom" then
# inform the function/atom of its names
$value | (.names += [$key]) | (.names |= unique) |
if $value.kind == "atom" then
# check if the one we have is newer
env_req(env; $key) as $ours |
if $ours.last_modified > $value.last_modified then
$ours
else
# update modification timestamp
$value | .last_modified |= now
end
else
.
end
else
$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
fallback: env.fallback
};
def env_setfallback(env; fallback):
{
parent: env.parent,
fallback: fallback,
environment: env.environment
};
def addEnv(env):
{
expr: .,
env: env
};
def addToEnv(env; name; expr):
{
expr: expr,
env: env_set(env; name; expr)
};
def wrapEnv(atoms):
{
replEnv: .,
currentEnv: .,
atoms: atoms,
isReplEnv: true
};
def wrapEnv(replEnv; atoms):
{
replEnv: replEnv,
currentEnv: .,
atoms: atoms, # id -> value
isReplEnv: (replEnv == .) # should we allow separate copies?
};
def unwrapReplEnv:
.replEnv;
def unwrapCurrentEnv:
.currentEnv;
def env_set6(env; key; value):
if env.isReplEnv then
env_set(env.currentEnv; key; value) | wrapEnv(env.atoms)
else
env_set(env.currentEnv; key; value) | wrapEnv(env.replEnv; env.atoms)
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($rawEnv.atoms)
else
env_set_($rawEnv.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv; $rawEnv.atoms)
end) as $newEnv
| {
expr: $value,
env: $newEnv
};
def addToEnv(envexp; name):
if envexp.env.replEnv != null then
addToEnv6(envexp; name)
else {
expr: envexp.expr,
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))
}
else . end;
def env_remove_references(refs):
. as $env
| if has("replEnv") then
.currentEnv |= _env_remove_references(refs)
else
_env_remove_references(refs)
end;
# Evaluation
def arg_check(args):
if .inputs < 0 then
if (abs(.inputs) - 1) > (args | length) then
jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))")
else
.
end
else if .inputs != (args|length) then
jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))")
else
.
end end;
def addFrees(newEnv; frees):
. as $env
| reduce frees[] as $free (
$env;
. as $dot
| env_req(newEnv; $free) as $lookup
| if $lookup != null then
env_set_(.; $free; $lookup)
else
.
end)
| . as $env
| $env;
def interpret(arguments; env; _eval):
(if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) |
(select(.kind == "fn") |
arg_check(arguments) |
(core_interp(arguments; env) | addEnv(env))
) //
(select(.kind == "function") as $fn |
# todo: arg_check
(.body | pr_str(env)) as $src |
# _debug("INTERP " + $src) |
# _debug("FREES " + ($fn.free_referencess | tostring)) |
env_setfallback((.env | addFrees(env; $fn.free_referencess)); env) | childEnv($fn.binds; arguments) as $fnEnv |
# tell it about its surroundings
(reduce $fn.free_referencess[] as $name (
$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
}
| . as $dot
# | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str))
| _eval
| . as $envexp
|
{
expr: .expr,
env: env
}
# | . 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)");
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: retenv,
finish: (continue | not),
cont: true # set inside
};
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;
. as $ast
| { env: env, ast: ., cont: true, finish: false, ret_env: null }
| [ recurseflip(.cont;
.env as $_menv
| if .finish then
.cont |= false
else
(.ret_env//.env) as $_retenv
| .ret_env as $_orig_retenv
| .ast
|
(select(.kind == "list") |
if .value | length == 0 then
. | TCOWrap($_menv; $_orig_retenv; false)
else
(
(
.value | select(.[0].value == "def!") as $value |
($value[2] | EVAL($_menv)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "let*") as $value |
($_menv | 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] | TCOWrap($env; $_retenv; true)
) //
(
.value | select(.[0].value == "do") as $value |
(reduce ($value[1:][]) as $xvalue (
{ env: $_menv, expr: {kind:"nil"} };
.env as $env | $xvalue | EVAL($env)
)) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
) //
(
.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"})
else
$value[2]
end) | TCOWrap($condenv.env; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "fn*") as $value |
# (fn* args body)
$value[1].value | map(.value) as $binds | {
kind: "function",
binds: $binds,
env: $_menv,
body: $value[2],
names: [], # we can't do that circular reference thing
free_referencess: $value[2] | find_free_references($_menv | env_dump_keys + $binds) # for dynamically scoped variables
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
reduce .value[] as $elem (
[];
. as $dot | $elem | EVAL($_menv) as $eval_env |
($dot + [$eval_env.expr])
) | . as $expr | first |
interpret($expr[1:]; $_menv; _eval_here) as $exprenv |
$exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
) //
TCOWrap($_menv; $_orig_retenv; false)
)
end
) //
(select(.kind == "vector") |
if .value|length == 0 then
{
kind: "vector",
value: []
} | TCOWrap($_menv; $_orig_retenv; false)
else
[ { env: $_menv, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
} | TCOWrap($res | last.env; $_orig_retenv; false)
end
) //
(select(.kind == "hashmap") |
[ { env: $_menv, list: .value | to_entries } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
} | TCOWrap($res | last.env; $_orig_retenv; false)
) //
(select(.kind == "function") |
. | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to
) //
(select(.kind == "symbol") |
.value | env_get($_menv) | TCOWrap($_menv; null; false)
) // TCOWrap($_menv; $_orig_retenv; false)
end
) ]
| last as $result
| ($result.ret_env // $result.env) as $env
| $result.ast
| 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),
fallback: null
};
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 | _display) else empty end;
repl(
"(def! not (fn* (a) (if a false true)))" | rep(replEnv) | .env
)

253
jq/step6_file.jq Normal file
View File

@ -0,0 +1,253 @@
include "reader";
include "printer";
include "utils";
include "interp";
include "env";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end),
finish: (continue | not),
cont: true # set inside
};
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.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:
.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;
. as $ast
| { env: env, ast: ., cont: true, finish: false, ret_env: null }
| [ recurseflip(.cont;
.env as $_menv
| if .finish then
.cont |= false
else
(.ret_env//.env) as $_retenv
| .ret_env as $_orig_retenv
| .ast
| . as $init
| $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
| $_menv | unwrapReplEnv as $replEnv # -
| $init
|
(select(.kind == "list") |
if .value | length == 0 then
. | TCOWrap($_menv; $_orig_retenv; false)
else
(
(
.value | select(.[0].value == "def!") as $value |
($value[2] | EVAL($_menv)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "let*") as $value |
($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) 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] | TCOWrap($env; $_retenv; true)
) //
(
.value | select(.[0].value == "do") as $value |
(reduce ($value[1:][]) as $xvalue (
{ env: $_menv, expr: {kind:"nil"} };
.env as $env | $xvalue | EVAL($env)
)) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "if") as $value |
$value[1] | EVAL($_menv) as $condenv |
(if (["false", "nil"] | contains([$condenv.expr.kind])) then
($value[3] // {kind:"nil"})
else
$value[2]
end) | TCOWrap($condenv.env; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "fn*") as $value |
# (fn* args body)
$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 thing
free_referencess: $free_referencess # for dynamically scoped variables
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
reduce .value[] as $elem (
{env: $_menv, val: []};
. as $dot | $elem | EVAL($dot.env) as $eval_env |
($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv |
{env: $_menv, val: ($dot.val + [$eval_env.expr])}
) | . as $expr | $expr.val | first |
interpret($expr.val[1:]; $expr.env; _eval_here) as $exprenv |
$exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
) //
TCOWrap($_menv; $_orig_retenv; false)
)
end
) //
(select(.kind == "vector") |
if .value|length == 0 then
{
kind: "vector",
value: []
} | TCOWrap($_menv; $_orig_retenv; false)
else
[ { env: env, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
} | TCOWrap($res | last.env; $_orig_retenv; false)
end
) //
(select(.kind == "hashmap") |
[ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
} | TCOWrap($res | last.env; $_orig_retenv; false)
) //
(select(.kind == "function") |
. | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to
) //
(select(.kind == "symbol") |
.value | env_get($currentEnv) | TCOWrap($_menv; null; false)
) // TCOWrap($_menv; $_orig_retenv; false)
end
) ]
| last as $result
| ($result.ret_env // $result.env) as $env
| $result.ast
| addEnv($env);
def PRINT(env):
pr_str(env);
def rep(env):
READ | EVAL(env) as $expenv |
if $expenv.expr != null then
$expenv.expr | PRINT($expenv.env)
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"
},
"eval": {
kind: "fn",
inputs: 1,
function: "eval"
}
} + core_identify),
fallback: null,
};
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 | _display) else empty end;
def eval_ign(expr):
. as $env | expr | rep($env) | .env;
def eval_val(expr):
. as $env | expr | rep($env) | .expr;
def getEnv:
replEnv
| 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)\")))))))");
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
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 ] | _halt

295
jq/step7_quote.jq Normal file
View File

@ -0,0 +1,295 @@
include "reader";
include "printer";
include "utils";
include "interp";
include "env";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end),
finish: (continue | not),
cont: true # set inside
};
def _symbol(name):
{
kind: "symbol",
value: name
};
def _symbol_v(name):
if .kind == "symbol" then
.value == name
else
false
end;
def quasiquote:
if isPair then
.value as $value | null |
if ($value[0] | _symbol_v("unquote")) then
$value[1]
else
if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then
[_symbol("concat")] +
[$value[0].value[1]] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
else
[_symbol("cons")] +
[($value[0] | quasiquote)] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
end
end
else
[_symbol("quote")] +
[.] | wrap("list")
end;
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.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:
.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;
. as $ast
| { env: env, ast: ., cont: true, finish: false, ret_env: null }
| [ recurseflip(.cont;
.env as $_menv
| if .finish then
.cont |= false
else
(.ret_env//.env) as $_retenv
| .ret_env as $_orig_retenv
| .ast
| . as $init
| $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
| $_menv | unwrapReplEnv as $replEnv # -
| $init
|
(select(.kind == "list") |
if .value | length == 0 then
. | TCOWrap($_menv; $_orig_retenv; false)
else
(
(
.value | select(.[0].value == "def!") as $value |
($value[2] | EVAL($_menv)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "let*") as $value |
($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv |
(reduce ($value[1].value | nwise(2)) as $xvalue (
$_menv;
. as $env | $xvalue[1] | EVAL($env) as $expenv |
env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
| $value[2] | TCOWrap($env; $_retenv; true)
) //
(
.value | select(.[0].value == "do") as $value |
(reduce ($value[1:][]) as $xvalue (
{ env: $_menv, expr: {kind:"nil"} };
.env as $env | $xvalue | EVAL($env)
)) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "if") as $value |
$value[1] | EVAL($_menv) as $condenv |
(if (["false", "nil"] | contains([$condenv.expr.kind])) then
($value[3] // {kind:"nil"})
else
$value[2]
end) | TCOWrap($condenv.env; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "fn*") as $value |
# (fn* args body)
$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 thing
free_referencess: $free_referencess # for dynamically scoped variables
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quote") as $value |
$value[1] | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quasiquote") as $value |
$value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
) //
(
reduce .value[] as $elem (
{env: $_menv, val: []};
. as $dot | $elem | EVAL($dot.env) as $eval_env |
($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv |
{env: $_menv, val: ($dot.val + [$eval_env.expr])}
) | . as $expr | $expr.val | first |
interpret($expr.val[1:]; $expr.env; _eval_here) as $exprenv |
$exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
) //
TCOWrap($_menv; $_orig_retenv; false)
)
end
) //
(select(.kind == "vector") |
if .value|length == 0 then
{
kind: "vector",
value: []
} | TCOWrap($_menv; $_orig_retenv; false)
else
[ { env: env, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
} | TCOWrap($res | last.env; $_orig_retenv; false)
end
) //
(select(.kind == "hashmap") |
[ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
} | TCOWrap($res | last.env; $_orig_retenv; false)
) //
(select(.kind == "function") |
. | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to
) //
(select(.kind == "symbol") |
.value | env_get($currentEnv) | TCOWrap($_menv; null; false)
) // TCOWrap($_menv; $_orig_retenv; false)
end
) ]
| last as $result
| ($result.ret_env // $result.env) as $env
| $result.ast
| addEnv($env);
def PRINT(env):
pr_str(env);
def rep(env):
READ | EVAL(env) as $expenv |
if $expenv.expr != null then
$expenv.expr | PRINT($expenv.env)
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"
},
"eval": {
kind: "fn",
inputs: 1,
function: "eval"
}
} + core_identify),
fallback: null
};
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 | _display) else empty end;
def eval_ign(expr):
. as $env | expr | rep($env) | .env;
def eval_val(expr):
. as $env | expr | rep($env) | .expr;
def getEnv:
replEnv
| 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)\")))))))");
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
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 ] | _halt

363
jq/step8_macros.jq Normal file
View File

@ -0,0 +1,363 @@
include "reader";
include "printer";
include "utils";
include "interp";
include "env";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end),
finish: (continue | not),
cont: true # set inside
};
def _symbol(name):
{
kind: "symbol",
value: name
};
def _symbol_v(name):
if .kind == "symbol" then
.value == name
else
false
end;
def quasiquote:
if isPair then
.value as $value | null |
if ($value[0] | _symbol_v("unquote")) then
$value[1]
else
if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then
[_symbol("concat")] +
[$value[0].value[1]] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
else
[_symbol("cons")] +
[($value[0] | quasiquote)] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
end
end
else
[_symbol("quote")] +
[.] | wrap("list")
end;
def set_macro_function:
if .kind != "function" then
jqmal_error("expected a function to be defined by defmacro!")
else
.is_macro |= true
end;
def is_macro_call(env):
if .kind != "list" then
false
else
if (.value|first.kind == "symbol") then
env_req(env; .value|first.value)
| if .kind != "function" then
false
else
.is_macro
end
else
false
end
end;
def EVAL(env):
def _eval_here:
.env as $env | .expr | EVAL($env);
def _interpret($_menv):
reduce .value[] as $elem (
{env: $_menv, val: []};
. as $dot | $elem | EVAL($dot.env) as $eval_env |
($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv |
{env: $_menv, val: ($dot.val + [$eval_env.expr])}
) | . as $expr | $expr.val | first |
interpret($expr.val[1:]; $expr.env; _eval_here);
def macroexpand(env):
. as $dot |
$dot |
[ while(is_macro_call(env | unwrapCurrentEnv);
. as $dot
| ($dot.value[0] | EVAL(env).expr) as $fn
| $dot.value[1:] as $args
| $fn
| interpret($args; env; _eval_here).expr) // . ]
| last
| if is_macro_call(env | unwrapCurrentEnv) then
. as $dot
| ($dot.value[0] | EVAL(env).expr) as $fn
| $dot.value[1:] as $args
| $fn
| interpret($args; env; _eval_here).expr
else
.
end
;
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.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:
.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;
def eval_ast(env):
(select(.kind == "vector") |
if .value|length == 0 then
{
kind: "vector",
value: []
}
else
[ { env: env, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
}
end
) //
(select(.kind == "hashmap") |
[ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
}
) //
(select(.kind == "function") |
.# return this unchanged, since it can only be applied to
) //
(select(.kind == "symbol") |
.value | env_get(env | unwrapCurrentEnv)
) // .;
. as $ast
| { env: env, ast: ., cont: true, finish: false, ret_env: null }
| [ recurseflip(.cont;
.env as $_menv
| if .finish then
.cont |= false
else
(.ret_env//.env) as $_retenv
| .ret_env as $_orig_retenv
| .ast
| . as $init
| $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
| $_menv | unwrapReplEnv as $replEnv # -
| $init
|
(select(.kind == "list") |
macroexpand($_menv) |
if .kind != "list" then
eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)
else
if .value | length == 0 then
. | TCOWrap($_menv; $_orig_retenv; false)
else
(
(
.value | select(.[0].value == "def!") as $value |
($value[2] | EVAL($_menv)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "defmacro!") as $value |
($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "let*") as $value |
($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv |
(reduce ($value[1].value | nwise(2)) as $xvalue (
$_menv;
. as $env | $xvalue[1] | EVAL($env) as $expenv |
env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
| $value[2] | TCOWrap($env; $_retenv; true)
) //
(
.value | select(.[0].value == "do") as $value |
(reduce ($value[1:][]) as $xvalue (
{ env: $_menv, expr: {kind:"nil"} };
.env as $env | $xvalue | EVAL($env)
)) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "if") as $value |
$value[1] | EVAL($_menv) as $condenv |
(if (["false", "nil"] | contains([$condenv.expr.kind])) then
($value[3] // {kind:"nil"})
else
$value[2]
end) | TCOWrap($condenv.env; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "fn*") as $value |
# (fn* args body)
$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 thing
free_referencess: $free_referencess, # for dynamically scoped variables
is_macro: false
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quote") as $value |
$value[1] | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quasiquote") as $value |
$value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "macroexpand") as $value |
$value[1] | macroexpand(env) | TCOWrap($_menv; $_orig_retenv; false)
) //
(
. as $dot | _interpret($_menv) as $exprenv |
$exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
) //
TCOWrap($_menv; $_orig_retenv; false)
)
end
end
) //
(eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false))
end
) ]
| last as $result
| ($result.ret_env // $result.env) as $env
| $result.ast
| addEnv($env);
def PRINT(env):
pr_str(env);
def rep(env):
READ | EVAL(env) as $expenv |
if $expenv.expr != null then
$expenv.expr | PRINT($expenv.env)
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"
},
"eval": {
kind: "fn",
inputs: 1,
function: "eval"
}
} + core_identify),
fallback: null
};
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 | _display) else empty end;
def eval_ign(expr):
. as $env | expr | rep($env) | .env;
def eval_val(expr):
. as $env | expr | rep($env) | .expr;
def getEnv:
replEnv
| 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)\")))))))")
| eval_ign("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
;
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
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 ] | _halt

392
jq/step9_try.jq Normal file
View File

@ -0,0 +1,392 @@
include "reader";
include "printer";
include "utils";
include "interp";
include "env";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end),
finish: (continue | not),
cont: true # set inside
};
def _symbol(name):
{
kind: "symbol",
value: name
};
def _symbol_v(name):
if .kind == "symbol" then
.value == name
else
false
end;
def quasiquote:
if isPair then
.value as $value | null |
if ($value[0] | _symbol_v("unquote")) then
$value[1]
else
if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then
[_symbol("concat")] +
[$value[0].value[1]] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
else
[_symbol("cons")] +
[($value[0] | quasiquote)] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
end
end
else
[_symbol("quote")] +
[.] | wrap("list")
end;
def set_macro_function:
if .kind != "function" then
jqmal_error("expected a function to be defined by defmacro!")
else
.is_macro |= true
end;
def is_macro_call(env):
if .kind != "list" then
false
else
if (.value|first.kind == "symbol") then
env_req(env; .value|first.value)
| if .kind != "function" then
false
else
.is_macro
end
else
false
end
end;
def EVAL(env):
def _eval_here:
.env as $env | .expr | EVAL($env);
def _interpret($_menv):
reduce .value[] as $elem (
{env: $_menv, val: []};
. as $dot | $elem | EVAL($dot.env) as $eval_env |
($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv |
{env: $_menv, val: ($dot.val + [$eval_env.expr])}
) | . as $expr | $expr.val | first |
interpret($expr.val[1:]; $expr.env; _eval_here);
def macroexpand(env):
. as $dot |
$dot |
[ while(is_macro_call(env | unwrapCurrentEnv);
. as $dot
| ($dot.value[0] | EVAL(env).expr) as $fn
| $dot.value[1:] as $args
| $fn
| interpret($args; env; _eval_here).expr) // . ]
| last
| if is_macro_call(env | unwrapCurrentEnv) then
. as $dot
| ($dot.value[0] | EVAL(env).expr) as $fn
| $dot.value[1:] as $args
| $fn
| interpret($args; env; _eval_here).expr
else
.
end
;
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.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:
.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;
def eval_ast(env):
(select(.kind == "vector") |
if .value|length == 0 then
{
kind: "vector",
value: []
}
else
[ { env: env, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
}
end
) //
(select(.kind == "hashmap") |
[ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
}
) //
(select(.kind == "function") |
.# return this unchanged, since it can only be applied to
) //
(select(.kind == "symbol") |
.value | env_get(env | unwrapCurrentEnv)
) // .;
. as $ast
| { env: env, ast: ., cont: true, finish: false, ret_env: null }
| [ recurseflip(.cont;
.env as $_menv
| if .finish then
.cont |= false
else
(.ret_env//.env) as $_retenv
| .ret_env as $_orig_retenv
| .ast
| . as $init
| $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
| $_menv | unwrapReplEnv as $replEnv # -
| $init
|
(select(.kind == "list") |
macroexpand($_menv) |
if .kind != "list" then
eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)
else
if .value | length == 0 then
. | TCOWrap($_menv; $_orig_retenv; false)
else
(
(
.value | select(.[0].value == "def!") as $value |
($value[2] | EVAL($_menv)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "defmacro!") as $value |
($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "let*") as $value |
($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv |
(reduce ($value[1].value | nwise(2)) as $xvalue (
$_menv;
. as $env | $xvalue[1] | EVAL($env) as $expenv |
env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
| $value[2] | TCOWrap($env; $_retenv; true)
) //
(
.value | select(.[0].value == "do") as $value |
(reduce ($value[1:][]) as $xvalue (
{ env: $_menv, expr: {kind:"nil"} };
.env as $env | $xvalue | EVAL($env)
)) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "try*") as $value |
try (
$value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false)
) catch ( . as $exc |
if $value[2] then
if ($value[2].value[0] | _symbol_v("catch*")) then
(if ($exc | is_jqmal_error) then
$exc[19:] as $ex |
try (
$ex
| fromjson
) catch (
$ex |
wrap("string")
)
else
$exc|wrap("string")
end) as $exc |
$value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex |
$ex.expr | TCOWrap($ex.env; $_retenv; false)
else
error($exc)
end
else
error($exc)
end
)
) //
(
.value | select(.[0].value == "if") as $value |
$value[1] | EVAL($_menv) as $condenv |
(if (["false", "nil"] | contains([$condenv.expr.kind])) then
($value[3] // {kind:"nil"})
else
$value[2]
end) | TCOWrap($condenv.env; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "fn*") as $value |
# (fn* args body)
$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 thing
free_referencess: $free_referencess, # for dynamically scoped variables
is_macro: false
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quote") as $value |
$value[1] | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quasiquote") as $value |
$value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "macroexpand") as $value |
$value[1] | macroexpand(env) | TCOWrap($_menv; $_orig_retenv; false)
) //
(
. as $dot | _interpret($_menv) as $exprenv |
$exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
) //
TCOWrap($_menv; $_orig_retenv; false)
)
end
end
) //
(eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false))
end
) ]
| last as $result
| ($result.ret_env // $result.env) as $env
| $result.ast
| addEnv($env);
def PRINT(env):
pr_str(env);
def rep(env):
READ | EVAL(env) as $expenv |
if $expenv.expr != null then
$expenv.expr | PRINT($expenv.env)
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"
},
"eval": {
kind: "fn",
inputs: 1,
function: "eval"
}
} + core_identify),
fallback: null
};
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 | _display) else empty end;
def eval_ign(expr):
. as $env | expr | rep($env) | .env;
def eval_val(expr):
. as $env | expr | rep($env) | .expr;
def getEnv:
replEnv
| 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)\")))))))")
| eval_ign("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
;
def main:
if $ARGS.positional|length > 0 then
getEnv as $env |
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 ] | _halt

404
jq/stepA_mal.jq Normal file
View File

@ -0,0 +1,404 @@
include "reader";
include "printer";
include "utils";
include "interp";
include "env";
include "core";
def read_line:
. as $in
| label $top
| _readline;
def READ:
read_str | read_form | .value;
def recurseflip(x; y):
recurse(y; x);
def TCOWrap(env; retenv; continue):
{
ast: .,
env: env,
ret_env: (if retenv != null then (retenv | setpath(["atoms"]; env.atoms)) else retenv end),
finish: (continue | not),
cont: true # set inside
};
def _symbol(name):
{
kind: "symbol",
value: name
};
def _symbol_v(name):
if .kind == "symbol" then
.value == name
else
false
end;
def quasiquote:
if isPair then
.value as $value | null |
if ($value[0] | _symbol_v("unquote")) then
$value[1]
else
if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then
[_symbol("concat")] +
[$value[0].value[1]] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
else
[_symbol("cons")] +
[($value[0] | quasiquote)] +
[($value[1:] | wrap("list") | quasiquote)] | wrap("list")
end
end
else
[_symbol("quote")] +
[.] | wrap("list")
end;
def set_macro_function:
if .kind != "function" then
jqmal_error("expected a function to be defined by defmacro!")
else
.is_macro |= true
end;
def is_macro_call(env):
if .kind != "list" then
false
else
if (.value|first.kind == "symbol") then
env_req(env; .value|first.value)
| if .kind != "function" then
false
else
.is_macro
end
else
false
end
end;
def EVAL(env):
def _eval_here:
.env as $env | .expr | EVAL($env);
def _interpret($_menv):
reduce .value[] as $elem (
{env: $_menv, val: []};
. as $dot | $elem | EVAL($dot.env) as $eval_env |
($dot.env | setpath(["atoms"]; $eval_env.env.atoms)) as $_menv |
{env: $_menv, val: ($dot.val + [$eval_env.expr])}
) | . as $expr | $expr.val | first |
interpret($expr.val[1:]; $expr.env; _eval_here);
def macroexpand(env):
. as $dot |
$dot |
[ while(is_macro_call(env | unwrapCurrentEnv);
. as $dot
| ($dot.value[0] | EVAL(env).expr) as $fn
| $dot.value[1:] as $args
| $fn
| interpret($args; env; _eval_here).expr) // . ]
| last
| if is_macro_call(env | unwrapCurrentEnv) then
. as $dot
| ($dot.value[0] | EVAL(env).expr) as $fn
| $dot.value[1:] as $args
| $fn
| interpret($args; env; _eval_here).expr
else
.
end
;
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.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:
.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;
def eval_ast(env):
(select(.kind == "vector") |
if .value|length == 0 then
{
kind: "vector",
value: []
}
else
[ { env: env, list: .value } | map_with_env ] as $res |
{
kind: "vector",
value: $res | map(.value)
}
end
) //
(select(.kind == "hashmap") |
[ { env: env, list: (.value | to_entries) } | hmap_with_env ] as $res |
{
kind: "hashmap",
value: $res | map(.value) | from_entries
}
) //
(select(.kind == "function") |
.# return this unchanged, since it can only be applied to
) //
(select(.kind == "symbol") |
.value | env_get(env | unwrapCurrentEnv)
) // .;
. as $ast
| { env: env, ast: ., cont: true, finish: false, ret_env: null }
| [ recurseflip(.cont;
.env as $_menv
| (if $DEBUG then _debug("EVAL: \($ast | pr_str($_menv))") else . end)
| (if $DEBUG then _debug("ATOMS: \($_menv.atoms)") else . end)
| if .finish then
.cont |= false
else
(.ret_env//.env) as $_retenv
| .ret_env as $_orig_retenv
| .ast
| . as $init
| $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package"
| $_menv | unwrapReplEnv as $replEnv # -
| $init
|
(select(.kind == "list") |
macroexpand($_menv) |
if .kind != "list" then
eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)
else
if .value | length == 0 then
. | TCOWrap($_menv; $_orig_retenv; false)
else
(
(
.value | select(.[0].value == "atoms??") as $value |
$_menv.atoms | keys | map(wrap("string")) | wrap("list") | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "def!") as $value |
($value[2] | EVAL($_menv)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "defmacro!") as $value |
($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval |
addToEnv($evval; $value[1].value) as $val |
$val.expr | TCOWrap($val.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "let*") as $value |
($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv |
(reduce ($value[1].value | nwise(2)) as $xvalue (
$_menv;
. as $env | $xvalue[1] | EVAL($env) as $expenv |
env_set_($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
| $value[2] | TCOWrap($env; $_retenv; true)
) //
(
.value | select(.[0].value == "do") as $value |
(reduce ($value[1:][]) as $xvalue (
{ env: $_menv, expr: {kind:"nil"} };
.env as $env | $xvalue | EVAL($env)
)) | . as $ex | .expr | TCOWrap($ex.env; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "try*") as $value |
try (
$value[1] | EVAL($_menv) as $exp | $exp.expr | TCOWrap($exp.env; $_orig_retenv; false)
) catch ( . as $exc |
if $value[2] then
if ($value[2].value[0] | _symbol_v("catch*")) then
(if ($exc | is_jqmal_error) then
$exc[19:] as $ex |
try (
$ex
| fromjson
) catch (
$ex |
wrap("string")
)
else
$exc|wrap("string")
end) as $exc |
$value[2].value[2] | EVAL($currentEnv | childEnv([$value[2].value[1].value]; [$exc]) | wrapEnv($replEnv; $_menv.atoms)) as $ex |
$ex.expr | TCOWrap($ex.env; $_retenv; false)
else
error($exc)
end
else
error($exc)
end
)
) //
(
.value | select(.[0].value == "if") as $value |
$value[1] | EVAL($_menv) as $condenv |
(if (["false", "nil"] | contains([$condenv.expr.kind])) then
($value[3] // {kind:"nil"})
else
$value[2]
end) | TCOWrap($condenv.env; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "fn*") as $value |
# (fn* args body)
$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: $_menv,
body: $value[2],
names: [], # we can't do that circular reference thing
free_referencess: $free_referencess, # for dynamically scoped variables
is_macro: false
} | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quote") as $value |
$value[1] | TCOWrap($_menv; $_orig_retenv; false)
) //
(
.value | select(.[0].value == "quasiquote") as $value |
$value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true)
) //
(
.value | select(.[0].value == "macroexpand") as $value |
$value[1] | macroexpand($_menv) | TCOWrap($_menv; $_orig_retenv; false)
) //
(
. as $dot | _interpret($_menv) as $exprenv |
$exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false)
) //
TCOWrap($_menv; $_orig_retenv; false)
)
end
end
) //
(eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false))
end
| (if $DEBUG then _debug("POSTEVAL: \($ast | pr_str($_menv)) = \(.ast | pr_str($_menv))") else . end)
) ]
| last as $result
| ($result.ret_env // $result.env) as $env
| $result.ast
| addEnv($env);
def PRINT(env):
pr_str(env);
def rep(env):
READ | EVAL(env) as $expenv |
if $expenv.expr != null then
$expenv.expr | PRINT($expenv.env)
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"
},
"eval": {
kind: "fn",
inputs: 1,
function: "eval"
}
} + core_identify),
fallback: null
};
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 | _display) else empty end;
def eval_ign(expr):
. as $env | expr | rep($env) | .env;
def eval_val(expr):
. as $env | expr | rep($env) | .expr;
def getEnv:
replEnv
| wrapEnv({})
| eval_ign("(def! *host-language* \"jq\")")
| 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)\")))))))")
| eval_ign("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
;
def main:
if $ARGS.positional|length > 0 then
try (
getEnv as $env |
env_set_($env; "*ARGV*"; $ARGS.positional[1:] | map(wrap("string")) | wrap("list")) |
eval_val("(load-file \($ARGS.positional[0] | tojson))") |
""
) catch (
_print
)
else
repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) )
end;
[ main ] | _halt

160
jq/utils.jq Normal file
View File

@ -0,0 +1,160 @@
def _debug(ex):
. as $top
| ex
| debug
| $top;
def _print:
tostring;
def nwise(n):
def _nwise:
if length <= n then
.
else
.[0:n], (.[n:] | _nwise)
end;
_nwise;
def abs(x):
if x < 0 then 0 - x else x end;
def jqmal_error(e):
error("JqMAL Exception :: " + e);
def is_jqmal_error:
startswith("JqMAL Exception :: ");
def wrap(kind):
{
kind: kind,
value: .
};
def wrap2(kind; opts):
opts + {
kind: kind,
value: .
};
def isPair:
if (.kind == "list" or .kind == "vector") then
.value | length > 0
else
false
end;
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 as $value | ([ range(0; $value|length; 2) ] | map(select(. % 2 == 0) | $value[.].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 | to_entries[] | ({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") | (
map(tomal) | wrap("list")
)
) // (
select(type == "string") | (
if startswith("sym/") then
.[4:] | wrap("symbol")
else
wrap("string")
end
)
) // (
select(type == "number") | (
wrap("number")
)
);
def _extern(options):
{command: .}
| debug
| if (options.nowait | not) then
input | fromjson
else
null
end;
def issue_extern(cmd; options):
{cmd: cmd, args: .}
| _extern(options);
def issue_extern(cmd):
issue_extern(cmd; {});
def _readline:
[.]
| issue_extern("readline"; {nowait: false})
;
def __readline(prompt):
. as $top
| prompt
| _readline;
def __readline:
__readline(.);
def _display:
tostring | .+"\n" | debug;
def _write_to_file(name):
. as $value
| [(name|tojson), (.|tojson), (false|tojson)]
| issue_extern("fwrite"; {nowait: true})
| $value;
def _append_to_file(name):
. as $value
| [(name|tojson), (.|tojson), (true|tojson)]
| issue_extern("fwrite"; {nowait: true})
| $value;
def _halt:
[]
| issue_extern("halt"; {nowait: true})
| halt;
def trap:
_write_to_file("trap_reason.json") | jqmal_error("trap");