From 026270413e7f09fb95c62a2d6fe34879482ebd57 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 29 Sep 2024 16:53:23 +0200 Subject: [PATCH 01/20] jq: merge eval_ast/macroexpand into EVAL. Add DEBUG-EVAL Original issue describing the change and converting the first set of implementations: https://github.com/kanaka/mal/pull/592 Tracking issue for other implementations: https://github.com/kanaka/mal/issues/657 All normal tests pass, but REGRESS and self-hosting fail. Steps: display the results from jq without python simplify/improve quasiquote simplify replenv construction Cosmetic: Update the interpreter from latest Debian/Ubuntu. move first core functions from steps4-A to core.jq simplify interprocess communication between run and utils.jq merge run and rts.py, simplify it --- impls/jq/Dockerfile | 18 +- impls/jq/Makefile | 10 +- impls/jq/core.jq | 29 +- impls/jq/env.jq | 2 +- impls/jq/interp.jq | 2 +- impls/jq/reader.jq | 2 +- impls/jq/rts.py | 112 -------- impls/jq/run | 53 +++- impls/jq/step0_repl.jq | 17 +- impls/jq/step1_read_print.jq | 38 +-- impls/jq/step2_eval.jq | 142 ++++------ impls/jq/step3_env.jq | 171 +++++------- impls/jq/step4_if_fn_do.jq | 512 +++++++++-------------------------- impls/jq/step5_tco.jq | 452 +++++++------------------------ impls/jq/step6_file.jq | 250 ++++++++--------- impls/jq/step7_quote.jq | 295 +++++++++----------- impls/jq/step8_macros.jq | 307 +++++++-------------- impls/jq/step9_try.jq | 311 ++++++++------------- impls/jq/stepA_mal.jq | 308 +++++++-------------- impls/jq/utils.jq | 63 +---- 20 files changed, 1017 insertions(+), 2077 deletions(-) delete mode 100644 impls/jq/rts.py diff --git a/impls/jq/Dockerfile b/impls/jq/Dockerfile index 80d2c08d89..3a6415d4bd 100644 --- a/impls/jq/Dockerfile +++ b/impls/jq/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:bionic +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## @@ -9,10 +9,8 @@ MAINTAINER Joel Martin 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 apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python RUN mkdir -p /mal WORKDIR /mal @@ -21,12 +19,4 @@ 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 +RUN DEBIAN_FRONTEND=noninteractive apt-get -y install jq diff --git a/impls/jq/Makefile b/impls/jq/Makefile index 27668e3c03..f196e6bac4 100644 --- a/impls/jq/Makefile +++ b/impls/jq/Makefile @@ -1,3 +1,11 @@ all: -.PHONY: clean +clean: + rm -fr .mypy_cache/ + +check: + flake8 run + pylint run + mypy run + +.PHONY: all clean check diff --git a/impls/jq/core.jq b/impls/jq/core.jq index caf8ffd202..90ca88c126 100644 --- a/impls/jq/core.jq +++ b/impls/jq/core.jq @@ -4,6 +4,31 @@ include "reader"; def core_identify: { + "+": { + 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" + }, "env": { kind: "fn", function: "env", @@ -369,9 +394,9 @@ def core_interp(arguments; env): ) // ( select(.function == ">=") | null | wrap(arguments[0].value >= arguments[1].value | tostring) ) // ( - select(.function == "slurp") | arguments | map(.value) | issue_extern("read") | wrap("string") + select(.function == "slurp") | arguments[0].value | slurp | wrap("string") ) // ( - select(.function == "read-string") | arguments | first.value | read_str | read_form.value + select(.function == "read-string") | arguments | first.value | read_form ) // ( select(.function == "atom?") | null | wrap(arguments | first.kind == "atom" | tostring) ) // ( diff --git a/impls/jq/env.jq b/impls/jq/env.jq index 7be2191b68..b12bdac9a0 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -257,7 +257,7 @@ def addToEnv(envexp; name): def _env_remove_references(refs): if . != null then if .environment == null then - _debug("This one broke the rules, officer: \(.)") + debug("This one broke the rules, officer: \(.)") else { environment: (.environment | to_entries | map(select(.key as $key | refs | contains([$key]) | not)) | from_entries), diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq index a60693f46c..428ff612c9 100644 --- a/impls/jq/interp.jq +++ b/impls/jq/interp.jq @@ -71,7 +71,7 @@ def addFrees(newEnv; frees): def interpret(arguments; env; _eval): extractReplEnv(env) as $replEnv | extractAtoms(env) as $envAtoms | - (if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) | + (if $DEBUG then debug("INTERP: \(pr_str(env))") end) | (select(.kind == "fn") | arg_check(arguments) | (select(.function == "eval") | diff --git a/impls/jq/reader.jq b/impls/jq/reader.jq index d8c98198f7..639f8b946f 100644 --- a/impls/jq/reader.jq +++ b/impls/jq/reader.jq @@ -308,4 +308,4 @@ def read_form_(depth): end end end end end end end end end end); def read_form: - {tokens: .} | read_form_(0); + ({tokens: read_str} | read_form_(0).value) // {kind: "nil"}; diff --git a/impls/jq/rts.py b/impls/jq/rts.py deleted file mode 100644 index fe1f16b637..0000000000 --- a/impls/jq/rts.py +++ /dev/null @@ -1,112 +0,0 @@ -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:]) diff --git a/impls/jq/run b/impls/jq/run index 02e476e49f..aad2862bdb 100755 --- a/impls/jq/run +++ b/impls/jq/run @@ -1,3 +1,52 @@ -#!/bin/sh +#!/usr/bin/python3 +"""Spawn a jq subprocess and wrap some IO interactions for it. -exec python rts.py "${@}" +jq seems unable to + - open an arbitrary file (slurp) + - emit a string on stdout without new line (readline) +""" +from json import JSONDecodeError, dumps, loads +from os import environ +from os.path import dirname, join, realpath +from subprocess import PIPE, Popen +from sys import argv + +rundir = dirname(realpath(__file__)) +with Popen(args=['/usr/bin/jq', + '--argjson', 'DEBUG', 'false', + '-nrM', # --null-input --raw-output --monochrome-output + '-L', rundir, + '-f', join(rundir, environ.get('STEP', 'stepA_mal') + '.jq'), + '--args'] + argv[1:], + stdin=PIPE, stderr=PIPE, encoding='utf-8', + ) as proc: + assert proc.stderr is not None # for mypy + for received in proc.stderr: + try: + as_json = loads(received) + except JSONDecodeError: + print(f'JQ STDERR: {received}', end=None) + else: + match as_json: + case ['DEBUG:', ['display', str(message)]]: + # While at it, provide a way to immediately print to + # stdin for DEBUG-EVAL, println and prn (jq is able to + # output to stderr, but *we* are already piping it). + print(message) + # Jq waits for this signal to go on, so that its own + # output is not mixed with our one. + print('null', file=proc.stdin, flush=True) + case ['DEBUG:', ['readline', str(prompt)]]: + try: + data = input(prompt) + except EOFError: + break # Expected end of this script + print(dumps(data), file=proc.stdin, flush=True) + case ['DEBUG:', ['slurp', str(fname)]]: + with open(fname, 'r', encoding='utf-8') as file_handler: + data = file_handler.read() + print(dumps(data), file=proc.stdin, flush=True) + case _: + # Allow normal debugging information for other purposes. + print(f'JQ STDERR: {received}', end=None) +print() diff --git a/impls/jq/step0_repl.jq b/impls/jq/step0_repl.jq index 46c5a5eaf8..e534b4f6ea 100644 --- a/impls/jq/step0_repl.jq +++ b/impls/jq/step0_repl.jq @@ -1,10 +1,5 @@ include "utils"; -def read_line: - . as $in - | label $top - | _readline; - def READ: .; @@ -14,14 +9,10 @@ def EVAL: def PRINT: .; -def rep: - READ | EVAL | PRINT | _display; - -def repl_: - ("user> " | _print) | - (read_line | rep); - def repl: - while(true; repl_); + # Infinite generator, interrupted by ./run. + "user> " | __readline | + READ | EVAL | + PRINT, repl; repl diff --git a/impls/jq/step1_read_print.jq b/impls/jq/step1_read_print.jq index d0069c27ed..c253bfa9a4 100644 --- a/impls/jq/step1_read_print.jq +++ b/impls/jq/step1_read_print.jq @@ -2,13 +2,8 @@ include "reader"; include "printer"; include "utils"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; def EVAL: .; @@ -16,27 +11,16 @@ 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; + # Infinite generator, interrupted by an exception or ./run. + "user> " | __readline | + try ( + READ | EVAL | + PRINT, repl + ) catch if is_jqmal_error then + ., repl + else + halt_error + end; repl diff --git a/impls/jq/step2_eval.jq b/impls/jq/step2_eval.jq index e04ce81ded..83a0e6db6f 100644 --- a/impls/jq/step2_eval.jq +++ b/impls/jq/step2_eval.jq @@ -2,17 +2,8 @@ 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"); + read_form; def arg_check(args): if .inputs != (args|length) then @@ -41,81 +32,68 @@ def interpret(arguments; env): 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; + # ("EVAL: \(pr_str(env))" | _display | empty), + (select(.kind == "list") | + .value | select(length != 0) as $value | + map(EVAL(env)) | .[1:] as $args | first | interpret($args; env) + ) // + ( + select(.kind == "vector") | + { + kind: "vector", + value: .value|map(EVAL(env)) + } + ) // + ( + select(.kind == "hashmap") | + { + kind: "hashmap", + value: .value|map_values(.value |= EVAL(env)) + } + ) // + ( + select(.kind == "symbol") | + env[.value] // jqmal_error("'\(.)' not found") + ) // + .; 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)); +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + PRINT, ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { - "+": { - 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) \ No newline at end of file + "+": { + 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" + }, + } + | + repl diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index 64c13e68a9..ed8f4f991c 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -1,22 +1,12 @@ include "reader"; include "printer"; include "utils"; - -def read_line: - . as $in - | label $top - | _readline; +include "env"; def READ: - read_str | read_form | .value; - -# Environment functions + read_form; -def pureChildEnv: - { - parent: ., - environment: {} - }; +# Environment Functions def env_set(env; $key; $value): { @@ -49,14 +39,6 @@ def env_get(env): $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))") @@ -106,79 +88,86 @@ def EVAL(env): { value: $resv.expr, env: env }, ({env: $resv.env, list: $rest} | map_with_env) end; - (select(.kind == "list") | - if .value | length == 0 then - . | addEnv(env) - else + + # EVAL starts here. + if "DEBUG-EVAL" | env_find(env).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + ( + select(.[0].value == "def!") as $value | + ($value[2] | EVAL(env)) as $evval | + addToEnv($evval; $value[1].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 .[] 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) + ) + ) + ) // ( - ( - .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); + 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: +def repl: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + (.expr | PRINT), (.env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; + +# The main program starts here. { parent: null, environment: { @@ -203,16 +192,6 @@ def replEnv: 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) + } + | + repl diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index bccd27e71a..c96ac6d290 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -1,191 +1,14 @@ include "reader"; include "printer"; include "utils"; +include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; # 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 @@ -210,62 +33,6 @@ def env_set(env; $key; $value): 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 @@ -334,7 +101,7 @@ def addFrees(newEnv; frees): | $env; def interpret(arguments; env; _eval): - (if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) | + (if $DEBUG then debug("INTERP: \(. | pr_str(env))") else . end) | (select(.kind == "fn") | arg_check(arguments) | (core_interp(arguments; env) | addEnv(env)) @@ -342,8 +109,8 @@ def interpret(arguments; env; _eval): (select(.kind == "function") as $fn | # todo: arg_check (.body | pr_str(env)) as $src | - # _debug("INTERP " + $src) | - # _debug("FREES " + ($fn.free_referencess | tostring)) | + # 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 ( @@ -365,7 +132,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) + # | debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) | _eval | . as $envexp | @@ -374,23 +141,11 @@ def interpret(arguments; env; _eval): 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)) + # | 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); @@ -417,150 +172,129 @@ def EVAL(env): { value: $resv.expr, env: env }, ({env: $resv.env, list: $rest} | map_with_env) end; - (select(.kind == "list") | - if .value | length == 0 then - . | addEnv(env) - else + + # EVAL starts here. + if "DEBUG-EVAL" | env_find(env).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | + (select(.kind == "list") | + .value | select(length != 0) as $value | + ( + ( + select(.[0].value == "def!") | + ($value[2] | EVAL(env)) as $evval | + addToEnv($evval; $value[1].value) + ) // + ( + select(.[0].value == "let*") | + (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 } + ) // + ( + select(.[0].value == "do") | + (reduce ($value[1:][]) as $xvalue ( + { env: env, expr: {kind:"nil"} }; + .env as $env | $xvalue | EVAL($env) + )) + ) // + ( + select(.[0].value == "if") | + $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 + ) // + ( + select(.[0].value == "fn*") | + # 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 .[] 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) + ) + ) + ) // + (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) + ) // ( - ( - .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) + select(.kind == "function") | + . | addEnv(env) # return this unchanged, since it can only be applied to + ) // + ( + select(.kind == "symbol") | + .value | env_get(env) | 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); + // 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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + (.expr | PRINT), (.env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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), + environment: 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 -) + } + | eval_ign("(def! not (fn* (a) (if a false true)))") + | + repl diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index c2053e30d7..ab1c9731ab 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -1,191 +1,14 @@ include "reader"; include "printer"; include "utils"; +include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; # 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 @@ -210,62 +33,6 @@ def env_set(env; $key; $value): 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 @@ -334,7 +101,7 @@ def addFrees(newEnv; frees): | $env; def interpret(arguments; env; _eval): - (if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) | + (if $DEBUG then debug("INTERP: \(. | pr_str(env))") else . end) | (select(.kind == "fn") | arg_check(arguments) | (core_interp(arguments; env) | addEnv(env)) @@ -342,8 +109,8 @@ def interpret(arguments; env; _eval): (select(.kind == "function") as $fn | # todo: arg_check (.body | pr_str(env)) as $src | - # _debug("INTERP " + $src) | - # _debug("FREES " + ($fn.free_referencess | tostring)) | + # 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 ( @@ -365,7 +132,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) + # | debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) | _eval | . as $envexp | @@ -374,8 +141,8 @@ def interpret(arguments; env; _eval): 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)) + # | 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)"); @@ -417,6 +184,7 @@ def EVAL(env): { 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; @@ -424,70 +192,74 @@ def EVAL(env): | if .finish then .cont |= false else - (.ret_env//.env) as $_retenv + (.ret_env//.env) as $_retenv | .ret_env as $_orig_retenv | .ast | + if "DEBUG-EVAL" | env_find($_menv).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | (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(length != 0) as $value | ( - .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 + ( + select(.[0].value == "def!") | + ($value[2] | EVAL($_menv)) as $evval | + addToEnv($evval; $value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + ($_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) + ) // + ( + select(.[0].value == "do") | + (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) + ) // + ( + select(.[0].value == "if") | + $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) + ) // + ( + select(.[0].value == "fn*") | + # (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 + ) // + ( + reduce .[] 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) + ) ) // (select(.kind == "vector") | if .value|length == 0 then @@ -503,21 +275,25 @@ def EVAL(env): } | TCOWrap($res | last.env; $_orig_retenv; false) end ) // - (select(.kind == "hashmap") | + ( + 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") | + ( + select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // - (select(.kind == "symbol") | + ( + select(.kind == "symbol") | .value | env_get($_menv) | TCOWrap($_menv; null; false) - ) // TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) end - ) ] + ) ] | last as $result | ($result.ret_env // $result.env) as $env | $result.ast @@ -526,57 +302,27 @@ def EVAL(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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | + (.expr | PRINT), (.env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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), + environment: 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 -) + } + | eval_ign("(def! not (fn* (a) (if a false true)))") + | + repl diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index 5a3076e5aa..25bd28973e 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -5,13 +5,8 @@ include "interp"; include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; def recurseflip(x; y): recurse(y; x); @@ -57,6 +52,7 @@ def EVAL(env): { 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; @@ -72,68 +68,81 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | + if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | (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(length != 0) as $value | ( - .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: ($_menv | 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 + ( + select(.[0].value == "def!") | + ($value[2] | EVAL($_menv)) as $evval | + addToEnv($evval; $value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + ($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) + ) // + ( + select(.[0].value == "do") | + (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) + ) // + ( + select(.[0].value == "if") | + $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) + ) // + ( + select(.[0].value == "fn*") | + # (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 | 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 + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . 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])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + ) ) // (select(.kind == "vector") | if .value|length == 0 then @@ -142,26 +151,30 @@ def EVAL(env): value: [] } | TCOWrap($_menv; $_orig_retenv; false) else - [ { env: env, list: .value } | map_with_env ] as $res | + [ { env: $currentEnv, 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 | + ( + select(.kind == "hashmap") | + [ { env: $currentEnv, 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") | + ( + select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // - (select(.kind == "symbol") | + ( + select(.kind == "symbol") | .value | env_get($currentEnv) | TCOWrap($_menv; null; false) - ) // TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) end ) ] | last as $result @@ -172,82 +185,35 @@ def EVAL(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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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 + environment: core_identify, + fallback: null + } | 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: + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | 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))") | - "" + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty else - repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) ) - end; - -[ main ] | _halt + repl + end diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index bd7ddfdfda..21bb1ee282 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -5,13 +5,8 @@ include "interp"; include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; def recurseflip(x; y): recurse(y; x); @@ -25,19 +20,6 @@ def TCOWrap(env; retenv; continue): 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 input is ('name, arg), return arg, else nothing. @@ -45,14 +27,14 @@ def quasiquote: select(.kind == "list") | .value | select(length == 2) - | select(.[0] | _symbol_v(name)) + | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): - ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) - // [_symbol("cons"), quasiquote, acc]) - | {kind:"list", value:.}; + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # Adapt parameters for jq foldr. def qq_foldr: @@ -67,10 +49,10 @@ def quasiquote: | qq_foldr ) // ( select(.kind == "vector") - | {kind:"list", value:[_symbol("vec"), qq_foldr]} + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") - | {kind:"list", value:[_symbol("quote"), .]} + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def EVAL(env): @@ -105,6 +87,7 @@ def EVAL(env): { 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; @@ -119,81 +102,90 @@ def EVAL(env): | $_menv | unwrapCurrentEnv as $currentEnv # unwrap env "package" | $_menv | unwrapReplEnv as $replEnv # - | $init - | + | + if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | (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(length != 0) as $value | ( - .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 | 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 + ( + select(.[0].value == "def!") | + ($value[2] | EVAL($_menv)) as $evval | + addToEnv($evval; $value[1].value) as $val | + $val.expr | TCOWrap($val.env; $_orig_retenv; false) + ) // + ( + select(.[0].value == "let*") | + ($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) + ) // + ( + select(.[0].value == "do") | + (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) + ) // + ( + select(.[0].value == "if") | + $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) + ) // + ( + select(.[0].value == "fn*") | + # (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 | 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 == "quasiquoteexpand") - | .[1] | quasiquote | 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(.[0].value == "quote") | + $value[1] | TCOWrap($_menv; $_orig_retenv; false) + ) // + ( + select(.[0].value == "quasiquote") | + $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) + ) // + ( + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . 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])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) + ) ) // (select(.kind == "vector") | if .value|length == 0 then @@ -202,26 +194,30 @@ def EVAL(env): value: [] } | TCOWrap($_menv; $_orig_retenv; false) else - [ { env: env, list: .value } | map_with_env ] as $res | + [ { 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: env, list: (.value | to_entries) } | hmap_with_env ] as $res | + ( + 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") | + ( + select(.kind == "function") | . | TCOWrap($_menv; $_orig_retenv; false) # return this unchanged, since it can only be applied to ) // - (select(.kind == "symbol") | + ( + select(.kind == "symbol") | .value | env_get($currentEnv) | TCOWrap($_menv; null; false) - ) // TCOWrap($_menv; $_orig_retenv; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) end ) ] | last as $result @@ -232,82 +228,35 @@ def EVAL(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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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), + environment: 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: + | eval_ign("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))))") + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | 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))") | - "" + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty else - repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) ) - end; - -[ main ] | _halt + repl + end diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 75c18c5129..0b1a620a35 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -5,13 +5,8 @@ include "interp"; include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; def recurseflip(x; y): recurse(y; x); @@ -25,19 +20,6 @@ def TCOWrap(env; retenv; continue): 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 input is ('name, arg), return arg, else nothing. @@ -45,14 +27,14 @@ def quasiquote: select(.kind == "list") | .value | select(length == 2) - | select(.[0] | _symbol_v(name)) + | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): - ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) - // [_symbol("cons"), quasiquote, acc]) - | {kind:"list", value:.}; + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # Adapt parameters for jq foldr. def qq_foldr: @@ -67,10 +49,10 @@ def quasiquote: | qq_foldr ) // ( select(.kind == "vector") - | {kind:"list", value:[_symbol("vec"), qq_foldr]} + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") - | {kind:"list", value:[_symbol("quote"), .]} + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def set_macro_function: @@ -80,56 +62,10 @@ def set_macro_function: .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 @@ -158,34 +94,6 @@ def EVAL(env): { 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 } @@ -202,29 +110,29 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | + if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | (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(length != 0) as $value | ( ( - .value | select(.[0].value == "def!") as $value | + select(.[0].value == "def!") | ($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 | + select(.[0].value == "defmacro!") | ($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 | + select(.[0].value == "let*") | ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( $_menv; @@ -233,14 +141,14 @@ def EVAL(env): | $value[2] | TCOWrap($env; $_retenv; true) ) // ( - .value | select(.[0].value == "do") as $value | + select(.[0].value == "do") | (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 | + select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) @@ -249,45 +157,86 @@ def EVAL(env): end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( - .value | select(.[0].value == "fn*") as $value | + select(.[0].value == "fn*") | # (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 | 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 + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | 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 | + select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( - .value | select(.[0].value == "quasiquoteexpand") - | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) - ) // - ( - .value | select(.[0].value == "quasiquote") as $value | + select(.[0].value == "quasiquote") | $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 | + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + if $fn.kind == "function" and $fn.is_macro then + $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) + else + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . 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])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + end ) // 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 ) // - (eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)) + ( + 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($currentEnv) | TCOWrap($_menv; null; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) end ) ] | last as $result @@ -298,84 +247,36 @@ def EVAL(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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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), + environment: 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: + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | 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))") | - "" + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty else - repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) ) - end; - -[ main ] | _halt + repl + end diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 9c3d416f48..11126aa5f7 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -5,13 +5,8 @@ include "interp"; include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; def recurseflip(x; y): recurse(y; x); @@ -25,19 +20,6 @@ def TCOWrap(env; retenv; continue): 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 input is ('name, arg), return arg, else nothing. @@ -45,14 +27,14 @@ def quasiquote: select(.kind == "list") | .value | select(length == 2) - | select(.[0] | _symbol_v(name)) + | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): - ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) - // [_symbol("cons"), quasiquote, acc]) - | {kind:"list", value:.}; + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # Adapt parameters for jq foldr. def qq_foldr: @@ -67,10 +49,10 @@ def quasiquote: | qq_foldr ) // ( select(.kind == "vector") - | {kind:"list", value:[_symbol("vec"), qq_foldr]} + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") - | {kind:"list", value:[_symbol("quote"), .]} + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def set_macro_function: @@ -80,56 +62,10 @@ def set_macro_function: .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 @@ -158,34 +94,6 @@ def EVAL(env): { 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 } @@ -202,29 +110,29 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | + if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | (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(length != 0) as $value | ( ( - .value | select(.[0].value == "def!") as $value | + select(.[0].value == "def!") | ($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 | + select(.[0].value == "defmacro!") | ($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 | + select(.[0].value == "let*") | ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( $_menv; @@ -233,19 +141,19 @@ def EVAL(env): | $value[2] | TCOWrap($env; $_retenv; true) ) // ( - .value | select(.[0].value == "do") as $value | + select(.[0].value == "do") | (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 | + select(.[0].value == "try*") | 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 ($value[2].value[0] | .kind == "symbol" and .value == "catch*") then (if ($exc | is_jqmal_error) then $exc[19:] as $ex | try ( @@ -269,7 +177,7 @@ def EVAL(env): ) ) // ( - .value | select(.[0].value == "if") as $value | + select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) @@ -278,45 +186,86 @@ def EVAL(env): end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( - .value | select(.[0].value == "fn*") as $value | + select(.[0].value == "fn*") | # (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 | 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 + ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { + kind: "function", + binds: $binds, + env: ($_menv | 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 | + select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( - .value | select(.[0].value == "quasiquoteexpand") - | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) - ) // - ( - .value | select(.[0].value == "quasiquote") as $value | + select(.[0].value == "quasiquote") | $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 | + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + if $fn.kind == "function" and $fn.is_macro then + $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) + else + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . 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])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + end ) // 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 ) // - (eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)) + ( + 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($currentEnv) | TCOWrap($_menv; null; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) end ) ] | last as $result @@ -327,84 +276,36 @@ def EVAL(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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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), + environment: 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: + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | 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))") | - "" + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty else - repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) ) - end; - -[ main ] | _halt + repl + end diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 0c794f3751..5bfb0299af 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -5,13 +5,8 @@ include "interp"; include "env"; include "core"; -def read_line: - . as $in - | label $top - | _readline; - def READ: - read_str | read_form | .value; + read_form; def recurseflip(x; y): recurse(y; x); @@ -25,19 +20,6 @@ def TCOWrap(env; retenv; continue): 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 input is ('name, arg), return arg, else nothing. @@ -45,14 +27,14 @@ def quasiquote: select(.kind == "list") | .value | select(length == 2) - | select(.[0] | _symbol_v(name)) + | select(.[0] | .kind == "symbol" and .value == name) | .[1]; # Right-folding function. The current element is provided as input. def qq_loop(acc): - ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) - // [_symbol("cons"), quasiquote, acc]) - | {kind:"list", value:.}; + (_starts_with("splice-unquote") + | {kind:"list", value:[{kind:"symbol", value:"concat"}, ., acc]}) + // {kind:"list", value:[{kind:"symbol", value:"cons"}, quasiquote, acc]}; # Adapt parameters for jq foldr. def qq_foldr: @@ -67,10 +49,10 @@ def quasiquote: | qq_foldr ) // ( select(.kind == "vector") - | {kind:"list", value:[_symbol("vec"), qq_foldr]} + | {kind:"list", value: [{kind:"symbol", value:"vec"}, qq_foldr]} ) // ( select(.kind == "hashmap" or .kind == "symbol") - | {kind:"list", value:[_symbol("quote"), .]} + | {kind:"list", value:[{kind:"symbol", value:"quote"}, .]} ) // .; def set_macro_function: @@ -80,56 +62,10 @@ def set_macro_function: .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 @@ -158,41 +94,13 @@ def EVAL(env): { 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 $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 @@ -204,33 +112,33 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | + if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + . != null and .kind != "false" and .kind != "nil" + then + ("EVAL: \(pr_str(env))" | _display | empty), . + end + | (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(length != 0) as $value | ( ( - .value | select(.[0].value == "atoms??") as $value | + select(.[0].value == "atoms??") | $_menv.atoms | keys | map(wrap("string")) | wrap("list") | TCOWrap($_menv; $_orig_retenv; false) ) // ( - .value | select(.[0].value == "def!") as $value | + select(.[0].value == "def!") | ($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 | + select(.[0].value == "defmacro!") | ($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 | + select(.[0].value == "let*") | ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( $_menv; @@ -239,19 +147,19 @@ def EVAL(env): | $value[2] | TCOWrap($env; $_retenv; true) ) // ( - .value | select(.[0].value == "do") as $value | + select(.[0].value == "do") | (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 | + select(.[0].value == "try*") | 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 ($value[2].value[0] | .kind == "symbol" and .value == "catch*") then (if ($exc | is_jqmal_error) then $exc[19:] as $ex | try ( @@ -275,7 +183,7 @@ def EVAL(env): ) ) // ( - .value | select(.[0].value == "if") as $value | + select(.[0].value == "if") | $value[1] | EVAL($_menv) as $condenv | (if (["false", "nil"] | contains([$condenv.expr.kind])) then ($value[3] // {kind:"nil"}) @@ -284,7 +192,7 @@ def EVAL(env): end) | TCOWrap($condenv.env; $_orig_retenv; true) ) // ( - .value | select(.[0].value == "fn*") as $value | + select(.[0].value == "fn*") | # (fn* args body) $value[1].value | map(.value) as $binds | ($value[2] | find_free_references($currentEnv | env_dump_keys + $binds)) as $free_referencess | { @@ -298,33 +206,74 @@ def EVAL(env): } | TCOWrap($_menv; $_orig_retenv; false) ) // ( - .value | select(.[0].value == "quote") as $value | + select(.[0].value == "quote") | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // ( - .value | select(.[0].value == "quasiquoteexpand") - | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) - ) // - ( - .value | select(.[0].value == "quasiquote") as $value | + select(.[0].value == "quasiquote") | $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 | + ( + .[0] | EVAL($_menv) | + (.env | setpath(["atoms"]; $_menv.atoms)) as $_menv | + .expr + ) as $fn | + if $fn.kind == "function" and $fn.is_macro then + $fn | interpret($value[1:]; $_menv; _eval_here) as $exprenv | + $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; true) + else + $value[1:] | + (reduce .[] as $elem ( + {env: $_menv, val: []}; + # debug(".val: \(.val) elem=\($elem)") | + . 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])} + # | debug(".val: \(.val)") + )) as $expr | + # debug("fn.kind: \($fn.kind)", "expr: \($expr)") | + $fn | + interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) + end ) // 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 ) // - (eval_ast($_menv) | TCOWrap($_menv; $_orig_retenv; false)) + ( + 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($currentEnv) | TCOWrap($_menv; null; false) + ) // + TCOWrap($_menv; $_orig_retenv; false) end - | (if $DEBUG then _debug("POSTEVAL: \($ast | pr_str($_menv)) = \(.ast | pr_str($_menv))") else . 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 @@ -334,89 +283,38 @@ def EVAL(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: + # Infinite generator, interrupted by an exception or ./run. + . as $env | "user> " | __readline | + try ( + READ | EVAL($env) | .env as $env | + (.expr | PRINT($env)), ($env | repl) + ) catch if is_jqmal_error then + ., ($env | repl) + else + halt_error + end; -def repl_(env): - ("user> " | _print) | - (read_line | rep(env)); +def eval_ign(expr): + . as $env | expr | READ | EVAL($env) | .env; -# we don't have no indirect functions, so we'll have to interpret the old way -def replEnv: +# The main program starts here. { 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), + environment: 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: + | env_set_(.; "*ARGV*"; {kind:"list", value:[$ARGS.positional[1:] | .[] | {kind:"string", value:.}]}) + | 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 - ) + eval_ign("(load-file \($ARGS.positional[0] | tojson))") | + empty else - repl( getEnv as $env | env_set_($env; "*ARGV*"; [] | wrap("list")) ) - end; - -[ main ] | _halt + eval_ign("(println (str \"Mal [\" *host-language* \"]\"))") | + repl + end diff --git a/impls/jq/utils.jq b/impls/jq/utils.jq index a4b3055ad9..36cae741d5 100644 --- a/impls/jq/utils.jq +++ b/impls/jq/utils.jq @@ -1,12 +1,3 @@ -def _debug(ex): - . as $top - | ex - | debug - | $top; - -def _print: - tostring; - def nwise(n): def _nwise: if length <= n then @@ -102,54 +93,16 @@ def tomal: ) ); -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; +# The following IO actions are implemented in rts.py. def __readline: - __readline(.); + ["readline", .] | debug | input; +# The output is not very interesting. +# 'input' here only ensures that the python process has printed the +# message before any further output by the jq process. 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; + ["display", .] | debug | input; -def _halt: - [] - | issue_extern("halt"; {nowait: true}) - | halt; - -def trap: - _write_to_file("trap_reason.json") | jqmal_error("trap"); +def slurp: + ["slurp", .] | debug | input; From a9f7c88eea1757a91fe86d85b3e3532d7bdad171 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 29 Sep 2024 17:01:44 +0200 Subject: [PATCH 02/20] jq: fix evaluation of vectors and maps in regression tests --- impls/jq/step3_env.jq | 48 ++++++++------------------- impls/jq/step4_if_fn_do.jq | 65 ++++++++++-------------------------- impls/jq/step5_tco.jq | 61 ++++++++++++---------------------- impls/jq/step6_file.jq | 67 ++++++++++++-------------------------- impls/jq/step7_quote.jq | 67 ++++++++++++-------------------------- impls/jq/step8_macros.jq | 67 ++++++++++++-------------------------- impls/jq/step9_try.jq | 67 ++++++++++++-------------------------- impls/jq/stepA_mal.jq | 67 ++++++++++++-------------------------- 8 files changed, 152 insertions(+), 357 deletions(-) diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index ed8f4f991c..291a741fa0 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -66,30 +66,6 @@ def interpret(arguments; 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; - - # EVAL starts here. if "DEBUG-EVAL" | env_find(env).environment["DEBUG-EVAL"] | . != null and .kind != "false" and .kind != "nil" then @@ -126,19 +102,23 @@ def EVAL(env): ) // ( select(.kind == "vector") | - [ { env: env, list: .value } | map_with_env ] as $res | - { - kind: "vector", - value: $res | map(.value) - } | addEnv($res | last.env) + .value | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .expr |= {kind:"vector", value:.} ) // ( 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) + .value | to_entries | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .expr |= {kind:"hashmap", value:from_entries} ) // ( select(.kind == "symbol") | diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index c96ac6d290..18850b4e8e 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -150,29 +150,6 @@ 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; - # EVAL starts here. if "DEBUG-EVAL" | env_find(env).environment["DEBUG-EVAL"] | . != null and .kind != "false" and .kind != "nil" @@ -239,37 +216,31 @@ def EVAL(env): ) ) ) // - (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 == "vector") | + .value | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .expr |= {kind:"vector", value:.} ) // ( - select(.kind == "function") | - . | addEnv(env) # return this unchanged, since it can only be applied to + select(.kind == "hashmap") | + .value | to_entries | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .expr |= {kind:"hashmap", value:from_entries} ) // ( select(.kind == "symbol") | .value | env_get(env) | addEnv(env) - ) - // addEnv(env); + ) // + addEnv(env); def PRINT: pr_str; diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index ab1c9731ab..f402e4fda8 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -162,29 +162,6 @@ 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; @@ -261,27 +238,29 @@ def EVAL(env): TCOWrap($_menv; $_orig_retenv; false) ) ) // - (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 == "vector") | + .value | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) ) // ( 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) + .value | to_entries | + reduce .[] as $x ({expr:[], env:env}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index 25bd28973e..c1ebe4b419 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -24,35 +24,6 @@ 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; @@ -144,27 +115,29 @@ def EVAL(env): TCOWrap($_menv; $_orig_retenv; false) ) ) // - (select(.kind == "vector") | - if .value|length == 0 then - { - kind: "vector", - value: [] - } | TCOWrap($_menv; $_orig_retenv; false) - else - [ { env: $currentEnv, list: .value } | map_with_env ] as $res | - { - kind: "vector", - value: $res | map(.value) - } | TCOWrap($res | last.env; $_orig_retenv; false) - end + ( + select(.kind == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "hashmap") | - [ { env: $currentEnv, list: (.value | to_entries) } | hmap_with_env ] as $res | - { - kind: "hashmap", - value: $res | map(.value) | from_entries - } | TCOWrap($res | last.env; $_orig_retenv; false) + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index 21bb1ee282..574905e9b6 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -59,35 +59,6 @@ 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; @@ -187,27 +158,29 @@ def EVAL(env): TCOWrap($_menv; $_orig_retenv; false) ) ) // - (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 == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) ) // ( 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) + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 0b1a620a35..e15fb52334 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -66,35 +66,6 @@ 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; @@ -206,27 +177,29 @@ def EVAL(env): TCOWrap($_menv; $_orig_retenv; false) ) ) // - (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 == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) ) // ( 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) + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 11126aa5f7..48060613b1 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -66,35 +66,6 @@ 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; @@ -235,27 +206,29 @@ def EVAL(env): TCOWrap($_menv; $_orig_retenv; false) ) ) // - (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 == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) ) // ( 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) + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 5bfb0299af..60d319e563 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -66,35 +66,6 @@ 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; @@ -241,27 +212,29 @@ def EVAL(env): TCOWrap($_menv; $_orig_retenv; false) ) ) // - (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 == "vector") | + .value | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x | EVAL($acc.env) | + .expr |= $acc.expr + [.] + ) | + .env as $e | + {kind:"vector", value:.expr} | + TCOWrap($e; $_orig_retenv; false) ) // ( 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) + .value | to_entries | + reduce .[] as $x ({expr:[], env:$_menv}; + . as $acc | + $x.value.value | EVAL($acc.env) | + .expr |= (. as $e | $acc.expr + [$x | .value.value |= $e]) + ) | + .env as $e | + {kind:"hashmap", value:.expr|from_entries} | + TCOWrap($e; $_orig_retenv; false) ) // ( select(.kind == "function") | From 9dd68845e8320f3342b707426335042accd04cf6 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 29 Sep 2024 17:05:40 +0200 Subject: [PATCH 03/20] jq: remove more unused stuff --- impls/jq/utils.jq | 26 -------------------------- 1 file changed, 26 deletions(-) diff --git a/impls/jq/utils.jq b/impls/jq/utils.jq index 36cae741d5..6956eab813 100644 --- a/impls/jq/utils.jq +++ b/impls/jq/utils.jq @@ -22,13 +22,6 @@ def wrap(kind): value: . }; -def wrap2(kind; opts): - opts + { - kind: kind, - value: . - }; - - def find_free_references(keys): def _refs: if . == null then [] else @@ -74,25 +67,6 @@ def find_free_references(keys): 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") - ) - ); - # The following IO actions are implemented in rts.py. def __readline: From 711d39353c4f9dd0554ceda0f6b77c8dbc735f33 Mon Sep 17 00:00:00 2001 From: AnotherTest Date: Sat, 5 Oct 2024 12:53:11 +0200 Subject: [PATCH 04/20] jq: fix TCO for vectors, breaking let* in step5 --- impls/jq/step5_tco.jq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index f402e4fda8..5731006111 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -241,7 +241,7 @@ def EVAL(env): ( select(.kind == "vector") | .value | - reduce .[] as $x ({expr:[], env:env}; + reduce .[] as $x ({expr:[], env:$_menv}; . as $acc | $x | EVAL($acc.env) | .expr |= $acc.expr + [.] From 06a2a69f55d735582ee4af768b3a5626eb44e8cf Mon Sep 17 00:00:00 2001 From: AnotherTest Date: Sat, 5 Oct 2024 13:01:28 +0200 Subject: [PATCH 05/20] jq: fix TCO for symbols, breaking let* in steps 5 to A Fix by alimpfard. --- impls/jq/step5_tco.jq | 2 +- impls/jq/step6_file.jq | 2 +- impls/jq/step7_quote.jq | 2 +- impls/jq/step8_macros.jq | 2 +- impls/jq/step9_try.jq | 2 +- impls/jq/stepA_mal.jq | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 5731006111..a4419c6192 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -268,7 +268,7 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($_menv) | TCOWrap($_menv; null; false) + .value | env_get($_menv) | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index c1ebe4b419..721ad7cc4e 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -145,7 +145,7 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; null; false) + .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index 574905e9b6..ca632d4ae8 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -188,7 +188,7 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; null; false) + .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index e15fb52334..5e6d10111f 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -207,7 +207,7 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; null; false) + .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 48060613b1..a7f0472a9d 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -236,7 +236,7 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; null; false) + .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 60d319e563..35684f5288 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -242,7 +242,7 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; null; false) + .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end From 5d43f64fcd1b5ba854b1ec7870c052c2c875341c Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 29 Sep 2024 23:08:20 +0200 Subject: [PATCH 06/20] jq: inline some short undocumented functions --- impls/jq/env.jq | 38 ++++++-------------------------------- impls/jq/interp.jq | 12 ++++++------ impls/jq/step4_if_fn_do.jq | 10 +++++----- impls/jq/step5_tco.jq | 10 +++++----- 4 files changed, 22 insertions(+), 48 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index b12bdac9a0..bc3117c55d 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -49,37 +49,8 @@ def pureChildEnv: 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_multiset(fn): + .environment += (reduce fn.names[] as $key(.environment; .[$key] |= fn)); def env_set($key; $value): (if $value.kind == "function" or $value.kind == "atom" then @@ -96,7 +67,10 @@ def env_set($key; $value): end else . - end) | inform_function($key) + end) | + .names += [$key] | + .names |= unique + else $value end) as $value | { diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq index 428ff612c9..b8ae3ac57d 100644 --- a/impls/jq/interp.jq +++ b/impls/jq/interp.jq @@ -137,10 +137,10 @@ def interpret(arguments; env; _eval): (.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 | + env_setfallback(extractEnv(.env | addFrees(env; $fn.free_referencess)); extractEnv(env)) | childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( - $fnEnv; + .; . as $env | try env_set_( .; $name; @@ -150,12 +150,12 @@ def interpret(arguments; env; _eval): else $xvalue end - ) catch $env)) as $fnEnv | + ) catch $env)) | # tell it about itself - env_multiset($fnEnv; $fn.names; $fn) as $fnEnv | + env_multiset($fn) | + wrapEnv($replEnv; $envAtoms) | { - env: env_multiset($fnEnv; $fn.names; $fn) - | wrapEnv($replEnv; $envAtoms), + env: ., expr: $fn.body } | . as $dot diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index 18850b4e8e..eb435dba6a 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -111,10 +111,10 @@ def interpret(arguments; env; _eval): (.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 | + env_setfallback((.env | addFrees(env; $fn.free_referencess)); env) | childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( - $fnEnv; + .; . as $env | try env_set( .; $name; @@ -124,11 +124,11 @@ def interpret(arguments; env; _eval): else $xvalue end - ) catch $env)) as $fnEnv | + ) catch $env)) | # tell it about itself - env_multiset($fnEnv; $fn.names; $fn) as $fnEnv | + env_multiset($fn) | { - env: env_multiset($fnEnv; $fn.names; $fn), + env: ., expr: $fn.body } | . as $dot diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index a4419c6192..7b2559bc6f 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -111,10 +111,10 @@ def interpret(arguments; env; _eval): (.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 | + env_setfallback((.env | addFrees(env; $fn.free_referencess)); env) | childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( - $fnEnv; + .; . as $env | try env_set( .; $name; @@ -124,11 +124,11 @@ def interpret(arguments; env; _eval): else $xvalue end - ) catch $env)) as $fnEnv | + ) catch $env)) | # tell it about itself - env_multiset($fnEnv; $fn.names; $fn) as $fnEnv | + env_multiset($fn) | { - env: env_multiset($fnEnv; $fn.names; $fn), + env: ., expr: $fn.body } | . as $dot From cd48aab2e9c3bf67233cba2e3fec0cb117912a5b Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 30 Sep 2024 08:28:35 +0200 Subject: [PATCH 07/20] jq: use env_req for env searches that should not fail instead of abusing env_find --- impls/jq/env.jq | 26 ++++++++++---------------- impls/jq/interp.jq | 6 +++--- impls/jq/step3_env.jq | 2 +- impls/jq/step4_if_fn_do.jq | 10 +++++----- impls/jq/step5_tco.jq | 10 +++++----- impls/jq/step6_file.jq | 2 +- impls/jq/step7_quote.jq | 2 +- impls/jq/step8_macros.jq | 2 +- impls/jq/step9_try.jq | 2 +- impls/jq/stepA_mal.jq | 2 +- 10 files changed, 29 insertions(+), 35 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index bc3117c55d..a34bc5b66e 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -58,7 +58,7 @@ def env_set($key; $value): ($value | if $value.kind == "atom" then # check if the one we have is newer - env_req(env; key) as $ours | + ($key | env_req(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else @@ -129,21 +129,15 @@ def env_get(env): 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 +def env_req(env): + . as $key | + env_find(env).environment[$key] | + if . != null and .kind == "atom" then + ($key | env_find(env.parent).environment[$key]) as $possibly_newer | + if $possibly_newer.identity == .identity + and $possibly_newer.last_modified > .last_modified + then + $possibly_newer end end; diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq index b8ae3ac57d..6540f2b2ad 100644 --- a/impls/jq/interp.jq +++ b/impls/jq/interp.jq @@ -59,7 +59,7 @@ def addFrees(newEnv; frees): $env; . as $dot | extractEnv(newEnv) as $env - | env_req($env; $free) as $lookup + | ($free | env_req($env)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else @@ -159,7 +159,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) + # | _debug("FNEXEC " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.env) | pr_str)) | _eval | . as $envexp | (extractReplEnv($envexp.env)) as $xreplenv @@ -171,7 +171,7 @@ def interpret(arguments; env; _eval): | wrapEnv($xreplenv; $envexp.env.atoms) } # | . as $dot - # | _debug("FNPOST " + (.expr | pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) | pr_str)) + # | _debug("FNPOST " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.expr.env) | pr_str)) # | _debug("INTERP " + $src + " = " + (.expr|pr_str)) ) // jqmal_error("Unsupported function kind \(.kind)"); diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index 291a741fa0..2842712581 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -66,7 +66,7 @@ def interpret(arguments; env): jqmal_error("Unsupported native function kind \(.kind)"); def EVAL(env): - if "DEBUG-EVAL" | env_find(env).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req(env) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index eb435dba6a..beb8a236ba 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -15,7 +15,7 @@ def env_set(env; $key; $value): $value | (.names += [$key]) | (.names |= unique) | if $value.kind == "atom" then # check if the one we have is newer - env_req(env; $key) as $ours | + ($key | env_req(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else @@ -91,7 +91,7 @@ def addFrees(newEnv; frees): | reduce frees[] as $free ( $env; . as $dot - | env_req(newEnv; $free) as $lookup + | ($free | env_req(newEnv)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else @@ -132,7 +132,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) + # | debug("FNEXEC " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.env) | pr_str)) | _eval | . as $envexp | @@ -141,7 +141,7 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST " + (.expr | pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) | pr_str)) + # | debug("FNPOST " + (.expr | pr_str) + " " + (; $fn.binds[0] | env_req($dot.expr.env) | pr_str)) # | debug("INTERP " + $src + " = " + (.expr|pr_str)) ) // jqmal_error("Unsupported function kind \(.kind)"); @@ -151,7 +151,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); # EVAL starts here. - if "DEBUG-EVAL" | env_find(env).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req(env) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 7b2559bc6f..fa74a3d449 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -15,7 +15,7 @@ def env_set(env; $key; $value): $value | (.names += [$key]) | (.names |= unique) | if $value.kind == "atom" then # check if the one we have is newer - env_req(env; $key) as $ours | + ($key | env_req(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else @@ -91,7 +91,7 @@ def addFrees(newEnv; frees): | reduce frees[] as $free ( $env; . as $dot - | env_req(newEnv; $free) as $lookup + | ($free | env_req(newEnv)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else @@ -132,7 +132,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) + # | debug("FNEXEC " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.env) | pr_str)) | _eval | . as $envexp | @@ -141,7 +141,7 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST " + (.expr | pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) | pr_str)) + # | debug("FNPOST " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.expr.env) | pr_str)) # | debug("INTERP " + $src + " = " + (.expr|pr_str)) ) // jqmal_error("Unsupported function kind \(.kind)"); @@ -173,7 +173,7 @@ def EVAL(env): | .ret_env as $_orig_retenv | .ast | - if "DEBUG-EVAL" | env_find($_menv).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req($_menv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index 721ad7cc4e..bd2363ae07 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -39,7 +39,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index ca632d4ae8..eaf2cd14fa 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -74,7 +74,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 5e6d10111f..9555135da8 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -81,7 +81,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index a7f0472a9d..70a7e5656b 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -81,7 +81,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 35684f5288..20f21c2ff7 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -83,7 +83,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_find($currentEnv).environment["DEBUG-EVAL"] | + if "DEBUG-EVAL" | env_req($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . From 75cee4a83fd62bb6e4d2855eede78a7606e38f42 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 30 Sep 2024 11:26:08 +0200 Subject: [PATCH 08/20] jq: start to merge most env_get variants --- impls/jq/env.jq | 20 +++++--------------- impls/jq/interp.jq | 10 ++++++---- impls/jq/step3_env.jq | 19 ------------------- impls/jq/step4_if_fn_do.jq | 11 +++++++---- impls/jq/step5_tco.jq | 11 +++++++---- 5 files changed, 25 insertions(+), 46 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index a34bc5b66e..06eea51c5c 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -73,11 +73,9 @@ def env_set($key; $value): else $value - end) as $value | { - parent: .parent, - environment: (.environment + (.environment | .[$key] |= $value)), # merge together, as .environment[key] |= value does not work - fallback: .fallback - }; + end) as $value | + # merge together, as .environment[$key] |= value does not work + .environment += (.environment | .[$key] |= $value); def env_dump_keys: def _dump1: @@ -97,6 +95,7 @@ def env_dump_keys: end | unique end; +# It should be possible to merge env_get env_req env_find. def env_find(env): if env.environment[.] == null then if env.parent then @@ -126,10 +125,8 @@ def env_get(env): end end; -def env_get(env; key): - key | env_get(env); - def env_req(env): + # key -> value or null . as $key | env_find(env).environment[$key] | if . != null and .kind == "atom" then @@ -153,13 +150,6 @@ def env_set(env; $key; $value): fallback: env.fallback }; -def env_setfallback(env; fallback): - { - parent: env.parent, - fallback: fallback, - environment: env.environment - }; - def addEnv(env): { expr: ., diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq index 6540f2b2ad..b1dc9cf07e 100644 --- a/impls/jq/interp.jq +++ b/impls/jq/interp.jq @@ -137,7 +137,9 @@ def interpret(arguments; env; _eval): (.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) | + extractEnv(.env | addFrees(env; $fn.free_referencess)) | + .fallback |= extractEnv(env) | + childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( .; @@ -159,7 +161,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | _debug("FNEXEC " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.env) | pr_str)) + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_req($dot.env) | pr_str)") | _eval | . as $envexp | (extractReplEnv($envexp.env)) as $xreplenv @@ -171,8 +173,8 @@ def interpret(arguments; env; _eval): | wrapEnv($xreplenv; $envexp.env.atoms) } # | . as $dot - # | _debug("FNPOST " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.expr.env) | pr_str)) - # | _debug("INTERP " + $src + " = " + (.expr|pr_str)) + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_req($dot.expr.env) | pr_str)") + # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); \ No newline at end of file diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index 2842712581..2cfce102fd 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -14,31 +14,12 @@ def env_set(env; $key; $value): 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 arg_check(args): if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index beb8a236ba..e5285b2b9e 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -111,7 +111,10 @@ def interpret(arguments; env; _eval): (.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) | + .env | + addFrees(env; $fn.free_referencess) | + .fallback |= env | + childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( .; @@ -132,7 +135,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.env) | pr_str)) + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_req($dot.env) | pr_str)") | _eval | . as $envexp | @@ -141,8 +144,8 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST " + (.expr | pr_str) + " " + (; $fn.binds[0] | env_req($dot.expr.env) | pr_str)) - # | debug("INTERP " + $src + " = " + (.expr|pr_str)) + # | debug("FNPOST \(.expr | pr_str) \(; $fn.binds[0] | env_req($dot.expr.env) | pr_str)") + # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index fa74a3d449..54bbfc5cab 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -111,7 +111,10 @@ def interpret(arguments; env; _eval): (.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) | + .env | + addFrees(env; $fn.free_referencess) | + .fallback |= env | + childEnv($fn.binds; arguments) | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( .; @@ -132,7 +135,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.env) | pr_str)) + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_req($dot.env) | pr_str)") | _eval | . as $envexp | @@ -141,8 +144,8 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST " + (.expr | pr_str) + " " + ($fn.binds[0] | env_req($dot.expr.env) | pr_str)) - # | debug("INTERP " + $src + " = " + (.expr|pr_str)) + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_req($dot.expr.env) | pr_str)") + # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); From fff6e7a31f20a611cdb3975c4d675d2aeef55975 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 1 Oct 2024 10:34:25 +0200 Subject: [PATCH 09/20] jq: merge most env_get variants --- impls/jq/env.jq | 25 +++---------------------- impls/jq/interp.jq | 9 +++++---- impls/jq/step3_env.jq | 28 +++++++++++++--------------- impls/jq/step4_if_fn_do.jq | 16 +++++++++------- impls/jq/step5_tco.jq | 16 +++++++++------- impls/jq/step6_file.jq | 6 ++++-- impls/jq/step7_quote.jq | 6 ++++-- impls/jq/step8_macros.jq | 6 ++++-- impls/jq/step9_try.jq | 6 ++++-- impls/jq/stepA_mal.jq | 6 ++++-- 10 files changed, 59 insertions(+), 65 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index 06eea51c5c..a0b6652b30 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -58,7 +58,7 @@ def env_set($key; $value): ($value | if $value.kind == "atom" then # check if the one we have is newer - ($key | env_req(env)) as $ours | + ($key | env_get(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else @@ -95,7 +95,7 @@ def env_dump_keys: end | unique end; -# It should be possible to merge env_get env_req env_find. +# Helper for env_get. def env_find(env): if env.environment[.] == null then if env.parent then @@ -108,27 +108,8 @@ def env_find(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_req(env): # key -> value or null - . as $key | - env_find(env).environment[$key] | + . as $key | env_find(env).environment[$key] | if . != null and .kind == "atom" then ($key | env_find(env.parent).environment[$key]) as $possibly_newer | if $possibly_newer.identity == .identity diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq index b1dc9cf07e..1f3e6d5783 100644 --- a/impls/jq/interp.jq +++ b/impls/jq/interp.jq @@ -59,7 +59,7 @@ def addFrees(newEnv; frees): $env; . as $dot | extractEnv(newEnv) as $env - | ($free | env_req($env)) as $lookup + | ($free | env_get($env)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else @@ -146,7 +146,8 @@ def interpret(arguments; env; _eval): . as $env | try env_set_( .; $name; - $name | env_get(env) | . as $xvalue + $name | env_get(env) // jqmal_error("'\(.)' not found ") | + . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else @@ -161,7 +162,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_req($dot.env) | pr_str)") + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") | _eval | . as $envexp | (extractReplEnv($envexp.env)) as $xreplenv @@ -173,7 +174,7 @@ def interpret(arguments; env; _eval): | wrapEnv($xreplenv; $envexp.env.atoms) } # | . as $dot - # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_req($dot.expr.env) | pr_str)") + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index 2cfce102fd..7f3198fd88 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -47,28 +47,26 @@ def interpret(arguments; env): jqmal_error("Unsupported native function kind \(.kind)"); def EVAL(env): - if "DEBUG-EVAL" | env_req(env) | + if "DEBUG-EVAL" | env_get(env) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . end | (select(.kind == "list") | - .value | select(length != 0) as $value | - ( + .value | select(length != 0) | ( - select(.[0].value == "def!") as $value | - ($value[2] | EVAL(env)) as $evval | - addToEnv($evval; $value[1].value) + select(.[0].value == "def!") | + addToEnv(.[2] | EVAL(env); .[1].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 } + select(.[0].value == "let*") | + (reduce (.[1].value | nwise(2)) as $xvalue ( + env | pureChildEnv; + . as $env | $xvalue[1] | EVAL($env) | + env_set(.env; $xvalue[0].value; .expr) + )) as $env | + .[2] | {expr:EVAL($env).expr, env:env} ) // ( reduce .[] as $elem ( @@ -79,7 +77,6 @@ def EVAL(env): | $ev.expr | first | interpret($ev.expr[1:]; $ev.env) ) - ) ) // ( select(.kind == "vector") | @@ -103,7 +100,8 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get(env) | addEnv(env) + .value | env_get(env) // jqmal_error("'\(.)' not found ") | + addEnv(env) ) // addEnv(env); diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index e5285b2b9e..31a55f4982 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -15,7 +15,7 @@ def env_set(env; $key; $value): $value | (.names += [$key]) | (.names |= unique) | if $value.kind == "atom" then # check if the one we have is newer - ($key | env_req(env)) as $ours | + ($key | env_get(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else @@ -91,7 +91,7 @@ def addFrees(newEnv; frees): | reduce frees[] as $free ( $env; . as $dot - | ($free | env_req(newEnv)) as $lookup + | ($free | env_get(newEnv)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else @@ -121,7 +121,8 @@ def interpret(arguments; env; _eval): . as $env | try env_set( .; $name; - $name | env_get(env) | . as $xvalue + $name | env_get(env) // jqmal_error("'\(.)' not found") + | . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else @@ -135,7 +136,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_req($dot.env) | pr_str)") + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") | _eval | . as $envexp | @@ -144,7 +145,7 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST \(.expr | pr_str) \(; $fn.binds[0] | env_req($dot.expr.env) | pr_str)") + # | debug("FNPOST \(.expr | pr_str) \(; $fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); @@ -154,7 +155,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); # EVAL starts here. - if "DEBUG-EVAL" | env_req(env) | + if "DEBUG-EVAL" | env_get(env) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -241,7 +242,8 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get(env) | addEnv(env) + .value | env_get(env) // jqmal_error("'\(.)' not found") | + addEnv(env) ) // addEnv(env); diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 54bbfc5cab..0380e1e593 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -15,7 +15,7 @@ def env_set(env; $key; $value): $value | (.names += [$key]) | (.names |= unique) | if $value.kind == "atom" then # check if the one we have is newer - ($key | env_req(env)) as $ours | + ($key | env_get(env)) as $ours | if $ours.last_modified > $value.last_modified then $ours else @@ -91,7 +91,7 @@ def addFrees(newEnv; frees): | reduce frees[] as $free ( $env; . as $dot - | ($free | env_req(newEnv)) as $lookup + | ($free | env_get(newEnv)) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else @@ -121,7 +121,8 @@ def interpret(arguments; env; _eval): . as $env | try env_set( .; $name; - $name | env_get(env) | . as $xvalue + $name | env_get(env) // jqmal_error("'\(.)' not found") | + . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else @@ -135,7 +136,7 @@ def interpret(arguments; env; _eval): expr: $fn.body } | . as $dot - # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_req($dot.env) | pr_str)") + # | debug("FNEXEC \(.expr | pr_str) \($fn.binds[0] | env_get($dot.env) | pr_str)") | _eval | . as $envexp | @@ -144,7 +145,7 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_req($dot.expr.env) | pr_str)") + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); @@ -176,7 +177,7 @@ def EVAL(env): | .ret_env as $_orig_retenv | .ast | - if "DEBUG-EVAL" | env_req($_menv) | + if "DEBUG-EVAL" | env_get($_menv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -271,7 +272,8 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($_menv) | TCOWrap($_menv; $_orig_retenv; false) + .value | env_get($_menv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index bd2363ae07..b81ef57812 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -39,7 +39,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_req($currentEnv) | + if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -145,7 +145,9 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index eaf2cd14fa..c667259850 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -74,7 +74,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_req($currentEnv) | + if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -188,7 +188,9 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 9555135da8..5110af1c30 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -81,7 +81,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_req($currentEnv) | + if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -207,7 +207,9 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 70a7e5656b..63a0e6e75d 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -81,7 +81,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_req($currentEnv) | + if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -236,7 +236,9 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 20f21c2ff7..d6c9337a01 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -83,7 +83,7 @@ def EVAL(env): | $_menv | unwrapReplEnv as $replEnv # - | $init | - if "DEBUG-EVAL" | env_req($currentEnv) | + if "DEBUG-EVAL" | env_get($currentEnv) | . != null and .kind != "false" and .kind != "nil" then ("EVAL: \(pr_str(env))" | _display | empty), . @@ -242,7 +242,9 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get($currentEnv) | TCOWrap($_menv; $_orig_retenv; false) + .value | + env_get($currentEnv) // jqmal_error("'\(.)' not found") | + TCOWrap($_menv; $_orig_retenv; false) ) // TCOWrap($_menv; $_orig_retenv; false) end From 450a074cfec3cc019aa252ccba79fc5ee0278ccd Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 1 Oct 2024 19:30:58 +0200 Subject: [PATCH 10/20] jq: merge all addToEnv variants --- impls/jq/env.jq | 7 ------- impls/jq/step3_env.jq | 11 ++++------- impls/jq/step4_if_fn_do.jq | 31 ++++++++----------------------- impls/jq/step5_tco.jq | 32 ++++++++++---------------------- 4 files changed, 22 insertions(+), 59 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index a0b6652b30..b90b40b494 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -137,13 +137,6 @@ def addEnv(env): env: env }; -def addToEnv(env; name; expr): - { - expr: expr, - env: env_set(env; name; expr) - }; - - def wrapEnv(atoms): { replEnv: ., diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index 7f3198fd88..213c4cdc22 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -14,12 +14,6 @@ def env_set(env; $key; $value): environment: (env.environment + (env.environment | .[$key] |= $value)) # merge together, as .environment[key] |= value does not work }; -def addToEnv(envexp; name): - { - expr: envexp.expr, - env: env_set(envexp.env; name; envexp.expr) - }; - def arg_check(args): if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") @@ -57,7 +51,10 @@ def EVAL(env): .value | select(length != 0) | ( select(.[0].value == "def!") | - addToEnv(.[2] | EVAL(env); .[1].value) + .[1].value as $key | + .[2] | EVAL(env) | + .expr as $value | + .env |= env_set(.; $key; $value) ) // ( select(.[0].value == "let*") | diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index 31a55f4982..d4bc1b3b99 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -33,27 +33,6 @@ def env_set(env; $key; $value): fallback: env.fallback }; -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 { @@ -166,8 +145,14 @@ def EVAL(env): ( ( select(.[0].value == "def!") | - ($value[2] | EVAL(env)) as $evval | - addToEnv($evval; $value[1].value) + .[1].value as $key | + .[2] | EVAL(env) | + .expr as $value | + if .env.replEnv != null then + addToEnv(.; $key) + else + .env |= env_set_(.; $key; $value) + end ) // ( select(.[0].value == "let*") | diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 0380e1e593..0365fffd32 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -33,27 +33,6 @@ def env_set(env; $key; $value): fallback: env.fallback }; -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 { @@ -189,7 +168,16 @@ def EVAL(env): ( select(.[0].value == "def!") | ($value[2] | EVAL($_menv)) as $evval | - addToEnv($evval; $value[1].value) as $val | + ( + if $evval.env.replEnv != null then + addToEnv($evval; $value[1].value) + else + { + expr: $evval.expr, + env: env_set_($evval.env; $value[1].value; $evval.expr) + } + end + ) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( From 36c457ee3d0c05e59c66ec30b20a788593118f00 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 1 Oct 2024 21:40:41 +0200 Subject: [PATCH 11/20] jq: remove the addEnv function --- impls/jq/env.jq | 8 +------- impls/jq/interp.jq | 16 +++++++++------- impls/jq/step3_env.jq | 7 ++++--- impls/jq/step4_if_fn_do.jq | 11 ++++++----- impls/jq/step5_tco.jq | 10 ++++------ impls/jq/step6_file.jq | 8 +++----- impls/jq/step7_quote.jq | 8 +++----- impls/jq/step8_macros.jq | 8 +++----- impls/jq/step9_try.jq | 8 +++----- impls/jq/stepA_mal.jq | 8 +++----- 10 files changed, 39 insertions(+), 53 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index b90b40b494..7e806036b9 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -131,12 +131,6 @@ def env_set(env; $key; $value): fallback: env.fallback }; -def addEnv(env): - { - expr: ., - env: env - }; - def wrapEnv(atoms): { replEnv: ., @@ -210,4 +204,4 @@ def env_remove_references(refs): else _env_remove_references(refs) end - end; \ No newline at end of file + end; diff --git a/impls/jq/interp.jq b/impls/jq/interp.jq index 1f3e6d5783..275962b536 100644 --- a/impls/jq/interp.jq +++ b/impls/jq/interp.jq @@ -88,7 +88,8 @@ def interpret(arguments; env; _eval): # env modifying function arguments[0].identity as $id | ($envAtoms | setpath([$id]; arguments[1])) as $envAtoms | - arguments[1] | addEnv(env | setpath(["atoms"]; $envAtoms)) + arguments[1] | + {expr:., env: (env | setpath(["atoms"]; $envAtoms))} ) // (select(.function == "swap!") | # env modifying function @@ -98,15 +99,16 @@ def interpret(arguments; env; _eval): ([$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)) + $newEnvValue.expr | + {expr:., env:(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)) + $value | {expr:., env:(env | setpath(["atoms"]; $envAtoms))} ) // (select(.function == "deref") | - $envAtoms[arguments[0].identity] | addEnv(env) - ) // + $envAtoms[arguments[0].identity] | {expr:., env:env} + ) // (select(.function == "apply") | # (apply F ...T A) -> (F ...T ...A) arguments as $args @@ -128,9 +130,9 @@ def interpret(arguments; env; _eval): env: (.env | setpath(["atoms"]; $val.env.atoms)) } )) as $ex - | $ex.val | wrap("list") | addEnv($ex.env) + | $ex.val | wrap("list") | {expr:., env:$ex.env} ) // - (core_interp(arguments; env) | addEnv(env)) + (core_interp(arguments; env) | {expr:., env:env}) ) // (select(.kind == "function") as $fn | # todo: arg_check diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index 213c4cdc22..ef925b8728 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -37,7 +37,8 @@ def interpret(arguments; env): select(.function == "number_div") | arguments | map(.value) | .[0] / .[1] | wrap("number") ) - ) | addEnv(env) // + | {expr:., env:env} + ) // jqmal_error("Unsupported native function kind \(.kind)"); def EVAL(env): @@ -98,9 +99,9 @@ def EVAL(env): ( select(.kind == "symbol") | .value | env_get(env) // jqmal_error("'\(.)' not found ") | - addEnv(env) + {expr:., env:env} ) // - addEnv(env); + {expr:., env:env}; def PRINT: pr_str; diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index d4bc1b3b99..fa12599b7e 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -83,7 +83,7 @@ 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)) + (core_interp(arguments; env) | {expr:., env:env}) ) // (select(.kind == "function") as $fn | # todo: arg_check @@ -192,7 +192,7 @@ def EVAL(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) + } | {expr: ., env:env} ) // ( reduce .[] as $elem ( @@ -227,10 +227,11 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get(env) // jqmal_error("'\(.)' not found") | - addEnv(env) + .value | + env_get(env) // jqmal_error("'\(.)' not found") | + {expr:., env:env} ) // - addEnv(env); + {expr:., env:env}; def PRINT: pr_str; diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 0365fffd32..71e458c1a4 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -83,7 +83,7 @@ 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)) + core_interp(arguments; env) | {expr:., env:env} ) // (select(.kind == "function") as $fn | # todo: arg_check @@ -265,11 +265,9 @@ def EVAL(env): ) // TCOWrap($_menv; $_orig_retenv; false) end - ) ] - | last as $result - | ($result.ret_env // $result.env) as $env - | $result.ast - | addEnv($env); + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; def PRINT: pr_str; diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index b81ef57812..b6eb13b97a 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -151,11 +151,9 @@ def EVAL(env): ) // TCOWrap($_menv; $_orig_retenv; false) end - ) ] - | last as $result - | ($result.ret_env // $result.env) as $env - | $result.ast - | addEnv($env); + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index c667259850..bc359373a5 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -194,11 +194,9 @@ def EVAL(env): ) // TCOWrap($_menv; $_orig_retenv; false) end - ) ] - | last as $result - | ($result.ret_env // $result.env) as $env - | $result.ast - | addEnv($env); + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 5110af1c30..65612c8aee 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -213,11 +213,9 @@ def EVAL(env): ) // TCOWrap($_menv; $_orig_retenv; false) end - ) ] - | last as $result - | ($result.ret_env // $result.env) as $env - | $result.ast - | addEnv($env); + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 63a0e6e75d..cd3437c0b3 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -242,11 +242,9 @@ def EVAL(env): ) // TCOWrap($_menv; $_orig_retenv; false) end - ) ] - | last as $result - | ($result.ret_env // $result.env) as $env - | $result.ast - | addEnv($env); + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index d6c9337a01..efc822b594 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -249,11 +249,9 @@ def EVAL(env): 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); + ) ] | + last | + {expr: .ast, env:(.ret_env // .env)}; def PRINT(env): pr_str(env); From 6b5bb92131fd8ba9503cacfeba8e6c0b3ba93064 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 14:48:01 +0200 Subject: [PATCH 12/20] jq: inline pureChildEnv for readability --- impls/jq/env.jq | 7 ------- impls/jq/step3_env.jq | 4 +++- impls/jq/step4_if_fn_do.jq | 5 +++-- impls/jq/step5_tco.jq | 5 +++-- impls/jq/step6_file.jq | 6 ++++-- impls/jq/step7_quote.jq | 6 ++++-- impls/jq/step8_macros.jq | 6 ++++-- impls/jq/step9_try.jq | 6 ++++-- impls/jq/stepA_mal.jq | 6 ++++-- 9 files changed, 29 insertions(+), 22 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index 7e806036b9..8585ea72c7 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -42,13 +42,6 @@ def childEnv(binds; exprs): ) | .value | map({(.[0]): .[1]}) | add }; -def pureChildEnv: - { - parent: ., - environment: {}, - fallback: null - }; - def env_multiset(fn): .environment += (reduce fn.names[] as $key(.environment; .[$key] |= fn)); diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index ef925b8728..deaf3b0d93 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -60,7 +60,9 @@ def EVAL(env): ( select(.[0].value == "let*") | (reduce (.[1].value | nwise(2)) as $xvalue ( - env | pureChildEnv; + # Initial accumulator + {parent: env, environment:{}, fallback:null}; + # Loop body . as $env | $xvalue[1] | EVAL($env) | env_set(.env; $xvalue[0].value; .expr) )) as $env | diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index fa12599b7e..37bb887045 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -156,9 +156,10 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - (env | pureChildEnv) as $subenv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $subenv; + # Initial accumulator + {parent:env, environment:{}, fallback:null}; + # Loop body . 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 } diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 71e458c1a4..3a62d76c0e 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -182,9 +182,10 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - ($_menv | pureChildEnv) as $subenv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $subenv; + # Initial accumulator + {parent:$_menv, environment:{}, fallback:null}; + # Loop body . 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) diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index b6eb13b97a..8c918b8c03 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -56,9 +56,11 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $_menv; + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body . 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) diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index bc359373a5..36235aab15 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -91,9 +91,11 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $_menv; + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body . 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) diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 65612c8aee..e709c6037f 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -104,9 +104,11 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $_menv; + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body . 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) diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index cd3437c0b3..1349c5be62 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -104,9 +104,11 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $_menv; + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body . 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) diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index efc822b594..a8823e9f4c 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -110,9 +110,11 @@ def EVAL(env): ) // ( select(.[0].value == "let*") | - ($currentEnv | pureChildEnv | wrapEnv($replEnv; $_menv.atoms)) as $_menv | (reduce ($value[1].value | nwise(2)) as $xvalue ( - $_menv; + # Initial accumulator + {parent:$currentEnv, environment:{}, fallback:null} | + wrapEnv($replEnv; $_menv.atoms); + # Loop body . 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) From b6387d3f09ee6fb3ba95117c97ba469898428cc2 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 15:14:28 +0200 Subject: [PATCH 13/20] jq: inline env_step6 The procedure is short and its name not explicit. --- impls/jq/env.jq | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index 8585ea72c7..60a3705241 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -146,16 +146,14 @@ def unwrapReplEnv: 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) + # Moving the common env_set before the if breaks something. ? + 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 else env_set(env; key; value) end; From 7bbd3deda7625a084f4767d8e6826d871ec9845b Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 15:49:47 +0200 Subject: [PATCH 14/20] jq: remove obsolete fallback clause probably once useful for empty lists --- impls/jq/step5_tco.jq | 3 +-- impls/jq/step6_file.jq | 3 +-- impls/jq/step7_quote.jq | 3 +-- impls/jq/step8_macros.jq | 3 +-- impls/jq/step9_try.jq | 3 +-- impls/jq/stepA_mal.jq | 3 +-- 6 files changed, 6 insertions(+), 12 deletions(-) diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 3a62d76c0e..92e9c8eee5 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -227,8 +227,7 @@ def EVAL(env): ) | . as $expr | first | interpret($expr[1:]; $_menv; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) - ) // - TCOWrap($_menv; $_orig_retenv; false) + ) ) ) // ( diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index 8c918b8c03..fe5c12eae8 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -113,8 +113,7 @@ def EVAL(env): $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) - ) // - TCOWrap($_menv; $_orig_retenv; false) + ) ) ) // ( diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index 36235aab15..8b0c59ec4e 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -156,8 +156,7 @@ def EVAL(env): $fn | interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) - ) // - TCOWrap($_menv; $_orig_retenv; false) + ) ) ) // ( diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index e709c6037f..851f72ed92 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -175,8 +175,7 @@ def EVAL(env): interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end - ) // - TCOWrap($_menv; $_orig_retenv; false) + ) ) ) // ( diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 1349c5be62..8036631f2c 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -204,8 +204,7 @@ def EVAL(env): interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end - ) // - TCOWrap($_menv; $_orig_retenv; false) + ) ) ) // ( diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index a8823e9f4c..0e6926d4bb 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -210,8 +210,7 @@ def EVAL(env): interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end - ) // - TCOWrap($_menv; $_orig_retenv; false) + ) ) ) // ( From 6c244348ee408033e3bbec407dd073fda7dfbaeb Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 19:12:00 +0200 Subject: [PATCH 15/20] jq: improve readability of addToEnv --- impls/jq/env.jq | 22 ++++++++++------------ impls/jq/stepA_mal.jq | 9 +++++---- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/impls/jq/env.jq b/impls/jq/env.jq index 60a3705241..e0b77c4b30 100644 --- a/impls/jq/env.jq +++ b/impls/jq/env.jq @@ -158,18 +158,16 @@ def env_set_(env; key; value): 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 addToEnv(name): + # { expr, env } -> { same expr, new env } + .expr as $value | + .env |= ( + . as $rawEnv | + if .isReplEnv then + env_set_(.currentEnv; name; $value) | wrapEnv($rawEnv.atoms) + else + env_set_(.currentEnv; name; $value) | wrapEnv($rawEnv.replEnv; $rawEnv.atoms) + end); def _env_remove_references(refs): if . != null then diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 0e6926d4bb..dbe9232246 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -98,14 +98,15 @@ def EVAL(env): ) // ( select(.[0].value == "def!") | - ($value[2] | EVAL($_menv)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "defmacro!") | - ($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + .expr |= set_macro_function | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( From fc1502cb66afafd9a1799d221917b42a2f567ae0 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 20:00:22 +0200 Subject: [PATCH 16/20] jq: simplify try* --- impls/jq/stepA_mal.jq | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index dbe9232246..e833a1bcb5 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -129,11 +129,12 @@ def EVAL(env): ) // ( select(.[0].value == "try*") | + if $value[2] + and ($value[2].value[0] | .kind == "symbol" and .value == "catch*") + then 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] | .kind == "symbol" and .value == "catch*") then (if ($exc | is_jqmal_error) then $exc[19:] as $ex | try ( @@ -148,13 +149,11 @@ def EVAL(env): 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 ) + else + $value[1] | EVAL($_menv) as $exp | + $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) + end ) // ( select(.[0].value == "if") | From db187e0bce79c84404284f5f9bcb63bff24828af Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 20:03:31 +0200 Subject: [PATCH 17/20] jq: implement TCO for do --- impls/jq/stepA_mal.jq | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index e833a1bcb5..4e8d0a09fb 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -122,10 +122,11 @@ def EVAL(env): ) // ( select(.[0].value == "do") | - (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) + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "try*") | From d0545f10b83b1a58c49d89ed45ea5c6cf318b34c Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 20:05:27 +0200 Subject: [PATCH 18/20] jq: remove uneeded parenthesis --- impls/jq/stepA_mal.jq | 2 -- 1 file changed, 2 deletions(-) diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 4e8d0a09fb..d9e61a1894 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -91,7 +91,6 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "atoms??") | $_menv.atoms | keys | map(wrap("string")) | wrap("list") | TCOWrap($_menv; $_orig_retenv; false) @@ -212,7 +211,6 @@ def EVAL(env): $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end ) - ) ) // ( select(.kind == "vector") | From de1a79a25469cee20625a1516721f1d08862b9ed Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 20:06:42 +0200 Subject: [PATCH 19/20] jq: wrap one more construction with TCOWrap --- impls/jq/stepA_mal.jq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index d9e61a1894..59bcfb7841 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -67,7 +67,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); . as $ast - | { env: env, ast: ., cont: true, finish: false, ret_env: null } + | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | (if $DEBUG then debug("EVAL: \($ast | pr_str($_menv))") else . end) From f325441244032fecfadce058d4af75a70b932117 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 5 Oct 2024 20:37:03 +0200 Subject: [PATCH 20/20] jq: backport last changes from stepA to step 3-9 --- impls/jq/step3_env.jq | 11 +++-------- impls/jq/step4_if_fn_do.jq | 16 +++++++--------- impls/jq/step5_tco.jq | 25 +++++++++++-------------- impls/jq/step6_file.jq | 17 ++++++++--------- impls/jq/step7_quote.jq | 17 ++++++++--------- impls/jq/step8_macros.jq | 22 +++++++++++----------- impls/jq/step9_try.jq | 37 ++++++++++++++++++------------------- 7 files changed, 66 insertions(+), 79 deletions(-) diff --git a/impls/jq/step3_env.jq b/impls/jq/step3_env.jq index deaf3b0d93..8e074ba441 100644 --- a/impls/jq/step3_env.jq +++ b/impls/jq/step3_env.jq @@ -61,7 +61,7 @@ def EVAL(env): select(.[0].value == "let*") | (reduce (.[1].value | nwise(2)) as $xvalue ( # Initial accumulator - {parent: env, environment:{}, fallback:null}; + {parent:env, environment:{}, fallback:null}; # Loop body . as $env | $xvalue[1] | EVAL($env) | env_set(.env; $xvalue[0].value; .expr) @@ -100,7 +100,8 @@ def EVAL(env): ) // ( select(.kind == "symbol") | - .value | env_get(env) // jqmal_error("'\(.)' not found ") | + .value | + env_get(env) // jqmal_error("'\(.)' not found") | {expr:., env:env} ) // {expr:., env:env}; @@ -108,12 +109,6 @@ def EVAL(env): def PRINT: pr_str; -def childEnv(binds; value): - { - parent: ., - environment: [binds, value] | transpose | map({(.[0]): .[1]}) | from_entries - }; - def repl: # Infinite generator, interrupted by an exception or ./run. . as $env | "user> " | __readline | diff --git a/impls/jq/step4_if_fn_do.jq b/impls/jq/step4_if_fn_do.jq index 37bb887045..a05612b902 100644 --- a/impls/jq/step4_if_fn_do.jq +++ b/impls/jq/step4_if_fn_do.jq @@ -83,7 +83,7 @@ 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) | {expr:., env:env}) + core_interp(arguments; env) | {expr:., env:env} ) // (select(.kind == "function") as $fn | # todo: arg_check @@ -100,8 +100,8 @@ def interpret(arguments; env; _eval): . as $env | try env_set( .; $name; - $name | env_get(env) // jqmal_error("'\(.)' not found") - | . as $xvalue + $name | env_get(env) // jqmal_error("'\(.)' not found") | + . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else @@ -124,7 +124,7 @@ def interpret(arguments; env; _eval): env: env } # | . as $dot - # | debug("FNPOST \(.expr | pr_str) \(; $fn.binds[0] | env_get($dot.expr.env) | pr_str)") + # | debug("FNPOST \(.expr | pr_str) \($fn.binds[0] | env_get($dot.expr.env) | pr_str)") # | debug("INTERP \($src) = \(.expr | pr_str)") ) // jqmal_error("Unsupported function kind \(.kind)"); @@ -142,16 +142,15 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "def!") | .[1].value as $key | .[2] | EVAL(env) | - .expr as $value | if .env.replEnv != null then - addToEnv(.; $key) + addToEnv($key) else - .env |= env_set_(.; $key; $value) + .expr as $def_value | + .env |= env_set_(.; $key; $def_value) end ) // ( @@ -204,7 +203,6 @@ def EVAL(env): | $ev.expr | first | interpret($ev.expr[1:]; $ev.env; _eval_here) ) - ) ) // ( select(.kind == "vector") | diff --git a/impls/jq/step5_tco.jq b/impls/jq/step5_tco.jq index 92e9c8eee5..fdb22127c0 100644 --- a/impls/jq/step5_tco.jq +++ b/impls/jq/step5_tco.jq @@ -146,7 +146,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); . as $ast - | { env: env, ast: ., cont: true, finish: false, ret_env: null } + | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then @@ -164,18 +164,15 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "def!") | - ($value[2] | EVAL($_menv)) as $evval | + $value[2] | EVAL($_menv) | ( - if $evval.env.replEnv != null then - addToEnv($evval; $value[1].value) + if .env.replEnv != null then + addToEnv($value[1].value) else - { - expr: $evval.expr, - env: env_set_($evval.env; $value[1].value; $evval.expr) - } + .expr as $def_value | + .env |= env_set_(.; $value[1].value; $def_value) end ) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) @@ -192,10 +189,11 @@ def EVAL(env): ) // ( select(.[0].value == "do") | - (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) + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | @@ -228,7 +226,6 @@ def EVAL(env): interpret($expr[1:]; $_menv; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) ) - ) ) // ( select(.kind == "vector") | diff --git a/impls/jq/step6_file.jq b/impls/jq/step6_file.jq index fe5c12eae8..8d2ed95627 100644 --- a/impls/jq/step6_file.jq +++ b/impls/jq/step6_file.jq @@ -25,7 +25,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); . as $ast - | { env: env, ast: ., cont: true, finish: false, ret_env: null } + | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then @@ -47,11 +47,10 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "def!") | - ($value[2] | EVAL($_menv)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( @@ -67,10 +66,11 @@ def EVAL(env): ) // ( select(.[0].value == "do") | - (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) + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | @@ -114,7 +114,6 @@ def EVAL(env): interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) ) - ) ) // ( select(.kind == "vector") | diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index 8b0c59ec4e..5bd7b188db 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -60,7 +60,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); . as $ast - | { env: env, ast: ., cont: true, finish: false, ret_env: null } + | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then @@ -82,11 +82,10 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "def!") | - ($value[2] | EVAL($_menv)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( @@ -102,10 +101,11 @@ def EVAL(env): ) // ( select(.[0].value == "do") | - (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) + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | @@ -157,7 +157,6 @@ def EVAL(env): interpret($expr.val; $expr.env; _eval_here) as $exprenv | $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) ) - ) ) // ( select(.kind == "vector") | diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 851f72ed92..f57834d34c 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -67,7 +67,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); . as $ast - | { env: env, ast: ., cont: true, finish: false, ret_env: null } + | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then @@ -89,17 +89,17 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "def!") | - ($value[2] | EVAL($_menv)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "defmacro!") | - ($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + .expr |= set_macro_function | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( @@ -115,10 +115,11 @@ def EVAL(env): ) // ( select(.[0].value == "do") | - (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) + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "if") | @@ -176,7 +177,6 @@ def EVAL(env): $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end ) - ) ) // ( select(.kind == "vector") | diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index 8036631f2c..d2d79543db 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -67,7 +67,7 @@ def EVAL(env): .env as $env | .expr | EVAL($env); . as $ast - | { env: env, ast: ., cont: true, finish: false, ret_env: null } + | TCOWrap(env; null; true) | [ recurseflip(.cont; .env as $_menv | if .finish then @@ -89,17 +89,17 @@ def EVAL(env): | (select(.kind == "list") | .value | select(length != 0) as $value | - ( ( select(.[0].value == "def!") | - ($value[2] | EVAL($_menv)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( select(.[0].value == "defmacro!") | - ($value[2] | EVAL($_menv) | (.expr |= set_macro_function)) as $evval | - addToEnv($evval; $value[1].value) as $val | + $value[2] | EVAL($_menv) | + .expr |= set_macro_function | + addToEnv($value[1].value) as $val | $val.expr | TCOWrap($val.env; $_orig_retenv; false) ) // ( @@ -115,18 +115,20 @@ def EVAL(env): ) // ( select(.[0].value == "do") | - (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) + (reduce $value[1:-1][] as $xvalue ( + $_menv; + . as $env | $xvalue | EVAL($env) | .env + )) as $env | + $value[-1] | TCOWrap($env; $_orig_retenv; true) ) // ( select(.[0].value == "try*") | + if $value[2] + and ($value[2].value[0] | .kind == "symbol" and .value == "catch*") + then 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] | .kind == "symbol" and .value == "catch*") then (if ($exc | is_jqmal_error) then $exc[19:] as $ex | try ( @@ -141,13 +143,11 @@ def EVAL(env): 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 ) + else + $value[1] | EVAL($_menv) as $exp | + $exp.expr | TCOWrap($exp.env; $_orig_retenv; false) + end ) // ( select(.[0].value == "if") | @@ -205,7 +205,6 @@ def EVAL(env): $exprenv.expr | TCOWrap($exprenv.env; $_orig_retenv; false) end ) - ) ) // ( select(.kind == "vector") |