[jackhill/mal.git] / jq / step5_tco.jq

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
)
Commit	Line	Data
086a79dc A	1	include "reader";
	2	include "printer";
	3	include "utils";
086a79dc A	4	include "core";
	5
	6	def read_line:
	7	. as $in
	8	\| label $top
e9cb5f03	9	\| _readline;
086a79dc A	10
	11	def READ:
	12	read_str \| read_form \| .value;
	13
413107d1 A	14	# Environment Functions
	15
	16	def childEnv(binds; exprs):
	17	{
	18	parent: .,
	19	fallback: null,
	20	environment: [binds, exprs] \| transpose \| (
	21	. as $dot \| reduce .[] as $item (
	22	{ value: [], seen: false, name: null, idx: 0 };
	23	if $item[1] != null then
	24	if .seen then
	25	{
	26	value: (.value[1:-1] + (.value\|last[1].value += [$item[1]])),
	27	seen: true,
	28	name: .name
	29	}
	30	else
	31	if $item[0] == "&" then
	32	$dot[.idx+1][0] as $name \| {
	33	value: (.value + [[$name, {kind:"list", value: [$item[1]]}]]),
	34	seen: true,
	35	name: $name
	36	}
	37	else
	38	{
	39	value: (.value + [$item]),
	40	seen: false,
	41	name: null
	42	}
	43	end
	44	end \| (.idx \|= .idx + 1)
	45	else
	46	if $item[0] == "&" then
	47	$dot[.idx+1][0] as $name \| {
	48	value: (.value + [[$name, {kind:"list", value: []}]]),
	49	seen: true,
	50	name: $name
	51	}
	52	else . end
	53	end
	54	)
	55	) \| .value \| map({(.[0]): .[1]}) \| add
	56	};
	57
	58	def pureChildEnv:
	59	{
	60	parent: .,
	61	environment: {},
	62	fallback: null
	63	};
	64
	65	def rootEnv:
	66	{
	67	parent: null,
	68	fallback: null,
	69	environment: {}
	70	};
	71
	72	def inform_function(name):
	73	(.names += [name]) \| (.names \|= unique);
	74
	75	def inform_function_multi(names):
	76	. as $dot \| reduce names[] as $name(
	77	$dot;
78	inform_function($name)
79	);
80
81	def env_multiset(keys; value):
82	(if value.kind == "function" then # multiset not allowed on atoms
83	value \| inform_function_multi(keys)
84	else
85	value
86	end) as $value \| {
87	parent: .parent,
88	environment: (
89	.environment + (reduce keys[] as $key(.environment; .[$key] \|= value))
90	),
91	fallback: .fallback
92	};
93
94	def env_multiset(env; keys; value):
95	env \| env_multiset(keys; value);
96
97	def env_set($key; $value):
98	(if $value.kind == "function" or $value.kind == "atom" then
99	# inform the function/atom of its names
100	($value \|
101	if $value.kind == "atom" then
102	# check if the one we have is newer
103	env_req(env; key) as $ours \|
104	if $ours.last_modified > $value.last_modified then
105	$ours
106	else
107	# update modification timestamp
108	$value \| .last_modified \|= now
109	end
110	else
111	.
112	end) \| inform_function($key)
113	else
114	$value
115	end) as $value \| {
116	parent: .parent,
117	environment: (.environment + (.environment \| .[$key] \|= $value)), # merge together, as .environment[key] \|= value does not work
118	fallback: .fallback
119	};
120
121	def env_dump_keys:
122	def _dump1:
123	.environment // {} \| keys;
124	if . == null then [] else
125	if .parent == null then
126	(
127	_dump1 +
128	(.fallback \| env_dump_keys)
129	)
130	else
131	(
132	_dump1 +
133	(.parent \| env_dump_keys) +
134	(.fallback \| env_dump_keys)
135	)
136	end \| unique
137	end;
138
139	def env_find(env):
140	if env.environment[.] == null then
141	if env.parent then
142	env_find(env.parent) // if env.fallback then env_find(env.fallback) else null end
143	else
144	null
145	end
146	else
147	env
148	end;
149
150	def env_get(env):
151	. as $key \| $key \| env_find(env).environment[$key] as $value \|
152	if $value == null then
153	jqmal_error("'\($key)' not found")
154	else
155	if $value.kind == "atom" then
156	$value.identity as $id \|
157	$key \| env_find(env.parent).environment[$key] as $possibly_newer \|
158	if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
159	$possibly_newer
160	else
161	$value
162	end
163	else
164	$value
165	end
166	end;
167
168	def env_get(env; key):
169	key \| env_get(env);
170
171	def env_req(env; key):
172	key as $key \| key \| env_find(env).environment[$key] as $value \|
173	if $value == null then
174	null
175	else
176	if $value.kind == "atom" then
177	$value.identity as $id \|
178	$key \| env_find(env.parent).environment[$key] as $possibly_newer \|
179	if $possibly_newer.identity == $id and $possibly_newer.last_modified > $value.last_modified then
180	$possibly_newer
181	else
182	$value
183	end
184	else
185	$value
186	end
187	end;
188
189	def env_set(env; $key; $value):
190	(if $value.kind == "function" or $value.kind == "atom" then
191	# inform the function/atom of its names
192	$value \| (.names += [$key]) \| (.names \|= unique) \|
193	if $value.kind == "atom" then
194	# check if the one we have is newer
195	env_req(env; $key) as $ours \|
196	if $ours.last_modified > $value.last_modified then
197	$ours
198	else
199	# update modification timestamp
200	$value \| .last_modified \|= now
201	end
202	else
203	.
204	end
205	else
206	$value
207	end) as $value \| {
208	parent: env.parent,
209	environment: ((env.environment // jqmal_error("Environment empty in \(env \| keys)")) + (env.environment \| .[$key] \|= $value)), # merge together, as env.environment[key] \|= value does not work
210	fallback: env.fallback
211	};
212
213	def env_setfallback(env; fallback):
214	{
215	parent: env.parent,
216	fallback: fallback,
217	environment: env.environment
218	};
219
220	def addEnv(env):
221	{
222	expr: .,
223	env: env
224	};
225
226	def addToEnv(env; name; expr):
227	{
228	expr: expr,
229	env: env_set(env; name; expr)
230	};
231
232
233	def wrapEnv(atoms):
234	{
235	replEnv: .,
236	currentEnv: .,
237	atoms: atoms,
238	isReplEnv: true
239	};
240
241	def wrapEnv(replEnv; atoms):
242	{
243	replEnv: replEnv,
244	currentEnv: .,
245	atoms: atoms, # id -> value
246	isReplEnv: (replEnv == .) # should we allow separate copies?
247	};
248
249	def unwrapReplEnv:
250	.replEnv;
251
252	def unwrapCurrentEnv:
253	.currentEnv;
254
255	def env_set6(env; key; value):
256	if env.isReplEnv then
257	env_set(env.currentEnv; key; value) \| wrapEnv(env.atoms)
258	else
259	env_set(env.currentEnv; key; value) \| wrapEnv(env.replEnv; env.atoms)
260	end;
261
262	def env_set_(env; key; value):
263	if env.currentEnv != null then
264	env_set6(env; key; value)
265	else
266	env_set(env; key; value)
267	end;
268
269	def addToEnv6(envexp; name):
270	envexp.expr as $value
271	\| envexp.env as $rawEnv
272	\| (if $rawEnv.isReplEnv then
273	env_set_($rawEnv.currentEnv; name; $value) \| wrapEnv($rawEnv.atoms)
274	else
275	env_set_($rawEnv.currentEnv; name; $value) \| wrapEnv($rawEnv.replEnv; $rawEnv.atoms)
276	end) as $newEnv
277	\| {
278	expr: $value,
279	env: $newEnv
280	};
281
282	def addToEnv(envexp; name):
283	if envexp.env.replEnv != null then
284	addToEnv6(envexp; name)
285	else {
286	expr: envexp.expr,
287	env: env_set_(envexp.env; name; envexp.expr)
288	} end;
289
290	def _env_remove_references(refs):
291	if . != null then
292	{
293	environment: (.environment \| to_entries \| map(select(.key as $key \| refs \| contains([$key]) \| not)) \| from_entries),
294	parent: (.parent \| _env_remove_references(refs)),
295	fallback: (.fallback \| _env_remove_references(refs))
296	}
297	else . end;
298
299	def env_remove_references(refs):
300	. as $env
301	\| if has("replEnv") then
302	.currentEnv \|= _env_remove_references(refs)
303	else
304	_env_remove_references(refs)
305	end;
306
307	# Evaluation
308
309	def arg_check(args):
310	if .inputs < 0 then
311	if (abs(.inputs) - 1) > (args \| length) then
312	jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args\|length))")
313	else
314	.
315	end
316	else if .inputs != (args\|length) then
317	jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args\|length))")
318	else
319	.
320	end end;
321
322	def addFrees(newEnv; frees):
323	. as $env
324	\| reduce frees[] as $free (
325	$env;
326	. as $dot
327	\| env_req(newEnv; $free) as $lookup
328	\| if $lookup != null then
329	env_set_(.; $free; $lookup)
330	else
331	.
332	end)
333	\| . as $env
334	\| $env;
335
336	def interpret(arguments; env; _eval):
337	(if $DEBUG then _debug("INTERP: \(. \| pr_str(env))") else . end) \|
338	(select(.kind == "fn") \|
339	arg_check(arguments) \|
340	(core_interp(arguments; env) \| addEnv(env))
341	) //
342	(select(.kind == "function") as $fn \|
343	# todo: arg_check
344	(.body \| pr_str(env)) as $src \|
345	# _debug("INTERP " + $src) \|
346	# _debug("FREES " + ($fn.free_referencess \| tostring)) \|
347	env_setfallback((.env \| addFrees(env; $fn.free_referencess)); env) \| childEnv($fn.binds; arguments) as $fnEnv \|
348	# tell it about its surroundings
349	(reduce $fn.free_referencess[] as $name (
350	$fnEnv;
351	. as $env \| try env_set(
352	.;
353	$name;
354	$name \| env_get(env) \| . as $xvalue
355	\| if $xvalue.kind == "function" then
356	setpath(["free_referencess"]; $fn.free_referencess)
357	else
358	$xvalue
359	end
360	) catch $env)) as $fnEnv \|
361	# tell it about itself
362	env_multiset($fnEnv; $fn.names; $fn) as $fnEnv \|
363	{
364	env: env_multiset($fnEnv; $fn.names; $fn),
365	expr: $fn.body
366	}
367	\| . as $dot
368	# \| _debug("FNEXEC " + (.expr \| pr_str) + " " + (env_req($dot.env; $fn.binds[0]) \| pr_str))
369	\| _eval
370	\| . as $envexp
371	\|
372	{
373	expr: .expr,
374	env: env
375	}
376	# \| . as $dot
377	# \| _debug("FNPOST " + (.expr \| pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) \| pr_str))
378	# \| _debug("INTERP " + $src + " = " + (.expr\|pr_str))
379	) //
380	jqmal_error("Unsupported function kind \(.kind)");
381
a451ec51 A	382	def recurseflip(x; y):
	383	recurse(y; x);
	384
	385	def TCOWrap(env; retenv; continue):
	386	{
	387	ast: .,
	388	env: env,
	389	ret_env: retenv,
	390	finish: (continue \| not),
	391	cont: true # set inside
	392	};
	393
