include "utils"; include "core"; include "env"; include "printer"; def arg_check(args): if .inputs < 0 then if (abs(.inputs) - 1) > (args | length) then jqmal_error("Invalid number of arguments (expected at least \(abs(.inputs) - 1), got \(args|length))") else . end else if .inputs != (args|length) then jqmal_error("Invalid number of arguments (expected \(.inputs), got \(args|length))") else . end end; def extractReplEnv(env): env | .replEnv // .; def extractEnv(env): env | .currentEnv // .; def updateReplEnv(renv): def findpath: if .env.parent then .path += ["parent"] | .env |= .parent | findpath else .path end; ({ env: ., path: [] } | findpath) as $path | setpath($path; renv); def extractCurrentReplEnv(env): def findpath: if .env.parent then .path += ["parent"] | .env |= .parent | findpath else .path end; if env.currentEnv != null then ({ env: env.currentEnv, path: [] } | findpath) as $path | env.currentEnv | getpath($path) else env end; def extractAtoms(env): env.atoms // {}; def addFrees(newEnv; frees): . as $env | reduce frees[] as $free ( $env; . as $dot | extractEnv(newEnv) as $env | env_req($env; $free) as $lookup | if $lookup != null then env_set_(.; $free; $lookup) else . end) | . as $env | $env; def interpret(arguments; env; _eval): extractReplEnv(env) as $replEnv | extractAtoms(env) as $envAtoms | (if $DEBUG then _debug("INTERP: \(. | pr_str(env))") else . end) | (select(.kind == "fn") | arg_check(arguments) | (select(.function == "eval") | # special function { expr: arguments[0], env: $replEnv|wrapEnv($replEnv; $envAtoms) } | _eval | .env as $xenv | extractReplEnv($xenv) as $xreplenv | setpath( ["env", "currentEnv"]; extractEnv(env) | updateReplEnv($xreplenv)) ) // (select(.function == "reset!") | # env modifying function arguments[0].identity as $id | ($envAtoms | setpath([$id]; arguments[1])) as $envAtoms | arguments[1] | addEnv(env | setpath(["atoms"]; $envAtoms)) ) // (select(.function == "swap!") | # env modifying function arguments[0].identity as $id | $envAtoms[$id] as $initValue | arguments[1] as $function | ([$initValue] + arguments[2:]) as $args | ($function | interpret($args; env; _eval)) as $newEnvValue | ($envAtoms | setpath([$id]; $newEnvValue.expr)) as $envAtoms | $newEnvValue.expr | addEnv(env | setpath(["atoms"]; $envAtoms)) ) // (select(.function == "atom") | (now|tostring) as $id | {kind: "atom", identity: $id} as $value | ($envAtoms | setpath([$id]; arguments[0])) as $envAtoms | $value | addEnv(env | setpath(["atoms"]; $envAtoms)) ) // (select(.function == "deref") | $envAtoms[arguments[0].identity] | addEnv(env) ) // (select(.function == "apply") | # (apply F ...T A) -> (F ...T ...A) arguments as $args | ($args|first) as $F | ($args|last.value) as $A | $args[1:-1] as $T | $F | interpret([$T[], $A[]]; env; _eval) ) // (select(.function == "map") | arguments | first as $F | last.value as $L | (reduce $L[] as $elem ( {env: env, val: []}; . as $dot | ($F | interpret([$elem]; $dot.env; _eval)) as $val | { val: (.val + [$val.expr]), env: (.env | setpath(["atoms"]; $val.env.atoms)) } )) as $ex | $ex.val | wrap("list") | addEnv($ex.env) ) // (core_interp(arguments; env) | addEnv(env)) ) // (select(.kind == "function") as $fn | # todo: arg_check (.body | pr_str(env)) as $src | # _debug("INTERP " + $src) | # _debug("FREES " + ($fn.free_referencess | tostring)) | env_setfallback(extractEnv(.env | addFrees(env; $fn.free_referencess)); extractEnv(env)) | childEnv($fn.binds; arguments) as $fnEnv | # tell it about its surroundings (reduce $fn.free_referencess[] as $name ( $fnEnv; . as $env | try env_set_( .; $name; $name | env_get(env) | . as $xvalue | if $xvalue.kind == "function" then setpath(["free_referencess"]; $fn.free_referencess) else $xvalue end ) catch $env)) as $fnEnv | # tell it about itself env_multiset($fnEnv; $fn.names; $fn) as $fnEnv | { env: env_multiset($fnEnv; $fn.names; $fn) | wrapEnv($replEnv; $envAtoms), expr: $fn.body } | . as $dot # | _debug("FNEXEC " + (.expr | pr_str) + " " + (env_req($dot.env; $fn.binds[0]) | pr_str)) | _eval | . as $envexp | (extractReplEnv($envexp.env)) as $xreplenv | { expr: .expr, env: extractEnv(env) | updateReplEnv($xreplenv) | wrapEnv($xreplenv; $envexp.env.atoms) } # | . as $dot # | _debug("FNPOST " + (.expr | pr_str) + " " + (env_req($dot.expr.env; $fn.binds[0]) | pr_str)) # | _debug("INTERP " + $src + " = " + (.expr|pr_str)) ) // jqmal_error("Unsupported function kind \(.kind)");