From 026270413e7f09fb95c62a2d6fe34879482ebd57 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 29 Sep 2024 16:53:23 +0200 Subject: [PATCH] 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;