086a79dc A	394	def EVAL(env):
	395	def _eval_here:
	396	.env as $env \| .expr \| EVAL($env);
	397
	398	def hmap_with_env:
	399	.env as $env \| .list as $list \|
	400	if $list\|length == 0 then
	401	empty
	402	else
	403	$list[0] as $elem \|
	404	$list[1:] as $rest \|
	405	$elem[1] \| EVAL($env) as $resv \|
	406	{ value: [$elem[0], $resv.expr], env: env },
	407	({env: $resv.env, list: $rest} \| hmap_with_env)
	408	end;
	409	def map_with_env:
	410	.env as $env \| .list as $list \|
	411	if $list\|length == 0 then
	412	empty
	413	else
	414	$list[0] as $elem \|
	415	$list[1:] as $rest \|
	416	$elem \| EVAL($env) as $resv \|
	417	{ value: $resv.expr, env: env },
	418	({env: $resv.env, list: $rest} \| map_with_env)
	419	end;
a451ec51 A	420	. as $ast
	421	\| { env: env, ast: ., cont: true, finish: false, ret_env: null }
	422	\| [ recurseflip(.cont;
	423	.env as $_menv
	424	\| if .finish then
	425	.cont \|= false
086a79dc	426	else
a451ec51 A	427	(.ret_env//.env) as $_retenv
	428	\| .ret_env as $_orig_retenv
	429	\| .ast
	430	\|
	431	(select(.kind == "list") \|
	432	if .value \| length == 0 then
	433	. \| TCOWrap($_menv; $_orig_retenv; false)
	434	else
	435	(
	436	(
	437	.value \| select(.[0].value == "def!") as $value \|
	438	($value[2] \| EVAL($_menv)) as $evval \|
	439	addToEnv($evval; $value[1].value) as $val \|
	440	$val.expr \| TCOWrap($val.env; $_orig_retenv; false)
	441	) //
	442	(
	443	.value \| select(.[0].value == "let*") as $value \|
	444	($_menv \| pureChildEnv) as $subenv \|
	445	(reduce ($value[1].value \| nwise(2)) as $xvalue (
	446	$subenv;
	447	. as $env \| $xvalue[1] \| EVAL($env) as $expenv \|
	448	env_set($expenv.env; $xvalue[0].value; $expenv.expr))) as $env
	449	\| $value[2] \| TCOWrap($env; $_retenv; true)
	450	) //
	451	(
	452	.value \| select(.[0].value == "do") as $value \|
	453	(reduce ($value[1:][]) as $xvalue (
	454	{ env: $_menv, expr: {kind:"nil"} };
	455	.env as $env \| $xvalue \| EVAL($env)
	456	)) \| . as $ex \| .expr \| TCOWrap($ex.env; $_orig_retenv; false)
	457	) //
	458	(
	459	.value \| select(.[0].value == "if") as $value \|
	460	$value[1] \| EVAL(env) as $condenv \|
	461	(if (["false", "nil"] \| contains([$condenv.expr.kind])) then
	462	($value[3] // {kind:"nil"})
	463	else
	464	$value[2]
	465	end) \| TCOWrap($condenv.env; $_orig_retenv; true)
	466	) //
	467	(
	468	.value \| select(.[0].value == "fn*") as $value \|
a451ec51 A	469	# (fn* args body)
	470	$value[1].value \| map(.value) as $binds \| {
	471	kind: "function",
	472	binds: $binds,
	473	env: $_menv,
	474	body: $value[2],
597522fa	475	names: [], # we can't do that circular reference thing
a451ec51 A	476	free_referencess: $value[2] \| find_free_references($_menv \| env_dump_keys + $binds) # for dynamically scoped variables
	477	} \| TCOWrap($_menv; $_orig_retenv; false)
	478	) //
	479	(
	480	reduce .value[] as $elem (
	481	[];
	482	. as $dot \| $elem \| EVAL($_menv) as $eval_env \|
	483	($dot + [$eval_env.expr])
	484	) \| . as $expr \| first \|
	485	interpret($expr[1:]; $_menv; _eval_here) as $exprenv \|
	486	$exprenv.expr \| TCOWrap($exprenv.env; $_orig_retenv; false)
	487	) //
	488	TCOWrap($_menv; $_orig_retenv; false)
	489	)
	490	end
	491	) //
	492	(select(.kind == "vector") \|
	493	if .value\|length == 0 then
	494	{
	495	kind: "vector",
	496	value: []
	497	} \| TCOWrap($_menv; $_orig_retenv; false)
	498	else
	499	[ { env: $_menv, list: .value } \| map_with_env ] as $res \|
	500	{
	501	kind: "vector",
	502	value: $res \| map(.value)
	503	} \| TCOWrap($res \| last.env; $_orig_retenv; false)
	504	end
	505	) //
	506	(select(.kind == "hashmap") \|
	507	[ { env: $_menv, list: .value \| to_entries } \| hmap_with_env ] as $res \|
	508	{
	509	kind: "hashmap",
	510	value: $res \| map(.value) \| from_entries
	511	} \| TCOWrap($res \| last.env; $_orig_retenv; false)
	512	) //
	513	(select(.kind == "function") \|
	514	. \| TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to
	515	) //
	516	(select(.kind == "symbol") \|
	517	.value \| env_get($_menv) \| TCOWrap($_menv; null; false)
	518	) // TCOWrap($_menv; $_orig_retenv; false)
086a79dc	519	end
a451ec51 A	520	) ]
	521	\| last as $result
	522	\| ($result.ret_env // $result.env) as $env
	523	\| $result.ast
	524	\| addEnv($env);
086a79dc A	525
	526	def PRINT:
	527	pr_str;
	528
	529	def rep(env):
	530	READ \| EVAL(env) as $expenv \|
	531	if $expenv.expr != null then
	532	$expenv.expr \| PRINT
	533	else
	534	null
	535	end \| addEnv($expenv.env);
	536
	537	def repl_(env):
	538	("user> " \| _print) \|
	539	(read_line \| rep(env));
	540
	541	# we don't have no indirect functions, so we'll have to interpret the old way
	542	def replEnv:
	543	{
	544	parent: null,
	545	environment: ({
	546	"+": {
	547	kind: "fn", # native function
	548	inputs: 2,
	549	function: "number_add"
	550	},
	551	"-": {
	552	kind: "fn", # native function
	553	inputs: 2,
	554	function: "number_sub"
	555	},
	556	"*": {
	557	kind: "fn", # native function
	558	inputs: 2,
	559	function: "number_mul"
	560	},
	561	"/": {
	562	kind: "fn", # native function
	563	inputs: 2,
	564	function: "number_div"
	565	},
e9cb5f03	566	} + core_identify),
e9cb5f03	567	fallback: null
086a79dc A	568	};
	569
	570	def repl(env):
	571	def xrepl:
	572	(.env as $env \| try repl_($env) catch addEnv($env)) as $expenv \|
	573	{
	574	value: $expenv.expr,
	575	stop: false,
	576	env: ($expenv.env // .env)
	577	} \| ., xrepl;
83b974c5	578	{stop: false, env: env} \| xrepl \| if .value then (.value \| _display) else empty end;
086a79dc A	579
	580	repl(
	581	"(def! not (fn* (a) (if a false true)))" \| rep(replEnv) \| .env
597522fa	582	)