From e47522209912a80f9bd5c71ff5a99a5c31daf040 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 15 Mar 2026 13:43:48 +0000 Subject: [PATCH] Merge eval.sx + frames.sx + cek.sx into single evaluator.sx MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The core spec is now one file: spec/evaluator.sx (2275 lines). Three parts: Part 1: CEK frames — state and continuation frame constructors Part 2: Evaluation utilities — call, parse, define, macro, strict Part 3: CEK machine — the sole evaluator Deleted: - spec/eval.sx (merged into evaluator.sx) - spec/frames.sx (merged into evaluator.sx) - spec/cek.sx (merged into evaluator.sx) - spec/continuations.sx (dead — CEK handles shift/reset natively) Updated bootstrappers (JS + Python) to load evaluator.sx as core. Removed frames/cek from SPEC_MODULES (now part of core). Bundle size: 392KB → 377KB standard, 418KB → 403KB full. All tests unchanged: JS 747/747, Full 864/870, Python 679/679. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/javascript/bootstrap.py | 14 +- hosts/javascript/platform.py | 6 +- hosts/python/bootstrap.py | 9 +- hosts/python/platform.py | 6 +- shared/static/scripts/sx-browser.js | 1580 +++++++++++++-------------- spec/continuations.sx | 248 ----- spec/eval.sx | 846 -------------- spec/{cek.sx => evaluator.sx} | 1101 ++++++++++++++++++- spec/frames.sx | 262 ----- 9 files changed, 1894 insertions(+), 2178 deletions(-) delete mode 100644 spec/continuations.sx delete mode 100644 spec/eval.sx rename spec/{cek.sx => evaluator.sx} (53%) delete mode 100644 spec/frames.sx diff --git a/hosts/javascript/bootstrap.py b/hosts/javascript/bootstrap.py index 395727c..8bf4b7c 100644 --- a/hosts/javascript/bootstrap.py +++ b/hosts/javascript/bootstrap.py @@ -112,16 +112,11 @@ def compile_ref_to_js( spec_mod_set.add("deps") if "page-helpers" in SPEC_MODULES: spec_mod_set.add("page-helpers") - # CEK is the canonical evaluator — always included - spec_mod_set.add("cek") - spec_mod_set.add("frames") - # cek module requires frames - if "cek" in spec_mod_set: - spec_mod_set.add("frames") + # CEK is always included (part of evaluator.sx core file) + has_cek = True has_deps = "deps" in spec_mod_set has_router = "router" in spec_mod_set has_page_helpers = "page-helpers" in spec_mod_set - has_cek = "cek" in spec_mod_set # Resolve extensions ext_set = set() @@ -132,9 +127,10 @@ def compile_ref_to_js( ext_set.add(e) has_continuations = "continuations" in ext_set - # Build file list: core + adapters + spec modules + # Build file list: core evaluator + adapters + spec modules + # evaluator.sx = merged frames + eval utilities + CEK machine sx_files = [ - ("eval.sx", "eval"), + ("evaluator.sx", "evaluator (frames + eval + CEK)"), ("render.sx", "render (core)"), ] for name in ("parser", "html", "sx", "dom", "engine", "orchestration", "boot"): diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index 5bc516d..c87cfab 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -46,14 +46,12 @@ SPEC_MODULES = { "router": ("router.sx", "router (client-side route matching)"), "signals": ("signals.sx", "signals (reactive signal runtime)"), "page-helpers": ("page-helpers.sx", "page-helpers (pure data transformation helpers)"), - "frames": ("frames.sx", "frames (CEK continuation frames)"), - "cek": ("cek.sx", "cek (explicit CEK machine evaluator)"), "types": ("types.sx", "types (gradual type system)"), } +# Note: frames and cek are now part of evaluator.sx (always loaded as core) # Explicit ordering for spec modules with dependencies. -# Modules listed here are emitted in this order; any not listed use alphabetical. -SPEC_MODULE_ORDER = ["deps", "frames", "page-helpers", "router", "cek", "signals", "types"] +SPEC_MODULE_ORDER = ["deps", "page-helpers", "router", "signals", "types"] EXTENSION_NAMES = {"continuations"} diff --git a/hosts/python/bootstrap.py b/hosts/python/bootstrap.py index 74b7a63..0b9798a 100644 --- a/hosts/python/bootstrap.py +++ b/hosts/python/bootstrap.py @@ -1484,15 +1484,14 @@ def compile_ref_to_py( spec_mod_set.add("page-helpers") if "router" in SPEC_MODULES: spec_mod_set.add("router") - # CEK is the canonical evaluator — always include - spec_mod_set.add("cek") - spec_mod_set.add("frames") + # CEK is always included (part of evaluator.sx core file) + has_cek = True has_deps = "deps" in spec_mod_set - has_cek = "cek" in spec_mod_set # Core files always included, then selected adapters, then spec modules + # evaluator.sx = merged frames + eval utilities + CEK machine sx_files = [ - ("eval.sx", "eval"), + ("evaluator.sx", "evaluator (frames + eval + CEK)"), ("forms.sx", "forms (server definition forms)"), ("render.sx", "render (core)"), ] diff --git a/hosts/python/platform.py b/hosts/python/platform.py index fc31735..460b531 100644 --- a/hosts/python/platform.py +++ b/hosts/python/platform.py @@ -1636,14 +1636,12 @@ SPEC_MODULES = { "signals": ("signals.sx", "signals (reactive signal runtime)"), "page-helpers": ("page-helpers.sx", "page-helpers (pure data transformation helpers)"), "types": ("types.sx", "types (gradual type system)"), - "frames": ("frames.sx", "frames (CEK continuation frames)"), - "cek": ("cek.sx", "cek (explicit CEK machine evaluator)"), } +# Note: frames and cek are now part of evaluator.sx (always loaded as core) # Explicit ordering for spec modules with dependencies. -# Modules listed here are emitted in this order; any not listed use alphabetical. SPEC_MODULE_ORDER = [ - "deps", "engine", "frames", "page-helpers", "router", "cek", "signals", "types", + "deps", "engine", "page-helpers", "router", "signals", "types", ] EXTENSION_NAMES = {"continuations"} diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 2981b17..1d952ba 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -14,7 +14,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-03-15T13:27:20Z"; + var SX_VERSION = "2026-03-15T13:41:19Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -803,7 +803,185 @@ } - // === Transpiled from eval === + // === Transpiled from evaluator (frames + eval + CEK) === + + // make-cek-state + var makeCekState = function(control, env, kont) { return {"control": control, "env": env, "kont": kont, "phase": "eval", "value": NIL}; }; +PRIMITIVES["make-cek-state"] = makeCekState; + + // make-cek-value + var makeCekValue = function(value, env, kont) { return {"control": NIL, "env": env, "kont": kont, "phase": "continue", "value": value}; }; +PRIMITIVES["make-cek-value"] = makeCekValue; + + // cek-terminal? + var cekTerminal_p = function(state) { return (isSxTruthy((get(state, "phase") == "continue")) && isEmpty(get(state, "kont"))); }; +PRIMITIVES["cek-terminal?"] = cekTerminal_p; + + // cek-control + var cekControl = function(s) { return get(s, "control"); }; +PRIMITIVES["cek-control"] = cekControl; + + // cek-env + var cekEnv = function(s) { return get(s, "env"); }; +PRIMITIVES["cek-env"] = cekEnv; + + // cek-kont + var cekKont = function(s) { return get(s, "kont"); }; +PRIMITIVES["cek-kont"] = cekKont; + + // cek-phase + var cekPhase = function(s) { return get(s, "phase"); }; +PRIMITIVES["cek-phase"] = cekPhase; + + // cek-value + var cekValue = function(s) { return get(s, "value"); }; +PRIMITIVES["cek-value"] = cekValue; + + // make-if-frame + var makeIfFrame = function(thenExpr, elseExpr, env) { return {"type": "if", "then": thenExpr, "else": elseExpr, "env": env}; }; +PRIMITIVES["make-if-frame"] = makeIfFrame; + + // make-when-frame + var makeWhenFrame = function(bodyExprs, env) { return {"type": "when", "body": bodyExprs, "env": env}; }; +PRIMITIVES["make-when-frame"] = makeWhenFrame; + + // make-begin-frame + var makeBeginFrame = function(remaining, env) { return {"type": "begin", "remaining": remaining, "env": env}; }; +PRIMITIVES["make-begin-frame"] = makeBeginFrame; + + // make-let-frame + var makeLetFrame = function(name, remaining, body, local) { return {"type": "let", "name": name, "remaining": remaining, "body": body, "env": local}; }; +PRIMITIVES["make-let-frame"] = makeLetFrame; + + // make-define-frame + var makeDefineFrame = function(name, env, hasEffects, effectList) { return {"type": "define", "name": name, "env": env, "has-effects": hasEffects, "effect-list": effectList}; }; +PRIMITIVES["make-define-frame"] = makeDefineFrame; + + // make-set-frame + var makeSetFrame = function(name, env) { return {"type": "set", "name": name, "env": env}; }; +PRIMITIVES["make-set-frame"] = makeSetFrame; + + // make-arg-frame + var makeArgFrame = function(f, evaled, remaining, env, rawArgs, headName) { return {"type": "arg", "f": f, "evaled": evaled, "remaining": remaining, "env": env, "raw-args": rawArgs, "head-name": sxOr(headName, NIL)}; }; +PRIMITIVES["make-arg-frame"] = makeArgFrame; + + // make-call-frame + var makeCallFrame = function(f, args, env) { return {"type": "call", "f": f, "args": args, "env": env}; }; +PRIMITIVES["make-call-frame"] = makeCallFrame; + + // make-cond-frame + var makeCondFrame = function(remaining, env, scheme_p) { return {"type": "cond", "remaining": remaining, "env": env, "scheme": scheme_p}; }; +PRIMITIVES["make-cond-frame"] = makeCondFrame; + + // make-case-frame + var makeCaseFrame = function(matchVal, remaining, env) { return {"type": "case", "match-val": matchVal, "remaining": remaining, "env": env}; }; +PRIMITIVES["make-case-frame"] = makeCaseFrame; + + // make-thread-frame + var makeThreadFrame = function(remaining, env) { return {"type": "thread", "remaining": remaining, "env": env}; }; +PRIMITIVES["make-thread-frame"] = makeThreadFrame; + + // make-map-frame + var makeMapFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env, "indexed": false}; }; +PRIMITIVES["make-map-frame"] = makeMapFrame; + + // make-map-indexed-frame + var makeMapIndexedFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env, "indexed": true}; }; +PRIMITIVES["make-map-indexed-frame"] = makeMapIndexedFrame; + + // make-filter-frame + var makeFilterFrame = function(f, remaining, results, currentItem, env) { return {"type": "filter", "f": f, "remaining": remaining, "results": results, "current-item": currentItem, "env": env}; }; +PRIMITIVES["make-filter-frame"] = makeFilterFrame; + + // make-reduce-frame + var makeReduceFrame = function(f, remaining, env) { return {"type": "reduce", "f": f, "remaining": remaining, "env": env}; }; +PRIMITIVES["make-reduce-frame"] = makeReduceFrame; + + // make-for-each-frame + var makeForEachFrame = function(f, remaining, env) { return {"type": "for-each", "f": f, "remaining": remaining, "env": env}; }; +PRIMITIVES["make-for-each-frame"] = makeForEachFrame; + + // make-some-frame + var makeSomeFrame = function(f, remaining, env) { return {"type": "some", "f": f, "remaining": remaining, "env": env}; }; +PRIMITIVES["make-some-frame"] = makeSomeFrame; + + // make-every-frame + var makeEveryFrame = function(f, remaining, env) { return {"type": "every", "f": f, "remaining": remaining, "env": env}; }; +PRIMITIVES["make-every-frame"] = makeEveryFrame; + + // make-scope-frame + var makeScopeFrame = function(name, remaining, env) { return {"type": "scope", "name": name, "remaining": remaining, "env": env}; }; +PRIMITIVES["make-scope-frame"] = makeScopeFrame; + + // make-reset-frame + var makeResetFrame = function(env) { return {"type": "reset", "env": env}; }; +PRIMITIVES["make-reset-frame"] = makeResetFrame; + + // make-dict-frame + var makeDictFrame = function(remaining, results, env) { return {"type": "dict", "remaining": remaining, "results": results, "env": env}; }; +PRIMITIVES["make-dict-frame"] = makeDictFrame; + + // make-and-frame + var makeAndFrame = function(remaining, env) { return {"type": "and", "remaining": remaining, "env": env}; }; +PRIMITIVES["make-and-frame"] = makeAndFrame; + + // make-or-frame + var makeOrFrame = function(remaining, env) { return {"type": "or", "remaining": remaining, "env": env}; }; +PRIMITIVES["make-or-frame"] = makeOrFrame; + + // make-dynamic-wind-frame + var makeDynamicWindFrame = function(phase, bodyThunk, afterThunk, env) { return {"type": "dynamic-wind", "phase": phase, "body-thunk": bodyThunk, "after-thunk": afterThunk, "env": env}; }; +PRIMITIVES["make-dynamic-wind-frame"] = makeDynamicWindFrame; + + // make-reactive-reset-frame + var makeReactiveResetFrame = function(env, updateFn, firstRender_p) { return {"type": "reactive-reset", "env": env, "update-fn": updateFn, "first-render": firstRender_p}; }; +PRIMITIVES["make-reactive-reset-frame"] = makeReactiveResetFrame; + + // make-deref-frame + var makeDerefFrame = function(env) { return {"type": "deref", "env": env}; }; +PRIMITIVES["make-deref-frame"] = makeDerefFrame; + + // frame-type + var frameType = function(f) { return get(f, "type"); }; +PRIMITIVES["frame-type"] = frameType; + + // kont-push + var kontPush = function(frame, kont) { return cons(frame, kont); }; +PRIMITIVES["kont-push"] = kontPush; + + // kont-top + var kontTop = function(kont) { return first(kont); }; +PRIMITIVES["kont-top"] = kontTop; + + // kont-pop + var kontPop = function(kont) { return rest(kont); }; +PRIMITIVES["kont-pop"] = kontPop; + + // kont-empty? + var kontEmpty_p = function(kont) { return isEmpty(kont); }; +PRIMITIVES["kont-empty?"] = kontEmpty_p; + + // kont-capture-to-reset + var kontCaptureToReset = function(kont) { var scan = function(k, captured) { return (isSxTruthy(isEmpty(k)) ? error("shift without enclosing reset") : (function() { + var frame = first(k); + return (isSxTruthy(sxOr((frameType(frame) == "reset"), (frameType(frame) == "reactive-reset"))) ? [captured, rest(k)] : scan(rest(k), append(captured, [frame]))); +})()); }; +PRIMITIVES["scan"] = scan; +return scan(kont, []); }; +PRIMITIVES["kont-capture-to-reset"] = kontCaptureToReset; + + // has-reactive-reset-frame? + var hasReactiveResetFrame_p = function(kont) { return (isSxTruthy(isEmpty(kont)) ? false : (isSxTruthy((frameType(first(kont)) == "reactive-reset")) ? true : hasReactiveResetFrame_p(rest(kont)))); }; +PRIMITIVES["has-reactive-reset-frame?"] = hasReactiveResetFrame_p; + + // kont-capture-to-reactive-reset + var kontCaptureToReactiveReset = function(kont) { var scan = function(k, captured) { return (isSxTruthy(isEmpty(k)) ? error("reactive deref without enclosing reactive-reset") : (function() { + var frame = first(k); + return (isSxTruthy((frameType(frame) == "reactive-reset")) ? [captured, frame, rest(k)] : scan(rest(k), append(captured, [frame]))); +})()); }; +PRIMITIVES["scan"] = scan; +return scan(kont, []); }; +PRIMITIVES["kont-capture-to-reactive-reset"] = kontCaptureToReactiveReset; // trampoline var trampoline = function(val) { return (function() { @@ -1184,6 +1362,613 @@ PRIMITIVES["sf-provide"] = sfProvide; })(); }; PRIMITIVES["expand-macro"] = expandMacro; + // cek-run + var cekRun = function(state) { return (isSxTruthy(cekTerminal_p(state)) ? cekValue(state) : cekRun(cekStep(state))); }; +PRIMITIVES["cek-run"] = cekRun; + + // cek-step + var cekStep = function(state) { return (isSxTruthy((cekPhase(state) == "eval")) ? stepEval(state) : stepContinue(state)); }; +PRIMITIVES["cek-step"] = cekStep; + + // step-eval + var stepEval = function(state) { return (function() { + var expr = cekControl(state); + var env = cekEnv(state); + var kont = cekKont(state); + return (function() { var _m = typeOf(expr); if (_m == "number") return makeCekValue(expr, env, kont); if (_m == "string") return makeCekValue(expr, env, kont); if (_m == "boolean") return makeCekValue(expr, env, kont); if (_m == "nil") return makeCekValue(NIL, env, kont); if (_m == "symbol") return (function() { + var name = symbolName(expr); + return (function() { + var val = (isSxTruthy(envHas(env, name)) ? envGet(env, name) : (isSxTruthy(isPrimitive(name)) ? getPrimitive(name) : (isSxTruthy((name == "true")) ? true : (isSxTruthy((name == "false")) ? false : (isSxTruthy((name == "nil")) ? NIL : error((String("Undefined symbol: ") + String(name)))))))); + return makeCekValue(val, env, kont); +})(); +})(); if (_m == "keyword") return makeCekValue(keywordName(expr), env, kont); if (_m == "dict") return (function() { + var ks = keys(expr); + return (isSxTruthy(isEmpty(ks)) ? makeCekValue({}, env, kont) : (function() { + var firstKey = first(ks); + var remainingEntries = []; + { var _c = rest(ks); for (var _i = 0; _i < _c.length; _i++) { var k = _c[_i]; remainingEntries.push([k, get(expr, k)]); } } + return makeCekState(get(expr, firstKey), env, kontPush(makeDictFrame(remainingEntries, [[firstKey]], env), kont)); +})()); +})(); if (_m == "list") return (isSxTruthy(isEmpty(expr)) ? makeCekValue([], env, kont) : stepEvalList(expr, env, kont)); return makeCekValue(expr, env, kont); })(); +})(); }; +PRIMITIVES["step-eval"] = stepEval; + + // step-eval-list + var stepEvalList = function(expr, env, kont) { return (function() { + var head = first(expr); + var args = rest(expr); + return (isSxTruthy(!isSxTruthy(sxOr((typeOf(head) == "symbol"), (typeOf(head) == "lambda"), (typeOf(head) == "list")))) ? (isSxTruthy(isEmpty(expr)) ? makeCekValue([], env, kont) : makeCekState(first(expr), env, kontPush(makeMapFrame(NIL, rest(expr), [], env), kont))) : (isSxTruthy((typeOf(head) == "symbol")) ? (function() { + var name = symbolName(head); + return (isSxTruthy((name == "if")) ? stepSfIf(args, env, kont) : (isSxTruthy((name == "when")) ? stepSfWhen(args, env, kont) : (isSxTruthy((name == "cond")) ? stepSfCond(args, env, kont) : (isSxTruthy((name == "case")) ? stepSfCase(args, env, kont) : (isSxTruthy((name == "and")) ? stepSfAnd(args, env, kont) : (isSxTruthy((name == "or")) ? stepSfOr(args, env, kont) : (isSxTruthy((name == "let")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "let*")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "lambda")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "fn")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "define")) ? stepSfDefine(args, env, kont) : (isSxTruthy((name == "defcomp")) ? makeCekValue(sfDefcomp(args, env), env, kont) : (isSxTruthy((name == "defisland")) ? makeCekValue(sfDefisland(args, env), env, kont) : (isSxTruthy((name == "defmacro")) ? makeCekValue(sfDefmacro(args, env), env, kont) : (isSxTruthy((name == "defstyle")) ? makeCekValue(sfDefstyle(args, env), env, kont) : (isSxTruthy((name == "defhandler")) ? makeCekValue(sfDefhandler(args, env), env, kont) : (isSxTruthy((name == "defpage")) ? makeCekValue(sfDefpage(args, env), env, kont) : (isSxTruthy((name == "defquery")) ? makeCekValue(sfDefquery(args, env), env, kont) : (isSxTruthy((name == "defaction")) ? makeCekValue(sfDefaction(args, env), env, kont) : (isSxTruthy((name == "deftype")) ? makeCekValue(sfDeftype(args, env), env, kont) : (isSxTruthy((name == "defeffect")) ? makeCekValue(sfDefeffect(args, env), env, kont) : (isSxTruthy((name == "begin")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "do")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "quote")) ? makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont) : (isSxTruthy((name == "quasiquote")) ? makeCekValue(qqExpand(first(args), env), env, kont) : (isSxTruthy((name == "->")) ? stepSfThreadFirst(args, env, kont) : (isSxTruthy((name == "set!")) ? stepSfSet(args, env, kont) : (isSxTruthy((name == "letrec")) ? makeCekValue(sfLetrec(args, env), env, kont) : (isSxTruthy((name == "reset")) ? stepSfReset(args, env, kont) : (isSxTruthy((name == "shift")) ? stepSfShift(args, env, kont) : (isSxTruthy((name == "deref")) ? stepSfDeref(args, env, kont) : (isSxTruthy((name == "scope")) ? stepSfScope(args, env, kont) : (isSxTruthy((name == "provide")) ? stepSfProvide(args, env, kont) : (isSxTruthy((name == "dynamic-wind")) ? makeCekValue(sfDynamicWind(args, env), env, kont) : (isSxTruthy((name == "map")) ? stepHoMap(args, env, kont) : (isSxTruthy((name == "map-indexed")) ? stepHoMapIndexed(args, env, kont) : (isSxTruthy((name == "filter")) ? stepHoFilter(args, env, kont) : (isSxTruthy((name == "reduce")) ? stepHoReduce(args, env, kont) : (isSxTruthy((name == "some")) ? stepHoSome(args, env, kont) : (isSxTruthy((name == "every?")) ? stepHoEvery(args, env, kont) : (isSxTruthy((name == "for-each")) ? stepHoForEach(args, env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() { + var mac = envGet(env, name); + return makeCekState(expandMacro(mac, args, env), env, kont); +})() : (isSxTruthy((isSxTruthy(renderActiveP()) && isRenderExpr(expr))) ? makeCekValue(renderExpr(expr, env), env, kont) : stepEvalCall(head, args, env, kont)))))))))))))))))))))))))))))))))))))))))))); +})() : stepEvalCall(head, args, env, kont))); +})(); }; +PRIMITIVES["step-eval-list"] = stepEvalList; + + // step-sf-if + var stepSfIf = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeIfFrame(nth(args, 1), (isSxTruthy((len(args) > 2)) ? nth(args, 2) : NIL), env), kont)); }; +PRIMITIVES["step-sf-if"] = stepSfIf; + + // step-sf-when + var stepSfWhen = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeWhenFrame(rest(args), env), kont)); }; +PRIMITIVES["step-sf-when"] = stepSfWhen; + + // step-sf-begin + var stepSfBegin = function(args, env, kont) { return (isSxTruthy(isEmpty(args)) ? makeCekValue(NIL, env, kont) : (isSxTruthy((len(args) == 1)) ? makeCekState(first(args), env, kont) : makeCekState(first(args), env, kontPush(makeBeginFrame(rest(args), env), kont)))); }; +PRIMITIVES["step-sf-begin"] = stepSfBegin; + + // step-sf-let + var stepSfLet = function(args, env, kont) { return (isSxTruthy((typeOf(first(args)) == "symbol")) ? makeCekValue(sfNamedLet(args, env), env, kont) : (function() { + var bindings = first(args); + var body = rest(args); + var local = envExtend(env); + return (isSxTruthy(isEmpty(bindings)) ? stepSfBegin(body, local, kont) : (function() { + var firstBinding = (isSxTruthy((isSxTruthy((typeOf(first(bindings)) == "list")) && (len(first(bindings)) == 2))) ? first(bindings) : [first(bindings), nth(bindings, 1)]); + var restBindings = (isSxTruthy((isSxTruthy((typeOf(first(bindings)) == "list")) && (len(first(bindings)) == 2))) ? rest(bindings) : (function() { + var pairs = []; + reduce(function(acc, i) { return append_b(pairs, [nth(bindings, (i * 2)), nth(bindings, ((i * 2) + 1))]); }, NIL, range(1, (len(bindings) / 2))); + return pairs; +})()); + return (function() { + var vname = (isSxTruthy((typeOf(first(firstBinding)) == "symbol")) ? symbolName(first(firstBinding)) : first(firstBinding)); + return makeCekState(nth(firstBinding, 1), local, kontPush(makeLetFrame(vname, restBindings, body, local), kont)); +})(); +})()); +})()); }; +PRIMITIVES["step-sf-let"] = stepSfLet; + + // step-sf-define + var stepSfDefine = function(args, env, kont) { return (function() { + var nameSym = first(args); + var hasEffects = (isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects")); + var valIdx = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects"))) ? 3 : 1); + var effectList = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects"))) ? nth(args, 2) : NIL); + return makeCekState(nth(args, valIdx), env, kontPush(makeDefineFrame(symbolName(nameSym), env, hasEffects, effectList), kont)); +})(); }; +PRIMITIVES["step-sf-define"] = stepSfDefine; + + // step-sf-set! + var stepSfSet = function(args, env, kont) { return makeCekState(nth(args, 1), env, kontPush(makeSetFrame(symbolName(first(args)), env), kont)); }; +PRIMITIVES["step-sf-set!"] = stepSfSet; + + // step-sf-and + var stepSfAnd = function(args, env, kont) { return (isSxTruthy(isEmpty(args)) ? makeCekValue(true, env, kont) : makeCekState(first(args), env, kontPush(makeAndFrame(rest(args), env), kont))); }; +PRIMITIVES["step-sf-and"] = stepSfAnd; + + // step-sf-or + var stepSfOr = function(args, env, kont) { return (isSxTruthy(isEmpty(args)) ? makeCekValue(false, env, kont) : makeCekState(first(args), env, kontPush(makeOrFrame(rest(args), env), kont))); }; +PRIMITIVES["step-sf-or"] = stepSfOr; + + // step-sf-cond + var stepSfCond = function(args, env, kont) { return (function() { + var scheme_p = condScheme_p(args); + return (isSxTruthy(scheme_p) ? (isSxTruthy(isEmpty(args)) ? makeCekValue(NIL, env, kont) : (function() { + var clause = first(args); + var test = first(clause); + return (isSxTruthy(sxOr((isSxTruthy((typeOf(test) == "symbol")) && sxOr((symbolName(test) == "else"), (symbolName(test) == ":else"))), (isSxTruthy((typeOf(test) == "keyword")) && (keywordName(test) == "else")))) ? makeCekState(nth(clause, 1), env, kont) : makeCekState(test, env, kontPush(makeCondFrame(args, env, true), kont))); +})()) : (isSxTruthy((len(args) < 2)) ? makeCekValue(NIL, env, kont) : (function() { + var test = first(args); + return (isSxTruthy(sxOr((isSxTruthy((typeOf(test) == "keyword")) && (keywordName(test) == "else")), (isSxTruthy((typeOf(test) == "symbol")) && sxOr((symbolName(test) == "else"), (symbolName(test) == ":else"))))) ? makeCekState(nth(args, 1), env, kont) : makeCekState(test, env, kontPush(makeCondFrame(args, env, false), kont))); +})())); +})(); }; +PRIMITIVES["step-sf-cond"] = stepSfCond; + + // step-sf-case + var stepSfCase = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeCaseFrame(NIL, rest(args), env), kont)); }; +PRIMITIVES["step-sf-case"] = stepSfCase; + + // step-sf-thread-first + var stepSfThreadFirst = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeThreadFrame(rest(args), env), kont)); }; +PRIMITIVES["step-sf-thread-first"] = stepSfThreadFirst; + + // step-sf-lambda + var stepSfLambda = function(args, env, kont) { return makeCekValue(sfLambda(args, env), env, kont); }; +PRIMITIVES["step-sf-lambda"] = stepSfLambda; + + // step-sf-scope + var stepSfScope = function(args, env, kont) { return makeCekValue(sfScope(args, env), env, kont); }; +PRIMITIVES["step-sf-scope"] = stepSfScope; + + // step-sf-provide + var stepSfProvide = function(args, env, kont) { return makeCekValue(sfProvide(args, env), env, kont); }; +PRIMITIVES["step-sf-provide"] = stepSfProvide; + + // step-sf-reset + var stepSfReset = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeResetFrame(env), kont)); }; +PRIMITIVES["step-sf-reset"] = stepSfReset; + + // step-sf-shift + var stepSfShift = function(args, env, kont) { return (function() { + var kName = symbolName(first(args)); + var body = nth(args, 1); + var capturedResult = kontCaptureToReset(kont); + var captured = first(capturedResult); + var restKont = nth(capturedResult, 1); + return (function() { + var k = makeCekContinuation(captured, restKont); + return (function() { + var shiftEnv = envExtend(env); + envBind(shiftEnv, kName, k); + return makeCekState(body, shiftEnv, restKont); +})(); +})(); +})(); }; +PRIMITIVES["step-sf-shift"] = stepSfShift; + + // step-sf-deref + var stepSfDeref = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeDerefFrame(env), kont)); }; +PRIMITIVES["step-sf-deref"] = stepSfDeref; + + // cek-call + var cekCall = function(f, args) { return (function() { + var a = (isSxTruthy(isNil(args)) ? [] : args); + return (isSxTruthy(isNil(f)) ? NIL : (isSxTruthy(isLambda(f)) ? cekRun(continueWithCall(f, a, {}, a, [])) : (isSxTruthy(isCallable(f)) ? apply(f, a) : NIL))); +})(); }; +PRIMITIVES["cek-call"] = cekCall; + + // reactive-shift-deref + var reactiveShiftDeref = function(sig, env, kont) { return (function() { + var scanResult = kontCaptureToReactiveReset(kont); + var capturedFrames = first(scanResult); + var resetFrame = nth(scanResult, 1); + var remainingKont = nth(scanResult, 2); + var updateFn = get(resetFrame, "update-fn"); + return (function() { + var subDisposers = []; + return (function() { + var subscriber = function() { { var _c = subDisposers; for (var _i = 0; _i < _c.length; _i++) { var d = _c[_i]; cekCall(d, NIL); } } +subDisposers = []; +return (function() { + var newReset = makeReactiveResetFrame(env, updateFn, false); + var newKont = concat(capturedFrames, [newReset], remainingKont); + return withIslandScope(function(d) { return append_b(subDisposers, d); }, function() { return cekRun(makeCekValue(signalValue(sig), env, newKont)); }); +})(); }; + signalAddSub(sig, subscriber); + registerInScope(function() { signalRemoveSub(sig, subscriber); +return forEach(function(d) { return cekCall(d, NIL); }, subDisposers); }); + return (function() { + var initialKont = concat(capturedFrames, [resetFrame], remainingKont); + return makeCekValue(signalValue(sig), env, initialKont); +})(); +})(); +})(); +})(); }; +PRIMITIVES["reactive-shift-deref"] = reactiveShiftDeref; + + // step-eval-call + var stepEvalCall = function(head, args, env, kont) { return (function() { + var hname = (isSxTruthy((typeOf(head) == "symbol")) ? symbolName(head) : NIL); + return makeCekState(head, env, kontPush(makeArgFrame(NIL, [], args, env, args, hname), kont)); +})(); }; +PRIMITIVES["step-eval-call"] = stepEvalCall; + + // step-ho-map + var stepHoMap = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var coll = trampoline(evalExpr(nth(args, 1), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeMapFrame(f, rest(coll), [], env), kont))); +})(); }; +PRIMITIVES["step-ho-map"] = stepHoMap; + + // step-ho-map-indexed + var stepHoMapIndexed = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var coll = trampoline(evalExpr(nth(args, 1), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [0, first(coll)], env, [], kontPush(makeMapIndexedFrame(f, rest(coll), [], env), kont))); +})(); }; +PRIMITIVES["step-ho-map-indexed"] = stepHoMapIndexed; + + // step-ho-filter + var stepHoFilter = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var coll = trampoline(evalExpr(nth(args, 1), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeFilterFrame(f, rest(coll), [], first(coll), env), kont))); +})(); }; +PRIMITIVES["step-ho-filter"] = stepHoFilter; + + // step-ho-reduce + var stepHoReduce = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var init = trampoline(evalExpr(nth(args, 1), env)); + var coll = trampoline(evalExpr(nth(args, 2), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue(init, env, kont) : continueWithCall(f, [init, first(coll)], env, [], kontPush(makeReduceFrame(f, rest(coll), env), kont))); +})(); }; +PRIMITIVES["step-ho-reduce"] = stepHoReduce; + + // step-ho-some + var stepHoSome = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var coll = trampoline(evalExpr(nth(args, 1), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue(false, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeSomeFrame(f, rest(coll), env), kont))); +})(); }; +PRIMITIVES["step-ho-some"] = stepHoSome; + + // step-ho-every + var stepHoEvery = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var coll = trampoline(evalExpr(nth(args, 1), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue(true, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeEveryFrame(f, rest(coll), env), kont))); +})(); }; +PRIMITIVES["step-ho-every"] = stepHoEvery; + + // step-ho-for-each + var stepHoForEach = function(args, env, kont) { return (function() { + var f = trampoline(evalExpr(first(args), env)); + var coll = trampoline(evalExpr(nth(args, 1), env)); + return (isSxTruthy(isEmpty(coll)) ? makeCekValue(NIL, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeForEachFrame(f, rest(coll), env), kont))); +})(); }; +PRIMITIVES["step-ho-for-each"] = stepHoForEach; + + // step-continue + var stepContinue = function(state) { return (function() { + var value = cekValue(state); + var env = cekEnv(state); + var kont = cekKont(state); + return (isSxTruthy(kontEmpty_p(kont)) ? state : (function() { + var frame = kontTop(kont); + var restK = kontPop(kont); + var ft = frameType(frame); + return (isSxTruthy((ft == "if")) ? (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? makeCekState(get(frame, "then"), get(frame, "env"), restK) : (isSxTruthy(isNil(get(frame, "else"))) ? makeCekValue(NIL, env, restK) : makeCekState(get(frame, "else"), get(frame, "env"), restK))) : (isSxTruthy((ft == "when")) ? (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? (function() { + var body = get(frame, "body"); + var fenv = get(frame, "env"); + return (isSxTruthy(isEmpty(body)) ? makeCekValue(NIL, fenv, restK) : (isSxTruthy((len(body) == 1)) ? makeCekState(first(body), fenv, restK) : makeCekState(first(body), fenv, kontPush(makeBeginFrame(rest(body), fenv), restK)))); +})() : makeCekValue(NIL, env, restK)) : (isSxTruthy((ft == "begin")) ? (function() { + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : (isSxTruthy((len(remaining) == 1)) ? makeCekState(first(remaining), fenv, restK) : makeCekState(first(remaining), fenv, kontPush(makeBeginFrame(rest(remaining), fenv), restK)))); +})() : (isSxTruthy((ft == "let")) ? (function() { + var name = get(frame, "name"); + var remaining = get(frame, "remaining"); + var body = get(frame, "body"); + var local = get(frame, "env"); + envBind(local, name, value); + return (isSxTruthy(isEmpty(remaining)) ? stepSfBegin(body, local, restK) : (function() { + var nextBinding = first(remaining); + var vname = (isSxTruthy((typeOf(first(nextBinding)) == "symbol")) ? symbolName(first(nextBinding)) : first(nextBinding)); + return makeCekState(nth(nextBinding, 1), local, kontPush(makeLetFrame(vname, rest(remaining), body, local), restK)); +})()); +})() : (isSxTruthy((ft == "define")) ? (function() { + var name = get(frame, "name"); + var fenv = get(frame, "env"); + var hasEffects = get(frame, "has-effects"); + var effectList = get(frame, "effect-list"); + if (isSxTruthy((isSxTruthy(isLambda(value)) && isNil(lambdaName(value))))) { + value.name = name; +} + envBind(fenv, name, value); + if (isSxTruthy(hasEffects)) { + (function() { + var effectNames = (isSxTruthy((typeOf(effectList) == "list")) ? map(function(e) { return (isSxTruthy((typeOf(e) == "symbol")) ? symbolName(e) : (String(e))); }, effectList) : [(String(effectList))]); + var effectAnns = (isSxTruthy(envHas(fenv, "*effect-annotations*")) ? envGet(fenv, "*effect-annotations*") : {}); + effectAnns[name] = effectNames; + return envBind(fenv, "*effect-annotations*", effectAnns); +})(); +} + return makeCekValue(value, fenv, restK); +})() : (isSxTruthy((ft == "set")) ? (function() { + var name = get(frame, "name"); + var fenv = get(frame, "env"); + envSet(fenv, name, value); + return makeCekValue(value, env, restK); +})() : (isSxTruthy((ft == "and")) ? (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(value, env, restK) : (function() { + var remaining = get(frame, "remaining"); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, env, restK) : makeCekState(first(remaining), get(frame, "env"), (isSxTruthy((len(remaining) == 1)) ? restK : kontPush(makeAndFrame(rest(remaining), get(frame, "env")), restK)))); +})()) : (isSxTruthy((ft == "or")) ? (isSxTruthy(value) ? makeCekValue(value, env, restK) : (function() { + var remaining = get(frame, "remaining"); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(false, env, restK) : makeCekState(first(remaining), get(frame, "env"), (isSxTruthy((len(remaining) == 1)) ? restK : kontPush(makeOrFrame(rest(remaining), get(frame, "env")), restK)))); +})()) : (isSxTruthy((ft == "cond")) ? (function() { + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + var scheme_p = get(frame, "scheme"); + return (isSxTruthy(scheme_p) ? (isSxTruthy(value) ? makeCekState(nth(first(remaining), 1), fenv, restK) : (function() { + var nextClauses = rest(remaining); + return (isSxTruthy(isEmpty(nextClauses)) ? makeCekValue(NIL, fenv, restK) : (function() { + var nextClause = first(nextClauses); + var nextTest = first(nextClause); + return (isSxTruthy(sxOr((isSxTruthy((typeOf(nextTest) == "symbol")) && sxOr((symbolName(nextTest) == "else"), (symbolName(nextTest) == ":else"))), (isSxTruthy((typeOf(nextTest) == "keyword")) && (keywordName(nextTest) == "else")))) ? makeCekState(nth(nextClause, 1), fenv, restK) : makeCekState(nextTest, fenv, kontPush(makeCondFrame(nextClauses, fenv, true), restK))); +})()); +})()) : (isSxTruthy(value) ? makeCekState(nth(remaining, 1), fenv, restK) : (function() { + var next = slice(remaining, 2); + return (isSxTruthy((len(next) < 2)) ? makeCekValue(NIL, fenv, restK) : (function() { + var nextTest = first(next); + return (isSxTruthy(sxOr((isSxTruthy((typeOf(nextTest) == "keyword")) && (keywordName(nextTest) == "else")), (isSxTruthy((typeOf(nextTest) == "symbol")) && sxOr((symbolName(nextTest) == "else"), (symbolName(nextTest) == ":else"))))) ? makeCekState(nth(next, 1), fenv, restK) : makeCekState(nextTest, fenv, kontPush(makeCondFrame(next, fenv, false), restK))); +})()); +})())); +})() : (isSxTruthy((ft == "case")) ? (function() { + var matchVal = get(frame, "match-val"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(isNil(matchVal)) ? sfCaseStepLoop(value, remaining, fenv, restK) : sfCaseStepLoop(matchVal, remaining, fenv, restK)); +})() : (isSxTruthy((ft == "thread")) ? (function() { + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : (function() { + var form = first(remaining); + var restForms = rest(remaining); + return (function() { + var result = (isSxTruthy((typeOf(form) == "list")) ? (function() { + var f = trampoline(evalExpr(first(form), fenv)); + var rargs = map(function(a) { return trampoline(evalExpr(a, fenv)); }, rest(form)); + var allArgs = cons(value, rargs); + return (isSxTruthy((isSxTruthy(isCallable(f)) && !isSxTruthy(isLambda(f)))) ? apply(f, allArgs) : (isSxTruthy(isLambda(f)) ? trampoline(callLambda(f, allArgs, fenv)) : error((String("-> form not callable: ") + String(inspect(f)))))); +})() : (function() { + var f = trampoline(evalExpr(form, fenv)); + return (isSxTruthy((isSxTruthy(isCallable(f)) && !isSxTruthy(isLambda(f)))) ? f(value) : (isSxTruthy(isLambda(f)) ? trampoline(callLambda(f, [value], fenv)) : error((String("-> form not callable: ") + String(inspect(f)))))); +})()); + return (isSxTruthy(isEmpty(restForms)) ? makeCekValue(result, fenv, restK) : makeCekValue(result, fenv, kontPush(makeThreadFrame(restForms, fenv), restK))); +})(); +})()); +})() : (isSxTruthy((ft == "arg")) ? (function() { + var f = get(frame, "f"); + var evaled = get(frame, "evaled"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + var rawArgs = get(frame, "raw-args"); + var hname = get(frame, "head-name"); + return (isSxTruthy(isNil(f)) ? ((isSxTruthy((isSxTruthy(_strict_) && hname)) ? strictCheckArgs(hname, []) : NIL), (isSxTruthy(isEmpty(remaining)) ? continueWithCall(value, [], fenv, rawArgs, restK) : makeCekState(first(remaining), fenv, kontPush(makeArgFrame(value, [], rest(remaining), fenv, rawArgs, hname), restK)))) : (function() { + var newEvaled = append(evaled, [value]); + return (isSxTruthy(isEmpty(remaining)) ? ((isSxTruthy((isSxTruthy(_strict_) && hname)) ? strictCheckArgs(hname, newEvaled) : NIL), continueWithCall(f, newEvaled, fenv, rawArgs, restK)) : makeCekState(first(remaining), fenv, kontPush(makeArgFrame(f, newEvaled, rest(remaining), fenv, rawArgs, hname), restK))); +})()); +})() : (isSxTruthy((ft == "dict")) ? (function() { + var remaining = get(frame, "remaining"); + var results = get(frame, "results"); + var fenv = get(frame, "env"); + return (function() { + var lastResult = last(results); + var completed = append(slice(results, 0, (len(results) - 1)), [[first(lastResult), value]]); + return (isSxTruthy(isEmpty(remaining)) ? (function() { + var d = {}; + { var _c = completed; for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; d[first(pair)] = nth(pair, 1); } } + return makeCekValue(d, fenv, restK); +})() : (function() { + var nextEntry = first(remaining); + return makeCekState(nth(nextEntry, 1), fenv, kontPush(makeDictFrame(rest(remaining), append(completed, [[first(nextEntry)]]), fenv), restK)); +})()); +})(); +})() : (isSxTruthy((ft == "reset")) ? makeCekValue(value, env, restK) : (isSxTruthy((ft == "deref")) ? (function() { + var val = value; + var fenv = get(frame, "env"); + return (isSxTruthy(!isSxTruthy(isSignal(val))) ? makeCekValue(val, fenv, restK) : (isSxTruthy(hasReactiveResetFrame_p(restK)) ? reactiveShiftDeref(val, fenv, restK) : ((function() { + var ctx = sxContext("sx-reactive", NIL); + return (isSxTruthy(ctx) ? (function() { + var depList = get(ctx, "deps"); + var notifyFn = get(ctx, "notify"); + return (isSxTruthy(!isSxTruthy(contains(depList, val))) ? (append_b(depList, val), signalAddSub(val, notifyFn)) : NIL); +})() : NIL); +})(), makeCekValue(signalValue(val), fenv, restK)))); +})() : (isSxTruthy((ft == "reactive-reset")) ? (function() { + var updateFn = get(frame, "update-fn"); + var first_p = get(frame, "first-render"); + if (isSxTruthy((isSxTruthy(updateFn) && !isSxTruthy(first_p)))) { + cekCall(updateFn, [value]); +} + return makeCekValue(value, env, restK); +})() : (isSxTruthy((ft == "scope")) ? (function() { + var name = get(frame, "name"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(isEmpty(remaining)) ? (scopePop(name), makeCekValue(value, fenv, restK)) : makeCekState(first(remaining), fenv, kontPush(makeScopeFrame(name, rest(remaining), fenv), restK))); +})() : (isSxTruthy((ft == "map")) ? (function() { + var f = get(frame, "f"); + var remaining = get(frame, "remaining"); + var results = get(frame, "results"); + var indexed = get(frame, "indexed"); + var fenv = get(frame, "env"); + return (function() { + var newResults = append(results, [value]); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(newResults, fenv, restK) : (function() { + var callArgs = (isSxTruthy(indexed) ? [len(newResults), first(remaining)] : [first(remaining)]); + var nextFrame = (isSxTruthy(indexed) ? makeMapIndexedFrame(f, rest(remaining), newResults, fenv) : makeMapFrame(f, rest(remaining), newResults, fenv)); + return continueWithCall(f, callArgs, fenv, [], kontPush(nextFrame, restK)); +})()); +})(); +})() : (isSxTruthy((ft == "filter")) ? (function() { + var f = get(frame, "f"); + var remaining = get(frame, "remaining"); + var results = get(frame, "results"); + var currentItem = get(frame, "current-item"); + var fenv = get(frame, "env"); + return (function() { + var newResults = (isSxTruthy(value) ? append(results, [currentItem]) : results); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(newResults, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeFilterFrame(f, rest(remaining), newResults, first(remaining), fenv), restK))); +})(); +})() : (isSxTruthy((ft == "reduce")) ? (function() { + var f = get(frame, "f"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : continueWithCall(f, [value, first(remaining)], fenv, [], kontPush(makeReduceFrame(f, rest(remaining), fenv), restK))); +})() : (isSxTruthy((ft == "for-each")) ? (function() { + var f = get(frame, "f"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(NIL, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeForEachFrame(f, rest(remaining), fenv), restK))); +})() : (isSxTruthy((ft == "some")) ? (function() { + var f = get(frame, "f"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(value) ? makeCekValue(value, fenv, restK) : (isSxTruthy(isEmpty(remaining)) ? makeCekValue(false, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeSomeFrame(f, rest(remaining), fenv), restK)))); +})() : (isSxTruthy((ft == "every")) ? (function() { + var f = get(frame, "f"); + var remaining = get(frame, "remaining"); + var fenv = get(frame, "env"); + return (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(false, fenv, restK) : (isSxTruthy(isEmpty(remaining)) ? makeCekValue(true, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeEveryFrame(f, rest(remaining), fenv), restK)))); +})() : error((String("Unknown frame type: ") + String(ft)))))))))))))))))))))))))); +})()); +})(); }; +PRIMITIVES["step-continue"] = stepContinue; + + // continue-with-call + var continueWithCall = function(f, args, env, rawArgs, kont) { return (isSxTruthy(continuation_p(f)) ? (function() { + var arg = (isSxTruthy(isEmpty(args)) ? NIL : first(args)); + var contData = continuationData(f); + return (function() { + var captured = get(contData, "captured"); + var restK = get(contData, "rest-kont"); + return makeCekValue(arg, env, concat(captured, restK)); +})(); +})() : (isSxTruthy((isSxTruthy(isCallable(f)) && isSxTruthy(!isSxTruthy(isLambda(f))) && isSxTruthy(!isSxTruthy(isComponent(f))) && !isSxTruthy(isIsland(f)))) ? makeCekValue(apply(f, args), env, kont) : (isSxTruthy(isLambda(f)) ? (function() { + var params = lambdaParams(f); + var local = envMerge(lambdaClosure(f), env); + return (isSxTruthy((len(args) > len(params))) ? error((String(sxOr(lambdaName(f), "lambda")) + String(" expects ") + String(len(params)) + String(" args, got ") + String(len(args)))) : (forEach(function(pair) { return envBind(local, first(pair), nth(pair, 1)); }, zip(params, args)), forEach(function(p) { return envBind(local, p, NIL); }, slice(params, len(args))), makeCekState(lambdaBody(f), local, kont))); +})() : (isSxTruthy(sxOr(isComponent(f), isIsland(f))) ? (function() { + var parsed = parseKeywordArgs(rawArgs, env); + var kwargs = first(parsed); + var children = nth(parsed, 1); + var local = envMerge(componentClosure(f), env); + { var _c = componentParams(f); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envBind(local, p, sxOr(dictGet(kwargs, p), NIL)); } } + if (isSxTruthy(componentHasChildren(f))) { + envBind(local, "children", children); +} + return makeCekState(componentBody(f), local, kont); +})() : error((String("Not callable: ") + String(inspect(f)))))))); }; +PRIMITIVES["continue-with-call"] = continueWithCall; + + // sf-case-step-loop + var sfCaseStepLoop = function(matchVal, clauses, env, kont) { return (isSxTruthy((len(clauses) < 2)) ? makeCekValue(NIL, env, kont) : (function() { + var test = first(clauses); + var body = nth(clauses, 1); + return (isSxTruthy(sxOr((isSxTruthy((typeOf(test) == "keyword")) && (keywordName(test) == "else")), (isSxTruthy((typeOf(test) == "symbol")) && sxOr((symbolName(test) == "else"), (symbolName(test) == ":else"))))) ? makeCekState(body, env, kont) : (function() { + var testVal = trampoline(evalExpr(test, env)); + return (isSxTruthy((matchVal == testVal)) ? makeCekState(body, env, kont) : sfCaseStepLoop(matchVal, slice(clauses, 2), env, kont)); +})()); +})()); }; +PRIMITIVES["sf-case-step-loop"] = sfCaseStepLoop; + + // eval-expr-cek + var evalExprCek = function(expr, env) { return cekRun(makeCekState(expr, env, [])); }; +PRIMITIVES["eval-expr-cek"] = evalExprCek; + + // trampoline-cek + var trampolineCek = function(val) { return (isSxTruthy(isThunk(val)) ? evalExprCek(thunkExpr(val), thunkEnv(val)) : val); }; +PRIMITIVES["trampoline-cek"] = trampolineCek; + + // freeze-registry + var freezeRegistry = {}; +PRIMITIVES["freeze-registry"] = freezeRegistry; + + // freeze-signal + var freezeSignal = function(name, sig) { return (function() { + var scopeName = sxContext("sx-freeze-scope", NIL); + return (isSxTruthy(scopeName) ? (function() { + var entries = sxOr(get(freezeRegistry, scopeName), []); + entries.push({["name"]: name, ["signal"]: sig}); + return dictSet(freezeRegistry, scopeName, entries); +})() : NIL); +})(); }; +PRIMITIVES["freeze-signal"] = freezeSignal; + + // freeze-scope + var freezeScope = function(name, bodyFn) { scopePush("sx-freeze-scope", name); +freezeRegistry[name] = []; +cekCall(bodyFn, NIL); +scopePop("sx-freeze-scope"); +return NIL; }; +PRIMITIVES["freeze-scope"] = freezeScope; + + // cek-freeze-scope + var cekFreezeScope = function(name) { return (function() { + var entries = sxOr(get(freezeRegistry, name), []); + var signalsDict = {}; + { var _c = entries; for (var _i = 0; _i < _c.length; _i++) { var entry = _c[_i]; signalsDict[get(entry, "name")] = signalValue(get(entry, "signal")); } } + return {["name"]: name, ["signals"]: signalsDict}; +})(); }; +PRIMITIVES["cek-freeze-scope"] = cekFreezeScope; + + // cek-freeze-all + var cekFreezeAll = function() { return map(function(name) { return cekFreezeScope(name); }, keys(freezeRegistry)); }; +PRIMITIVES["cek-freeze-all"] = cekFreezeAll; + + // cek-thaw-scope + var cekThawScope = function(name, frozen) { return (function() { + var entries = sxOr(get(freezeRegistry, name), []); + var values = get(frozen, "signals"); + return (isSxTruthy(values) ? forEach(function(entry) { return (function() { + var sigName = get(entry, "name"); + var sig = get(entry, "signal"); + var val = get(values, sigName); + return (isSxTruthy(!isSxTruthy(isNil(val))) ? reset_b(sig, val) : NIL); +})(); }, entries) : NIL); +})(); }; +PRIMITIVES["cek-thaw-scope"] = cekThawScope; + + // cek-thaw-all + var cekThawAll = function(frozenList) { return forEach(function(frozen) { return cekThawScope(get(frozen, "name"), frozen); }, frozenList); }; +PRIMITIVES["cek-thaw-all"] = cekThawAll; + + // freeze-to-sx + var freezeToSx = function(name) { return sxSerialize(cekFreezeScope(name)); }; +PRIMITIVES["freeze-to-sx"] = freezeToSx; + + // thaw-from-sx + var thawFromSx = function(sxText) { return (function() { + var parsed = sxParse(sxText); + return (isSxTruthy(!isSxTruthy(isEmpty(parsed))) ? (function() { + var frozen = first(parsed); + return cekThawScope(get(frozen, "name"), frozen); +})() : NIL); +})(); }; +PRIMITIVES["thaw-from-sx"] = thawFromSx; + + // content-store + var contentStore = {}; +PRIMITIVES["content-store"] = contentStore; + + // content-hash + var contentHash = function(sxText) { return (function() { + var hash = 5381; + { var _c = range(0, len(sxText)); for (var _i = 0; _i < _c.length; _i++) { var i = _c[_i]; hash = (((hash * 33) + charCodeAt(sxText, i)) % 4294967296); } } + return toHex(hash); +})(); }; +PRIMITIVES["content-hash"] = contentHash; + + // content-put + var contentPut = function(sxText) { return (function() { + var cid = contentHash(sxText); + contentStore[cid] = sxText; + return cid; +})(); }; +PRIMITIVES["content-put"] = contentPut; + + // content-get + var contentGet = function(cid) { return get(contentStore, cid); }; +PRIMITIVES["content-get"] = contentGet; + + // freeze-to-cid + var freezeToCid = function(scopeName) { return (function() { + var sxText = freezeToSx(scopeName); + return contentPut(sxText); +})(); }; +PRIMITIVES["freeze-to-cid"] = freezeToCid; + + // thaw-from-cid + var thawFromCid = function(cid) { return (function() { + var sxText = contentGet(cid); + return (isSxTruthy(sxText) ? (thawFromSx(sxText), true) : NIL); +})(); }; +PRIMITIVES["thaw-from-cid"] = thawFromCid; + // === Transpiled from render (core) === @@ -3982,187 +4767,6 @@ PRIMITIVES["page-render-plan"] = pageRenderPlan; PRIMITIVES["env-components"] = envComponents; - // === Transpiled from frames (CEK continuation frames) === - - // make-cek-state - var makeCekState = function(control, env, kont) { return {"control": control, "env": env, "kont": kont, "phase": "eval", "value": NIL}; }; -PRIMITIVES["make-cek-state"] = makeCekState; - - // make-cek-value - var makeCekValue = function(value, env, kont) { return {"control": NIL, "env": env, "kont": kont, "phase": "continue", "value": value}; }; -PRIMITIVES["make-cek-value"] = makeCekValue; - - // cek-terminal? - var cekTerminal_p = function(state) { return (isSxTruthy((get(state, "phase") == "continue")) && isEmpty(get(state, "kont"))); }; -PRIMITIVES["cek-terminal?"] = cekTerminal_p; - - // cek-control - var cekControl = function(s) { return get(s, "control"); }; -PRIMITIVES["cek-control"] = cekControl; - - // cek-env - var cekEnv = function(s) { return get(s, "env"); }; -PRIMITIVES["cek-env"] = cekEnv; - - // cek-kont - var cekKont = function(s) { return get(s, "kont"); }; -PRIMITIVES["cek-kont"] = cekKont; - - // cek-phase - var cekPhase = function(s) { return get(s, "phase"); }; -PRIMITIVES["cek-phase"] = cekPhase; - - // cek-value - var cekValue = function(s) { return get(s, "value"); }; -PRIMITIVES["cek-value"] = cekValue; - - // make-if-frame - var makeIfFrame = function(thenExpr, elseExpr, env) { return {"type": "if", "then": thenExpr, "else": elseExpr, "env": env}; }; -PRIMITIVES["make-if-frame"] = makeIfFrame; - - // make-when-frame - var makeWhenFrame = function(bodyExprs, env) { return {"type": "when", "body": bodyExprs, "env": env}; }; -PRIMITIVES["make-when-frame"] = makeWhenFrame; - - // make-begin-frame - var makeBeginFrame = function(remaining, env) { return {"type": "begin", "remaining": remaining, "env": env}; }; -PRIMITIVES["make-begin-frame"] = makeBeginFrame; - - // make-let-frame - var makeLetFrame = function(name, remaining, body, local) { return {"type": "let", "name": name, "remaining": remaining, "body": body, "env": local}; }; -PRIMITIVES["make-let-frame"] = makeLetFrame; - - // make-define-frame - var makeDefineFrame = function(name, env, hasEffects, effectList) { return {"type": "define", "name": name, "env": env, "has-effects": hasEffects, "effect-list": effectList}; }; -PRIMITIVES["make-define-frame"] = makeDefineFrame; - - // make-set-frame - var makeSetFrame = function(name, env) { return {"type": "set", "name": name, "env": env}; }; -PRIMITIVES["make-set-frame"] = makeSetFrame; - - // make-arg-frame - var makeArgFrame = function(f, evaled, remaining, env, rawArgs, headName) { return {"type": "arg", "f": f, "evaled": evaled, "remaining": remaining, "env": env, "raw-args": rawArgs, "head-name": sxOr(headName, NIL)}; }; -PRIMITIVES["make-arg-frame"] = makeArgFrame; - - // make-call-frame - var makeCallFrame = function(f, args, env) { return {"type": "call", "f": f, "args": args, "env": env}; }; -PRIMITIVES["make-call-frame"] = makeCallFrame; - - // make-cond-frame - var makeCondFrame = function(remaining, env, scheme_p) { return {"type": "cond", "remaining": remaining, "env": env, "scheme": scheme_p}; }; -PRIMITIVES["make-cond-frame"] = makeCondFrame; - - // make-case-frame - var makeCaseFrame = function(matchVal, remaining, env) { return {"type": "case", "match-val": matchVal, "remaining": remaining, "env": env}; }; -PRIMITIVES["make-case-frame"] = makeCaseFrame; - - // make-thread-frame - var makeThreadFrame = function(remaining, env) { return {"type": "thread", "remaining": remaining, "env": env}; }; -PRIMITIVES["make-thread-frame"] = makeThreadFrame; - - // make-map-frame - var makeMapFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env, "indexed": false}; }; -PRIMITIVES["make-map-frame"] = makeMapFrame; - - // make-map-indexed-frame - var makeMapIndexedFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env, "indexed": true}; }; -PRIMITIVES["make-map-indexed-frame"] = makeMapIndexedFrame; - - // make-filter-frame - var makeFilterFrame = function(f, remaining, results, currentItem, env) { return {"type": "filter", "f": f, "remaining": remaining, "results": results, "current-item": currentItem, "env": env}; }; -PRIMITIVES["make-filter-frame"] = makeFilterFrame; - - // make-reduce-frame - var makeReduceFrame = function(f, remaining, env) { return {"type": "reduce", "f": f, "remaining": remaining, "env": env}; }; -PRIMITIVES["make-reduce-frame"] = makeReduceFrame; - - // make-for-each-frame - var makeForEachFrame = function(f, remaining, env) { return {"type": "for-each", "f": f, "remaining": remaining, "env": env}; }; -PRIMITIVES["make-for-each-frame"] = makeForEachFrame; - - // make-some-frame - var makeSomeFrame = function(f, remaining, env) { return {"type": "some", "f": f, "remaining": remaining, "env": env}; }; -PRIMITIVES["make-some-frame"] = makeSomeFrame; - - // make-every-frame - var makeEveryFrame = function(f, remaining, env) { return {"type": "every", "f": f, "remaining": remaining, "env": env}; }; -PRIMITIVES["make-every-frame"] = makeEveryFrame; - - // make-scope-frame - var makeScopeFrame = function(name, remaining, env) { return {"type": "scope", "name": name, "remaining": remaining, "env": env}; }; -PRIMITIVES["make-scope-frame"] = makeScopeFrame; - - // make-reset-frame - var makeResetFrame = function(env) { return {"type": "reset", "env": env}; }; -PRIMITIVES["make-reset-frame"] = makeResetFrame; - - // make-dict-frame - var makeDictFrame = function(remaining, results, env) { return {"type": "dict", "remaining": remaining, "results": results, "env": env}; }; -PRIMITIVES["make-dict-frame"] = makeDictFrame; - - // make-and-frame - var makeAndFrame = function(remaining, env) { return {"type": "and", "remaining": remaining, "env": env}; }; -PRIMITIVES["make-and-frame"] = makeAndFrame; - - // make-or-frame - var makeOrFrame = function(remaining, env) { return {"type": "or", "remaining": remaining, "env": env}; }; -PRIMITIVES["make-or-frame"] = makeOrFrame; - - // make-dynamic-wind-frame - var makeDynamicWindFrame = function(phase, bodyThunk, afterThunk, env) { return {"type": "dynamic-wind", "phase": phase, "body-thunk": bodyThunk, "after-thunk": afterThunk, "env": env}; }; -PRIMITIVES["make-dynamic-wind-frame"] = makeDynamicWindFrame; - - // make-reactive-reset-frame - var makeReactiveResetFrame = function(env, updateFn, firstRender_p) { return {"type": "reactive-reset", "env": env, "update-fn": updateFn, "first-render": firstRender_p}; }; -PRIMITIVES["make-reactive-reset-frame"] = makeReactiveResetFrame; - - // make-deref-frame - var makeDerefFrame = function(env) { return {"type": "deref", "env": env}; }; -PRIMITIVES["make-deref-frame"] = makeDerefFrame; - - // frame-type - var frameType = function(f) { return get(f, "type"); }; -PRIMITIVES["frame-type"] = frameType; - - // kont-push - var kontPush = function(frame, kont) { return cons(frame, kont); }; -PRIMITIVES["kont-push"] = kontPush; - - // kont-top - var kontTop = function(kont) { return first(kont); }; -PRIMITIVES["kont-top"] = kontTop; - - // kont-pop - var kontPop = function(kont) { return rest(kont); }; -PRIMITIVES["kont-pop"] = kontPop; - - // kont-empty? - var kontEmpty_p = function(kont) { return isEmpty(kont); }; -PRIMITIVES["kont-empty?"] = kontEmpty_p; - - // kont-capture-to-reset - var kontCaptureToReset = function(kont) { var scan = function(k, captured) { return (isSxTruthy(isEmpty(k)) ? error("shift without enclosing reset") : (function() { - var frame = first(k); - return (isSxTruthy(sxOr((frameType(frame) == "reset"), (frameType(frame) == "reactive-reset"))) ? [captured, rest(k)] : scan(rest(k), append(captured, [frame]))); -})()); }; -PRIMITIVES["scan"] = scan; -return scan(kont, []); }; -PRIMITIVES["kont-capture-to-reset"] = kontCaptureToReset; - - // has-reactive-reset-frame? - var hasReactiveResetFrame_p = function(kont) { return (isSxTruthy(isEmpty(kont)) ? false : (isSxTruthy((frameType(first(kont)) == "reactive-reset")) ? true : hasReactiveResetFrame_p(rest(kont)))); }; -PRIMITIVES["has-reactive-reset-frame?"] = hasReactiveResetFrame_p; - - // kont-capture-to-reactive-reset - var kontCaptureToReactiveReset = function(kont) { var scan = function(k, captured) { return (isSxTruthy(isEmpty(k)) ? error("reactive deref without enclosing reactive-reset") : (function() { - var frame = first(k); - return (isSxTruthy((frameType(frame) == "reactive-reset")) ? [captured, frame, rest(k)] : scan(rest(k), append(captured, [frame]))); -})()); }; -PRIMITIVES["scan"] = scan; -return scan(kont, []); }; -PRIMITIVES["kont-capture-to-reactive-reset"] = kontCaptureToReactiveReset; - - // === Transpiled from page-helpers (pure data transformation helpers) === // special-form-category-map @@ -4625,616 +5229,6 @@ PRIMITIVES["auto-quote-unknowns"] = autoQuoteUnknowns; PRIMITIVES["prepare-url-expr"] = prepareUrlExpr; - // === Transpiled from cek (explicit CEK machine evaluator) === - - // cek-run - var cekRun = function(state) { return (isSxTruthy(cekTerminal_p(state)) ? cekValue(state) : cekRun(cekStep(state))); }; -PRIMITIVES["cek-run"] = cekRun; - - // cek-step - var cekStep = function(state) { return (isSxTruthy((cekPhase(state) == "eval")) ? stepEval(state) : stepContinue(state)); }; -PRIMITIVES["cek-step"] = cekStep; - - // step-eval - var stepEval = function(state) { return (function() { - var expr = cekControl(state); - var env = cekEnv(state); - var kont = cekKont(state); - return (function() { var _m = typeOf(expr); if (_m == "number") return makeCekValue(expr, env, kont); if (_m == "string") return makeCekValue(expr, env, kont); if (_m == "boolean") return makeCekValue(expr, env, kont); if (_m == "nil") return makeCekValue(NIL, env, kont); if (_m == "symbol") return (function() { - var name = symbolName(expr); - return (function() { - var val = (isSxTruthy(envHas(env, name)) ? envGet(env, name) : (isSxTruthy(isPrimitive(name)) ? getPrimitive(name) : (isSxTruthy((name == "true")) ? true : (isSxTruthy((name == "false")) ? false : (isSxTruthy((name == "nil")) ? NIL : error((String("Undefined symbol: ") + String(name)))))))); - return makeCekValue(val, env, kont); -})(); -})(); if (_m == "keyword") return makeCekValue(keywordName(expr), env, kont); if (_m == "dict") return (function() { - var ks = keys(expr); - return (isSxTruthy(isEmpty(ks)) ? makeCekValue({}, env, kont) : (function() { - var firstKey = first(ks); - var remainingEntries = []; - { var _c = rest(ks); for (var _i = 0; _i < _c.length; _i++) { var k = _c[_i]; remainingEntries.push([k, get(expr, k)]); } } - return makeCekState(get(expr, firstKey), env, kontPush(makeDictFrame(remainingEntries, [[firstKey]], env), kont)); -})()); -})(); if (_m == "list") return (isSxTruthy(isEmpty(expr)) ? makeCekValue([], env, kont) : stepEvalList(expr, env, kont)); return makeCekValue(expr, env, kont); })(); -})(); }; -PRIMITIVES["step-eval"] = stepEval; - - // step-eval-list - var stepEvalList = function(expr, env, kont) { return (function() { - var head = first(expr); - var args = rest(expr); - return (isSxTruthy(!isSxTruthy(sxOr((typeOf(head) == "symbol"), (typeOf(head) == "lambda"), (typeOf(head) == "list")))) ? (isSxTruthy(isEmpty(expr)) ? makeCekValue([], env, kont) : makeCekState(first(expr), env, kontPush(makeMapFrame(NIL, rest(expr), [], env), kont))) : (isSxTruthy((typeOf(head) == "symbol")) ? (function() { - var name = symbolName(head); - return (isSxTruthy((name == "if")) ? stepSfIf(args, env, kont) : (isSxTruthy((name == "when")) ? stepSfWhen(args, env, kont) : (isSxTruthy((name == "cond")) ? stepSfCond(args, env, kont) : (isSxTruthy((name == "case")) ? stepSfCase(args, env, kont) : (isSxTruthy((name == "and")) ? stepSfAnd(args, env, kont) : (isSxTruthy((name == "or")) ? stepSfOr(args, env, kont) : (isSxTruthy((name == "let")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "let*")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "lambda")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "fn")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "define")) ? stepSfDefine(args, env, kont) : (isSxTruthy((name == "defcomp")) ? makeCekValue(sfDefcomp(args, env), env, kont) : (isSxTruthy((name == "defisland")) ? makeCekValue(sfDefisland(args, env), env, kont) : (isSxTruthy((name == "defmacro")) ? makeCekValue(sfDefmacro(args, env), env, kont) : (isSxTruthy((name == "defstyle")) ? makeCekValue(sfDefstyle(args, env), env, kont) : (isSxTruthy((name == "defhandler")) ? makeCekValue(sfDefhandler(args, env), env, kont) : (isSxTruthy((name == "defpage")) ? makeCekValue(sfDefpage(args, env), env, kont) : (isSxTruthy((name == "defquery")) ? makeCekValue(sfDefquery(args, env), env, kont) : (isSxTruthy((name == "defaction")) ? makeCekValue(sfDefaction(args, env), env, kont) : (isSxTruthy((name == "deftype")) ? makeCekValue(sfDeftype(args, env), env, kont) : (isSxTruthy((name == "defeffect")) ? makeCekValue(sfDefeffect(args, env), env, kont) : (isSxTruthy((name == "begin")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "do")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "quote")) ? makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont) : (isSxTruthy((name == "quasiquote")) ? makeCekValue(qqExpand(first(args), env), env, kont) : (isSxTruthy((name == "->")) ? stepSfThreadFirst(args, env, kont) : (isSxTruthy((name == "set!")) ? stepSfSet(args, env, kont) : (isSxTruthy((name == "letrec")) ? makeCekValue(sfLetrec(args, env), env, kont) : (isSxTruthy((name == "reset")) ? stepSfReset(args, env, kont) : (isSxTruthy((name == "shift")) ? stepSfShift(args, env, kont) : (isSxTruthy((name == "deref")) ? stepSfDeref(args, env, kont) : (isSxTruthy((name == "scope")) ? stepSfScope(args, env, kont) : (isSxTruthy((name == "provide")) ? stepSfProvide(args, env, kont) : (isSxTruthy((name == "dynamic-wind")) ? makeCekValue(sfDynamicWind(args, env), env, kont) : (isSxTruthy((name == "map")) ? stepHoMap(args, env, kont) : (isSxTruthy((name == "map-indexed")) ? stepHoMapIndexed(args, env, kont) : (isSxTruthy((name == "filter")) ? stepHoFilter(args, env, kont) : (isSxTruthy((name == "reduce")) ? stepHoReduce(args, env, kont) : (isSxTruthy((name == "some")) ? stepHoSome(args, env, kont) : (isSxTruthy((name == "every?")) ? stepHoEvery(args, env, kont) : (isSxTruthy((name == "for-each")) ? stepHoForEach(args, env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() { - var mac = envGet(env, name); - return makeCekState(expandMacro(mac, args, env), env, kont); -})() : (isSxTruthy((isSxTruthy(renderActiveP()) && isRenderExpr(expr))) ? makeCekValue(renderExpr(expr, env), env, kont) : stepEvalCall(head, args, env, kont)))))))))))))))))))))))))))))))))))))))))))); -})() : stepEvalCall(head, args, env, kont))); -})(); }; -PRIMITIVES["step-eval-list"] = stepEvalList; - - // step-sf-if - var stepSfIf = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeIfFrame(nth(args, 1), (isSxTruthy((len(args) > 2)) ? nth(args, 2) : NIL), env), kont)); }; -PRIMITIVES["step-sf-if"] = stepSfIf; - - // step-sf-when - var stepSfWhen = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeWhenFrame(rest(args), env), kont)); }; -PRIMITIVES["step-sf-when"] = stepSfWhen; - - // step-sf-begin - var stepSfBegin = function(args, env, kont) { return (isSxTruthy(isEmpty(args)) ? makeCekValue(NIL, env, kont) : (isSxTruthy((len(args) == 1)) ? makeCekState(first(args), env, kont) : makeCekState(first(args), env, kontPush(makeBeginFrame(rest(args), env), kont)))); }; -PRIMITIVES["step-sf-begin"] = stepSfBegin; - - // step-sf-let - var stepSfLet = function(args, env, kont) { return (isSxTruthy((typeOf(first(args)) == "symbol")) ? makeCekValue(sfNamedLet(args, env), env, kont) : (function() { - var bindings = first(args); - var body = rest(args); - var local = envExtend(env); - return (isSxTruthy(isEmpty(bindings)) ? stepSfBegin(body, local, kont) : (function() { - var firstBinding = (isSxTruthy((isSxTruthy((typeOf(first(bindings)) == "list")) && (len(first(bindings)) == 2))) ? first(bindings) : [first(bindings), nth(bindings, 1)]); - var restBindings = (isSxTruthy((isSxTruthy((typeOf(first(bindings)) == "list")) && (len(first(bindings)) == 2))) ? rest(bindings) : (function() { - var pairs = []; - reduce(function(acc, i) { return append_b(pairs, [nth(bindings, (i * 2)), nth(bindings, ((i * 2) + 1))]); }, NIL, range(1, (len(bindings) / 2))); - return pairs; -})()); - return (function() { - var vname = (isSxTruthy((typeOf(first(firstBinding)) == "symbol")) ? symbolName(first(firstBinding)) : first(firstBinding)); - return makeCekState(nth(firstBinding, 1), local, kontPush(makeLetFrame(vname, restBindings, body, local), kont)); -})(); -})()); -})()); }; -PRIMITIVES["step-sf-let"] = stepSfLet; - - // step-sf-define - var stepSfDefine = function(args, env, kont) { return (function() { - var nameSym = first(args); - var hasEffects = (isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects")); - var valIdx = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects"))) ? 3 : 1); - var effectList = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy((typeOf(nth(args, 1)) == "keyword")) && (keywordName(nth(args, 1)) == "effects"))) ? nth(args, 2) : NIL); - return makeCekState(nth(args, valIdx), env, kontPush(makeDefineFrame(symbolName(nameSym), env, hasEffects, effectList), kont)); -})(); }; -PRIMITIVES["step-sf-define"] = stepSfDefine; - - // step-sf-set! - var stepSfSet = function(args, env, kont) { return makeCekState(nth(args, 1), env, kontPush(makeSetFrame(symbolName(first(args)), env), kont)); }; -PRIMITIVES["step-sf-set!"] = stepSfSet; - - // step-sf-and - var stepSfAnd = function(args, env, kont) { return (isSxTruthy(isEmpty(args)) ? makeCekValue(true, env, kont) : makeCekState(first(args), env, kontPush(makeAndFrame(rest(args), env), kont))); }; -PRIMITIVES["step-sf-and"] = stepSfAnd; - - // step-sf-or - var stepSfOr = function(args, env, kont) { return (isSxTruthy(isEmpty(args)) ? makeCekValue(false, env, kont) : makeCekState(first(args), env, kontPush(makeOrFrame(rest(args), env), kont))); }; -PRIMITIVES["step-sf-or"] = stepSfOr; - - // step-sf-cond - var stepSfCond = function(args, env, kont) { return (function() { - var scheme_p = condScheme_p(args); - return (isSxTruthy(scheme_p) ? (isSxTruthy(isEmpty(args)) ? makeCekValue(NIL, env, kont) : (function() { - var clause = first(args); - var test = first(clause); - return (isSxTruthy(sxOr((isSxTruthy((typeOf(test) == "symbol")) && sxOr((symbolName(test) == "else"), (symbolName(test) == ":else"))), (isSxTruthy((typeOf(test) == "keyword")) && (keywordName(test) == "else")))) ? makeCekState(nth(clause, 1), env, kont) : makeCekState(test, env, kontPush(makeCondFrame(args, env, true), kont))); -})()) : (isSxTruthy((len(args) < 2)) ? makeCekValue(NIL, env, kont) : (function() { - var test = first(args); - return (isSxTruthy(sxOr((isSxTruthy((typeOf(test) == "keyword")) && (keywordName(test) == "else")), (isSxTruthy((typeOf(test) == "symbol")) && sxOr((symbolName(test) == "else"), (symbolName(test) == ":else"))))) ? makeCekState(nth(args, 1), env, kont) : makeCekState(test, env, kontPush(makeCondFrame(args, env, false), kont))); -})())); -})(); }; -PRIMITIVES["step-sf-cond"] = stepSfCond; - - // step-sf-case - var stepSfCase = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeCaseFrame(NIL, rest(args), env), kont)); }; -PRIMITIVES["step-sf-case"] = stepSfCase; - - // step-sf-thread-first - var stepSfThreadFirst = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeThreadFrame(rest(args), env), kont)); }; -PRIMITIVES["step-sf-thread-first"] = stepSfThreadFirst; - - // step-sf-lambda - var stepSfLambda = function(args, env, kont) { return makeCekValue(sfLambda(args, env), env, kont); }; -PRIMITIVES["step-sf-lambda"] = stepSfLambda; - - // step-sf-scope - var stepSfScope = function(args, env, kont) { return makeCekValue(sfScope(args, env), env, kont); }; -PRIMITIVES["step-sf-scope"] = stepSfScope; - - // step-sf-provide - var stepSfProvide = function(args, env, kont) { return makeCekValue(sfProvide(args, env), env, kont); }; -PRIMITIVES["step-sf-provide"] = stepSfProvide; - - // step-sf-reset - var stepSfReset = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeResetFrame(env), kont)); }; -PRIMITIVES["step-sf-reset"] = stepSfReset; - - // step-sf-shift - var stepSfShift = function(args, env, kont) { return (function() { - var kName = symbolName(first(args)); - var body = nth(args, 1); - var capturedResult = kontCaptureToReset(kont); - var captured = first(capturedResult); - var restKont = nth(capturedResult, 1); - return (function() { - var k = makeCekContinuation(captured, restKont); - return (function() { - var shiftEnv = envExtend(env); - envBind(shiftEnv, kName, k); - return makeCekState(body, shiftEnv, restKont); -})(); -})(); -})(); }; -PRIMITIVES["step-sf-shift"] = stepSfShift; - - // step-sf-deref - var stepSfDeref = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeDerefFrame(env), kont)); }; -PRIMITIVES["step-sf-deref"] = stepSfDeref; - - // cek-call - var cekCall = function(f, args) { return (function() { - var a = (isSxTruthy(isNil(args)) ? [] : args); - return (isSxTruthy(isNil(f)) ? NIL : (isSxTruthy(isLambda(f)) ? cekRun(continueWithCall(f, a, {}, a, [])) : (isSxTruthy(isCallable(f)) ? apply(f, a) : NIL))); -})(); }; -PRIMITIVES["cek-call"] = cekCall; - - // reactive-shift-deref - var reactiveShiftDeref = function(sig, env, kont) { return (function() { - var scanResult = kontCaptureToReactiveReset(kont); - var capturedFrames = first(scanResult); - var resetFrame = nth(scanResult, 1); - var remainingKont = nth(scanResult, 2); - var updateFn = get(resetFrame, "update-fn"); - return (function() { - var subDisposers = []; - return (function() { - var subscriber = function() { { var _c = subDisposers; for (var _i = 0; _i < _c.length; _i++) { var d = _c[_i]; cekCall(d, NIL); } } -subDisposers = []; -return (function() { - var newReset = makeReactiveResetFrame(env, updateFn, false); - var newKont = concat(capturedFrames, [newReset], remainingKont); - return withIslandScope(function(d) { return append_b(subDisposers, d); }, function() { return cekRun(makeCekValue(signalValue(sig), env, newKont)); }); -})(); }; - signalAddSub(sig, subscriber); - registerInScope(function() { signalRemoveSub(sig, subscriber); -return forEach(function(d) { return cekCall(d, NIL); }, subDisposers); }); - return (function() { - var initialKont = concat(capturedFrames, [resetFrame], remainingKont); - return makeCekValue(signalValue(sig), env, initialKont); -})(); -})(); -})(); -})(); }; -PRIMITIVES["reactive-shift-deref"] = reactiveShiftDeref; - - // step-eval-call - var stepEvalCall = function(head, args, env, kont) { return (function() { - var hname = (isSxTruthy((typeOf(head) == "symbol")) ? symbolName(head) : NIL); - return makeCekState(head, env, kontPush(makeArgFrame(NIL, [], args, env, args, hname), kont)); -})(); }; -PRIMITIVES["step-eval-call"] = stepEvalCall; - - // step-ho-map - var stepHoMap = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var coll = trampoline(evalExpr(nth(args, 1), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeMapFrame(f, rest(coll), [], env), kont))); -})(); }; -PRIMITIVES["step-ho-map"] = stepHoMap; - - // step-ho-map-indexed - var stepHoMapIndexed = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var coll = trampoline(evalExpr(nth(args, 1), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [0, first(coll)], env, [], kontPush(makeMapIndexedFrame(f, rest(coll), [], env), kont))); -})(); }; -PRIMITIVES["step-ho-map-indexed"] = stepHoMapIndexed; - - // step-ho-filter - var stepHoFilter = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var coll = trampoline(evalExpr(nth(args, 1), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeFilterFrame(f, rest(coll), [], first(coll), env), kont))); -})(); }; -PRIMITIVES["step-ho-filter"] = stepHoFilter; - - // step-ho-reduce - var stepHoReduce = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var init = trampoline(evalExpr(nth(args, 1), env)); - var coll = trampoline(evalExpr(nth(args, 2), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue(init, env, kont) : continueWithCall(f, [init, first(coll)], env, [], kontPush(makeReduceFrame(f, rest(coll), env), kont))); -})(); }; -PRIMITIVES["step-ho-reduce"] = stepHoReduce; - - // step-ho-some - var stepHoSome = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var coll = trampoline(evalExpr(nth(args, 1), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue(false, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeSomeFrame(f, rest(coll), env), kont))); -})(); }; -PRIMITIVES["step-ho-some"] = stepHoSome; - - // step-ho-every - var stepHoEvery = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var coll = trampoline(evalExpr(nth(args, 1), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue(true, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeEveryFrame(f, rest(coll), env), kont))); -})(); }; -PRIMITIVES["step-ho-every"] = stepHoEvery; - - // step-ho-for-each - var stepHoForEach = function(args, env, kont) { return (function() { - var f = trampoline(evalExpr(first(args), env)); - var coll = trampoline(evalExpr(nth(args, 1), env)); - return (isSxTruthy(isEmpty(coll)) ? makeCekValue(NIL, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeForEachFrame(f, rest(coll), env), kont))); -})(); }; -PRIMITIVES["step-ho-for-each"] = stepHoForEach; - - // step-continue - var stepContinue = function(state) { return (function() { - var value = cekValue(state); - var env = cekEnv(state); - var kont = cekKont(state); - return (isSxTruthy(kontEmpty_p(kont)) ? state : (function() { - var frame = kontTop(kont); - var restK = kontPop(kont); - var ft = frameType(frame); - return (isSxTruthy((ft == "if")) ? (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? makeCekState(get(frame, "then"), get(frame, "env"), restK) : (isSxTruthy(isNil(get(frame, "else"))) ? makeCekValue(NIL, env, restK) : makeCekState(get(frame, "else"), get(frame, "env"), restK))) : (isSxTruthy((ft == "when")) ? (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? (function() { - var body = get(frame, "body"); - var fenv = get(frame, "env"); - return (isSxTruthy(isEmpty(body)) ? makeCekValue(NIL, fenv, restK) : (isSxTruthy((len(body) == 1)) ? makeCekState(first(body), fenv, restK) : makeCekState(first(body), fenv, kontPush(makeBeginFrame(rest(body), fenv), restK)))); -})() : makeCekValue(NIL, env, restK)) : (isSxTruthy((ft == "begin")) ? (function() { - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : (isSxTruthy((len(remaining) == 1)) ? makeCekState(first(remaining), fenv, restK) : makeCekState(first(remaining), fenv, kontPush(makeBeginFrame(rest(remaining), fenv), restK)))); -})() : (isSxTruthy((ft == "let")) ? (function() { - var name = get(frame, "name"); - var remaining = get(frame, "remaining"); - var body = get(frame, "body"); - var local = get(frame, "env"); - envBind(local, name, value); - return (isSxTruthy(isEmpty(remaining)) ? stepSfBegin(body, local, restK) : (function() { - var nextBinding = first(remaining); - var vname = (isSxTruthy((typeOf(first(nextBinding)) == "symbol")) ? symbolName(first(nextBinding)) : first(nextBinding)); - return makeCekState(nth(nextBinding, 1), local, kontPush(makeLetFrame(vname, rest(remaining), body, local), restK)); -})()); -})() : (isSxTruthy((ft == "define")) ? (function() { - var name = get(frame, "name"); - var fenv = get(frame, "env"); - var hasEffects = get(frame, "has-effects"); - var effectList = get(frame, "effect-list"); - if (isSxTruthy((isSxTruthy(isLambda(value)) && isNil(lambdaName(value))))) { - value.name = name; -} - envBind(fenv, name, value); - if (isSxTruthy(hasEffects)) { - (function() { - var effectNames = (isSxTruthy((typeOf(effectList) == "list")) ? map(function(e) { return (isSxTruthy((typeOf(e) == "symbol")) ? symbolName(e) : (String(e))); }, effectList) : [(String(effectList))]); - var effectAnns = (isSxTruthy(envHas(fenv, "*effect-annotations*")) ? envGet(fenv, "*effect-annotations*") : {}); - effectAnns[name] = effectNames; - return envBind(fenv, "*effect-annotations*", effectAnns); -})(); -} - return makeCekValue(value, fenv, restK); -})() : (isSxTruthy((ft == "set")) ? (function() { - var name = get(frame, "name"); - var fenv = get(frame, "env"); - envSet(fenv, name, value); - return makeCekValue(value, env, restK); -})() : (isSxTruthy((ft == "and")) ? (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(value, env, restK) : (function() { - var remaining = get(frame, "remaining"); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, env, restK) : makeCekState(first(remaining), get(frame, "env"), (isSxTruthy((len(remaining) == 1)) ? restK : kontPush(makeAndFrame(rest(remaining), get(frame, "env")), restK)))); -})()) : (isSxTruthy((ft == "or")) ? (isSxTruthy(value) ? makeCekValue(value, env, restK) : (function() { - var remaining = get(frame, "remaining"); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(false, env, restK) : makeCekState(first(remaining), get(frame, "env"), (isSxTruthy((len(remaining) == 1)) ? restK : kontPush(makeOrFrame(rest(remaining), get(frame, "env")), restK)))); -})()) : (isSxTruthy((ft == "cond")) ? (function() { - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - var scheme_p = get(frame, "scheme"); - return (isSxTruthy(scheme_p) ? (isSxTruthy(value) ? makeCekState(nth(first(remaining), 1), fenv, restK) : (function() { - var nextClauses = rest(remaining); - return (isSxTruthy(isEmpty(nextClauses)) ? makeCekValue(NIL, fenv, restK) : (function() { - var nextClause = first(nextClauses); - var nextTest = first(nextClause); - return (isSxTruthy(sxOr((isSxTruthy((typeOf(nextTest) == "symbol")) && sxOr((symbolName(nextTest) == "else"), (symbolName(nextTest) == ":else"))), (isSxTruthy((typeOf(nextTest) == "keyword")) && (keywordName(nextTest) == "else")))) ? makeCekState(nth(nextClause, 1), fenv, restK) : makeCekState(nextTest, fenv, kontPush(makeCondFrame(nextClauses, fenv, true), restK))); -})()); -})()) : (isSxTruthy(value) ? makeCekState(nth(remaining, 1), fenv, restK) : (function() { - var next = slice(remaining, 2); - return (isSxTruthy((len(next) < 2)) ? makeCekValue(NIL, fenv, restK) : (function() { - var nextTest = first(next); - return (isSxTruthy(sxOr((isSxTruthy((typeOf(nextTest) == "keyword")) && (keywordName(nextTest) == "else")), (isSxTruthy((typeOf(nextTest) == "symbol")) && sxOr((symbolName(nextTest) == "else"), (symbolName(nextTest) == ":else"))))) ? makeCekState(nth(next, 1), fenv, restK) : makeCekState(nextTest, fenv, kontPush(makeCondFrame(next, fenv, false), restK))); -})()); -})())); -})() : (isSxTruthy((ft == "case")) ? (function() { - var matchVal = get(frame, "match-val"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(isNil(matchVal)) ? sfCaseStepLoop(value, remaining, fenv, restK) : sfCaseStepLoop(matchVal, remaining, fenv, restK)); -})() : (isSxTruthy((ft == "thread")) ? (function() { - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : (function() { - var form = first(remaining); - var restForms = rest(remaining); - return (function() { - var result = (isSxTruthy((typeOf(form) == "list")) ? (function() { - var f = trampoline(evalExpr(first(form), fenv)); - var rargs = map(function(a) { return trampoline(evalExpr(a, fenv)); }, rest(form)); - var allArgs = cons(value, rargs); - return (isSxTruthy((isSxTruthy(isCallable(f)) && !isSxTruthy(isLambda(f)))) ? apply(f, allArgs) : (isSxTruthy(isLambda(f)) ? trampoline(callLambda(f, allArgs, fenv)) : error((String("-> form not callable: ") + String(inspect(f)))))); -})() : (function() { - var f = trampoline(evalExpr(form, fenv)); - return (isSxTruthy((isSxTruthy(isCallable(f)) && !isSxTruthy(isLambda(f)))) ? f(value) : (isSxTruthy(isLambda(f)) ? trampoline(callLambda(f, [value], fenv)) : error((String("-> form not callable: ") + String(inspect(f)))))); -})()); - return (isSxTruthy(isEmpty(restForms)) ? makeCekValue(result, fenv, restK) : makeCekValue(result, fenv, kontPush(makeThreadFrame(restForms, fenv), restK))); -})(); -})()); -})() : (isSxTruthy((ft == "arg")) ? (function() { - var f = get(frame, "f"); - var evaled = get(frame, "evaled"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - var rawArgs = get(frame, "raw-args"); - var hname = get(frame, "head-name"); - return (isSxTruthy(isNil(f)) ? ((isSxTruthy((isSxTruthy(_strict_) && hname)) ? strictCheckArgs(hname, []) : NIL), (isSxTruthy(isEmpty(remaining)) ? continueWithCall(value, [], fenv, rawArgs, restK) : makeCekState(first(remaining), fenv, kontPush(makeArgFrame(value, [], rest(remaining), fenv, rawArgs, hname), restK)))) : (function() { - var newEvaled = append(evaled, [value]); - return (isSxTruthy(isEmpty(remaining)) ? ((isSxTruthy((isSxTruthy(_strict_) && hname)) ? strictCheckArgs(hname, newEvaled) : NIL), continueWithCall(f, newEvaled, fenv, rawArgs, restK)) : makeCekState(first(remaining), fenv, kontPush(makeArgFrame(f, newEvaled, rest(remaining), fenv, rawArgs, hname), restK))); -})()); -})() : (isSxTruthy((ft == "dict")) ? (function() { - var remaining = get(frame, "remaining"); - var results = get(frame, "results"); - var fenv = get(frame, "env"); - return (function() { - var lastResult = last(results); - var completed = append(slice(results, 0, (len(results) - 1)), [[first(lastResult), value]]); - return (isSxTruthy(isEmpty(remaining)) ? (function() { - var d = {}; - { var _c = completed; for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; d[first(pair)] = nth(pair, 1); } } - return makeCekValue(d, fenv, restK); -})() : (function() { - var nextEntry = first(remaining); - return makeCekState(nth(nextEntry, 1), fenv, kontPush(makeDictFrame(rest(remaining), append(completed, [[first(nextEntry)]]), fenv), restK)); -})()); -})(); -})() : (isSxTruthy((ft == "reset")) ? makeCekValue(value, env, restK) : (isSxTruthy((ft == "deref")) ? (function() { - var val = value; - var fenv = get(frame, "env"); - return (isSxTruthy(!isSxTruthy(isSignal(val))) ? makeCekValue(val, fenv, restK) : (isSxTruthy(hasReactiveResetFrame_p(restK)) ? reactiveShiftDeref(val, fenv, restK) : ((function() { - var ctx = sxContext("sx-reactive", NIL); - return (isSxTruthy(ctx) ? (function() { - var depList = get(ctx, "deps"); - var notifyFn = get(ctx, "notify"); - return (isSxTruthy(!isSxTruthy(contains(depList, val))) ? (append_b(depList, val), signalAddSub(val, notifyFn)) : NIL); -})() : NIL); -})(), makeCekValue(signalValue(val), fenv, restK)))); -})() : (isSxTruthy((ft == "reactive-reset")) ? (function() { - var updateFn = get(frame, "update-fn"); - var first_p = get(frame, "first-render"); - if (isSxTruthy((isSxTruthy(updateFn) && !isSxTruthy(first_p)))) { - cekCall(updateFn, [value]); -} - return makeCekValue(value, env, restK); -})() : (isSxTruthy((ft == "scope")) ? (function() { - var name = get(frame, "name"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(isEmpty(remaining)) ? (scopePop(name), makeCekValue(value, fenv, restK)) : makeCekState(first(remaining), fenv, kontPush(makeScopeFrame(name, rest(remaining), fenv), restK))); -})() : (isSxTruthy((ft == "map")) ? (function() { - var f = get(frame, "f"); - var remaining = get(frame, "remaining"); - var results = get(frame, "results"); - var indexed = get(frame, "indexed"); - var fenv = get(frame, "env"); - return (function() { - var newResults = append(results, [value]); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(newResults, fenv, restK) : (function() { - var callArgs = (isSxTruthy(indexed) ? [len(newResults), first(remaining)] : [first(remaining)]); - var nextFrame = (isSxTruthy(indexed) ? makeMapIndexedFrame(f, rest(remaining), newResults, fenv) : makeMapFrame(f, rest(remaining), newResults, fenv)); - return continueWithCall(f, callArgs, fenv, [], kontPush(nextFrame, restK)); -})()); -})(); -})() : (isSxTruthy((ft == "filter")) ? (function() { - var f = get(frame, "f"); - var remaining = get(frame, "remaining"); - var results = get(frame, "results"); - var currentItem = get(frame, "current-item"); - var fenv = get(frame, "env"); - return (function() { - var newResults = (isSxTruthy(value) ? append(results, [currentItem]) : results); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(newResults, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeFilterFrame(f, rest(remaining), newResults, first(remaining), fenv), restK))); -})(); -})() : (isSxTruthy((ft == "reduce")) ? (function() { - var f = get(frame, "f"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : continueWithCall(f, [value, first(remaining)], fenv, [], kontPush(makeReduceFrame(f, rest(remaining), fenv), restK))); -})() : (isSxTruthy((ft == "for-each")) ? (function() { - var f = get(frame, "f"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(NIL, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeForEachFrame(f, rest(remaining), fenv), restK))); -})() : (isSxTruthy((ft == "some")) ? (function() { - var f = get(frame, "f"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(value) ? makeCekValue(value, fenv, restK) : (isSxTruthy(isEmpty(remaining)) ? makeCekValue(false, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeSomeFrame(f, rest(remaining), fenv), restK)))); -})() : (isSxTruthy((ft == "every")) ? (function() { - var f = get(frame, "f"); - var remaining = get(frame, "remaining"); - var fenv = get(frame, "env"); - return (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(false, fenv, restK) : (isSxTruthy(isEmpty(remaining)) ? makeCekValue(true, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeEveryFrame(f, rest(remaining), fenv), restK)))); -})() : error((String("Unknown frame type: ") + String(ft)))))))))))))))))))))))))); -})()); -})(); }; -PRIMITIVES["step-continue"] = stepContinue; - - // continue-with-call - var continueWithCall = function(f, args, env, rawArgs, kont) { return (isSxTruthy(continuation_p(f)) ? (function() { - var arg = (isSxTruthy(isEmpty(args)) ? NIL : first(args)); - var contData = continuationData(f); - return (function() { - var captured = get(contData, "captured"); - var restK = get(contData, "rest-kont"); - return makeCekValue(arg, env, concat(captured, restK)); -})(); -})() : (isSxTruthy((isSxTruthy(isCallable(f)) && isSxTruthy(!isSxTruthy(isLambda(f))) && isSxTruthy(!isSxTruthy(isComponent(f))) && !isSxTruthy(isIsland(f)))) ? makeCekValue(apply(f, args), env, kont) : (isSxTruthy(isLambda(f)) ? (function() { - var params = lambdaParams(f); - var local = envMerge(lambdaClosure(f), env); - return (isSxTruthy((len(args) > len(params))) ? error((String(sxOr(lambdaName(f), "lambda")) + String(" expects ") + String(len(params)) + String(" args, got ") + String(len(args)))) : (forEach(function(pair) { return envBind(local, first(pair), nth(pair, 1)); }, zip(params, args)), forEach(function(p) { return envBind(local, p, NIL); }, slice(params, len(args))), makeCekState(lambdaBody(f), local, kont))); -})() : (isSxTruthy(sxOr(isComponent(f), isIsland(f))) ? (function() { - var parsed = parseKeywordArgs(rawArgs, env); - var kwargs = first(parsed); - var children = nth(parsed, 1); - var local = envMerge(componentClosure(f), env); - { var _c = componentParams(f); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envBind(local, p, sxOr(dictGet(kwargs, p), NIL)); } } - if (isSxTruthy(componentHasChildren(f))) { - envBind(local, "children", children); -} - return makeCekState(componentBody(f), local, kont); -})() : error((String("Not callable: ") + String(inspect(f)))))))); }; -PRIMITIVES["continue-with-call"] = continueWithCall; - - // sf-case-step-loop - var sfCaseStepLoop = function(matchVal, clauses, env, kont) { return (isSxTruthy((len(clauses) < 2)) ? makeCekValue(NIL, env, kont) : (function() { - var test = first(clauses); - var body = nth(clauses, 1); - return (isSxTruthy(sxOr((isSxTruthy((typeOf(test) == "keyword")) && (keywordName(test) == "else")), (isSxTruthy((typeOf(test) == "symbol")) && sxOr((symbolName(test) == "else"), (symbolName(test) == ":else"))))) ? makeCekState(body, env, kont) : (function() { - var testVal = trampoline(evalExpr(test, env)); - return (isSxTruthy((matchVal == testVal)) ? makeCekState(body, env, kont) : sfCaseStepLoop(matchVal, slice(clauses, 2), env, kont)); -})()); -})()); }; -PRIMITIVES["sf-case-step-loop"] = sfCaseStepLoop; - - // eval-expr-cek - var evalExprCek = function(expr, env) { return cekRun(makeCekState(expr, env, [])); }; -PRIMITIVES["eval-expr-cek"] = evalExprCek; - - // trampoline-cek - var trampolineCek = function(val) { return (isSxTruthy(isThunk(val)) ? evalExprCek(thunkExpr(val), thunkEnv(val)) : val); }; -PRIMITIVES["trampoline-cek"] = trampolineCek; - - // freeze-registry - var freezeRegistry = {}; -PRIMITIVES["freeze-registry"] = freezeRegistry; - - // freeze-signal - var freezeSignal = function(name, sig) { return (function() { - var scopeName = sxContext("sx-freeze-scope", NIL); - return (isSxTruthy(scopeName) ? (function() { - var entries = sxOr(get(freezeRegistry, scopeName), []); - entries.push({["name"]: name, ["signal"]: sig}); - return dictSet(freezeRegistry, scopeName, entries); -})() : NIL); -})(); }; -PRIMITIVES["freeze-signal"] = freezeSignal; - - // freeze-scope - var freezeScope = function(name, bodyFn) { scopePush("sx-freeze-scope", name); -freezeRegistry[name] = []; -cekCall(bodyFn, NIL); -scopePop("sx-freeze-scope"); -return NIL; }; -PRIMITIVES["freeze-scope"] = freezeScope; - - // cek-freeze-scope - var cekFreezeScope = function(name) { return (function() { - var entries = sxOr(get(freezeRegistry, name), []); - var signalsDict = {}; - { var _c = entries; for (var _i = 0; _i < _c.length; _i++) { var entry = _c[_i]; signalsDict[get(entry, "name")] = signalValue(get(entry, "signal")); } } - return {["name"]: name, ["signals"]: signalsDict}; -})(); }; -PRIMITIVES["cek-freeze-scope"] = cekFreezeScope; - - // cek-freeze-all - var cekFreezeAll = function() { return map(function(name) { return cekFreezeScope(name); }, keys(freezeRegistry)); }; -PRIMITIVES["cek-freeze-all"] = cekFreezeAll; - - // cek-thaw-scope - var cekThawScope = function(name, frozen) { return (function() { - var entries = sxOr(get(freezeRegistry, name), []); - var values = get(frozen, "signals"); - return (isSxTruthy(values) ? forEach(function(entry) { return (function() { - var sigName = get(entry, "name"); - var sig = get(entry, "signal"); - var val = get(values, sigName); - return (isSxTruthy(!isSxTruthy(isNil(val))) ? reset_b(sig, val) : NIL); -})(); }, entries) : NIL); -})(); }; -PRIMITIVES["cek-thaw-scope"] = cekThawScope; - - // cek-thaw-all - var cekThawAll = function(frozenList) { return forEach(function(frozen) { return cekThawScope(get(frozen, "name"), frozen); }, frozenList); }; -PRIMITIVES["cek-thaw-all"] = cekThawAll; - - // freeze-to-sx - var freezeToSx = function(name) { return sxSerialize(cekFreezeScope(name)); }; -PRIMITIVES["freeze-to-sx"] = freezeToSx; - - // thaw-from-sx - var thawFromSx = function(sxText) { return (function() { - var parsed = sxParse(sxText); - return (isSxTruthy(!isSxTruthy(isEmpty(parsed))) ? (function() { - var frozen = first(parsed); - return cekThawScope(get(frozen, "name"), frozen); -})() : NIL); -})(); }; -PRIMITIVES["thaw-from-sx"] = thawFromSx; - - // content-store - var contentStore = {}; -PRIMITIVES["content-store"] = contentStore; - - // content-hash - var contentHash = function(sxText) { return (function() { - var hash = 5381; - { var _c = range(0, len(sxText)); for (var _i = 0; _i < _c.length; _i++) { var i = _c[_i]; hash = (((hash * 33) + charCodeAt(sxText, i)) % 4294967296); } } - return toHex(hash); -})(); }; -PRIMITIVES["content-hash"] = contentHash; - - // content-put - var contentPut = function(sxText) { return (function() { - var cid = contentHash(sxText); - contentStore[cid] = sxText; - return cid; -})(); }; -PRIMITIVES["content-put"] = contentPut; - - // content-get - var contentGet = function(cid) { return get(contentStore, cid); }; -PRIMITIVES["content-get"] = contentGet; - - // freeze-to-cid - var freezeToCid = function(scopeName) { return (function() { - var sxText = freezeToSx(scopeName); - return contentPut(sxText); -})(); }; -PRIMITIVES["freeze-to-cid"] = freezeToCid; - - // thaw-from-cid - var thawFromCid = function(cid) { return (function() { - var sxText = contentGet(cid); - return (isSxTruthy(sxText) ? (thawFromSx(sxText), true) : NIL); -})(); }; -PRIMITIVES["thaw-from-cid"] = thawFromCid; - - // === Transpiled from signals (reactive signal runtime) === // make-signal diff --git a/spec/continuations.sx b/spec/continuations.sx deleted file mode 100644 index b5ae623..0000000 --- a/spec/continuations.sx +++ /dev/null @@ -1,248 +0,0 @@ -;; ========================================================================== -;; continuations.sx — Delimited continuations (shift/reset) -;; -;; OPTIONAL EXTENSION — not required by the core evaluator. -;; Bootstrappers include this only when the target requests it. -;; -;; Delimited continuations capture "the rest of the computation up to -;; a delimiter." They are strictly less powerful than full call/cc but -;; cover the practical use cases: suspendable rendering, cooperative -;; scheduling, linear async flows, wizard forms, and undo. -;; -;; Two new special forms: -;; (reset body) — establish a delimiter -;; (shift k body) — capture the continuation to the nearest reset -;; -;; One new type: -;; continuation — a captured delimited continuation, callable -;; -;; The captured continuation is a function of one argument. Invoking it -;; provides the value that the shift expression "returns" within the -;; delimited context, then completes the rest of the reset body. -;; -;; Continuations are composable — invoking a continuation returns a -;; value (the result of the reset body), which can be used normally. -;; This is the key difference from undelimited call/cc, where invoking -;; a continuation never returns. -;; -;; Platform requirements: -;; (make-continuation fn) — wrap a function as a continuation value -;; (continuation? x) — type predicate -;; (type-of continuation) → "continuation" -;; Continuations are callable (same dispatch as lambda). -;; ========================================================================== - - -;; -------------------------------------------------------------------------- -;; 1. Type -;; -------------------------------------------------------------------------- -;; -;; A continuation is a callable value of one argument. -;; -;; (continuation? k) → true if k is a captured continuation -;; (type-of k) → "continuation" -;; (k value) → invoke: resume the captured computation with value -;; -;; Continuations are first-class: they can be stored in variables, passed -;; as arguments, returned from functions, and put in data structures. -;; -;; Invoking a delimited continuation RETURNS a value — the result of the -;; reset body. This makes them composable: -;; -;; (+ 1 (reset (+ 10 (shift k (k 5))))) -;; ;; k is "add 10 to _ and return from reset" -;; ;; (k 5) → 15, which is returned from reset -;; ;; (+ 1 15) → 16 -;; -;; -------------------------------------------------------------------------- - - -;; -------------------------------------------------------------------------- -;; 2. reset — establish a continuation delimiter -;; -------------------------------------------------------------------------- -;; -;; (reset body) -;; -;; Evaluates body in the current environment. If no shift occurs during -;; evaluation of body, reset simply returns the value of body. -;; -;; If shift occurs, reset is the boundary — the continuation captured by -;; shift extends from the shift point back to (and including) this reset. -;; -;; reset is the "prompt" — it marks where the continuation stops. -;; -;; Semantics: -;; (reset expr) where expr contains no shift -;; → (eval expr env) ;; just evaluates normally -;; -;; (reset ... (shift k body) ...) -;; → captures continuation, evaluates shift's body -;; → the result of the shift body is the result of the reset -;; -;; -------------------------------------------------------------------------- - -(define sf-reset - (fn ((args :as list) (env :as dict)) - ;; Single argument: the body expression. - ;; Install a continuation delimiter, then evaluate body. - ;; The implementation is target-specific: - ;; - In Scheme: native reset/shift - ;; - In Haskell: Control.Monad.CC or delimited continuations library - ;; - In Python: coroutine/generator-based (see implementation notes) - ;; - In JavaScript: generator-based or CPS transform - ;; - In Rust: CPS transform at compile time - (let ((body (first args))) - (eval-with-delimiter body env)))) - - -;; -------------------------------------------------------------------------- -;; 3. shift — capture the continuation to the nearest reset -;; -------------------------------------------------------------------------- -;; -;; (shift k body) -;; -;; Captures the continuation from this point back to the nearest enclosing -;; reset and binds it to k. Then evaluates body in the current environment -;; extended with k. The result of body becomes the result of the enclosing -;; reset. -;; -;; k is a function of one argument. Calling (k value) resumes the captured -;; computation with value standing in for the shift expression. -;; -;; The continuation k is composable: (k value) returns a value (the result -;; of the reset body when resumed with value). This means k can be called -;; multiple times, and its result can be used in further computation. -;; -;; Examples: -;; -;; ;; Basic: shift provides a value to the surrounding computation -;; (reset (+ 1 (shift k (k 41)))) -;; ;; k = "add 1 to _", (k 41) → 42, reset returns 42 -;; -;; ;; Abort: shift can discard the continuation entirely -;; (reset (+ 1 (shift k "aborted"))) -;; ;; k is never called, reset returns "aborted" -;; -;; ;; Multiple invocations: k can be called more than once -;; (reset (+ 1 (shift k (list (k 10) (k 20))))) -;; ;; (k 10) → 11, (k 20) → 21, reset returns (11 21) -;; -;; ;; Stored for later: k can be saved and invoked outside reset -;; (define saved nil) -;; (reset (+ 1 (shift k (set! saved k) 0))) -;; ;; reset returns 0, saved holds the continuation -;; (saved 99) ;; → 100 -;; -;; -------------------------------------------------------------------------- - -(define sf-shift - (fn ((args :as list) (env :as dict)) - ;; Two arguments: the continuation variable name, and the body. - (let ((k-name (symbol-name (first args))) - (body (second args))) - ;; Capture the current continuation up to the nearest reset. - ;; Bind it to k-name in the environment, then evaluate body. - ;; The result of body is returned to the reset. - (capture-continuation k-name body env)))) - - -;; -------------------------------------------------------------------------- -;; 4. Interaction with other features -;; -------------------------------------------------------------------------- -;; -;; TCO (trampoline): -;; Continuations interact naturally with the trampoline. A shift inside -;; a tail-call position captures the continuation including the pending -;; return. The trampoline resolves thunks before the continuation is -;; delimited. -;; -;; Macros: -;; shift/reset are special forms, not macros. Macros expand before -;; evaluation, so shift inside a macro-expanded form works correctly — -;; it captures the continuation of the expanded code. -;; -;; Components: -;; shift inside a component body captures the continuation of that -;; component's render. The enclosing reset determines the delimiter. -;; This is the foundation for suspendable rendering — a component can -;; shift to suspend, and the server resumes it when data arrives. -;; -;; I/O primitives: -;; I/O primitives execute at invocation time, in whatever context -;; exists then. A continuation that captures a computation containing -;; I/O will re-execute that I/O when invoked. If the I/O requires -;; request context (e.g. current-user), invoking the continuation -;; outside a request will fail — same as calling the I/O directly. -;; This is consistent, not a restriction. -;; -;; In typed targets (Haskell, Rust), the type system can enforce that -;; continuations containing I/O are only invoked in appropriate contexts. -;; In dynamic targets (Python, JS), it fails at runtime. -;; -;; Lexical scope: -;; Continuations capture the dynamic extent (what happens next) but -;; close over the lexical environment at the point of capture. Variable -;; bindings in the continuation refer to the same environment — mutations -;; via set! are visible. -;; -;; -------------------------------------------------------------------------- - - -;; -------------------------------------------------------------------------- -;; 5. Implementation notes per target -;; -------------------------------------------------------------------------- -;; -;; The bootstrapper emits target-specific continuation machinery. -;; The spec defines semantics; each target chooses representation. -;; -;; Scheme / Racket: -;; Native shift/reset. No transformation needed. The bootstrapper -;; emits (require racket/control) or equivalent. -;; -;; Haskell: -;; Control.Monad.CC provides delimited continuations in the CC monad. -;; Alternatively, the evaluator can be CPS-transformed at compile time. -;; Continuations become first-class functions naturally. -;; -;; Python: -;; Generator-based: reset creates a generator, shift yields from it. -;; The trampoline loop drives the generator. Each yield is a shift -;; point, and send() provides the resume value. -;; Alternative: greenlet-based (stackful coroutines). -;; -;; JavaScript: -;; Generator-based (function* / yield). Similar to Python. -;; Alternative: CPS transform at bootstrap time — the bootstrapper -;; rewrites the evaluator into continuation-passing style, making -;; shift/reset explicit function arguments. -;; -;; Rust: -;; CPS transform at compile time. Continuations become enum variants -;; or boxed closures. The type system ensures continuations are used -;; linearly if desired (affine types via ownership). -;; -;; -------------------------------------------------------------------------- - - -;; -------------------------------------------------------------------------- -;; 6. Platform interface — what each target must provide -;; -------------------------------------------------------------------------- -;; -;; (eval-with-delimiter expr env) -;; Install a reset delimiter, evaluate expr, return result. -;; If expr calls shift, the continuation is captured up to here. -;; -;; (capture-continuation k-name body env) -;; Capture the current continuation up to the nearest delimiter. -;; Bind it to k-name in env, evaluate body, return result to delimiter. -;; -;; (make-continuation fn) -;; Wrap a native function as a continuation value. -;; -;; (continuation? x) -;; Type predicate. -;; -;; Continuations must be callable via the standard function-call -;; dispatch in eval-list (same path as lambda calls). -;; -;; -------------------------------------------------------------------------- diff --git a/spec/eval.sx b/spec/eval.sx deleted file mode 100644 index fc5ccfc..0000000 --- a/spec/eval.sx +++ /dev/null @@ -1,846 +0,0 @@ -;; ========================================================================== -;; eval.sx — Reference SX evaluator written in SX -;; -;; This is the canonical specification of SX evaluation semantics. -;; A thin bootstrap compiler per target reads this file and emits -;; a native evaluator (JavaScript, Python, Rust, etc.). -;; -;; The evaluator is written in a restricted subset of SX: -;; - defcomp, define, defmacro, lambda/fn -;; - if, when, cond, case, let, do, and, or -;; - map, filter, reduce, some, every? -;; - Primitives: list ops, string ops, arithmetic, predicates -;; - quote, quasiquote/unquote/splice-unquote -;; - Pattern matching via (case (type-of expr) ...) -;; -;; Platform-specific concerns (DOM rendering, async I/O, HTML emission) -;; are declared as interfaces — each target provides its own adapter. -;; ========================================================================== - - -;; -------------------------------------------------------------------------- -;; 1. Types -;; -------------------------------------------------------------------------- -;; -;; The evaluator operates on these value types: -;; -;; number — integer or float -;; string — double-quoted text -;; boolean — true / false -;; nil — singleton null -;; symbol — unquoted identifier (e.g. div, ~card, map) -;; keyword — colon-prefixed key (e.g. :class, :id) -;; list — ordered sequence (also used as code) -;; dict — string-keyed hash map -;; lambda — closure: {params, body, closure-env, name?} -;; macro — AST transformer: {params, rest-param, body, closure-env} -;; component — UI component: {name, params, has-children, body, closure-env} -;; island — reactive component: like component but with island flag -;; thunk — deferred eval for TCO: {expr, env} -;; -;; Each target must provide: -;; (type-of x) → one of the strings above -;; (make-lambda ...) → platform Lambda value -;; (make-component ..) → platform Component value -;; (make-island ...) → platform Island value (component + island flag) -;; (make-macro ...) → platform Macro value -;; (make-thunk ...) → platform Thunk value -;; -;; These are declared in platform.sx and implemented per target. -;; -------------------------------------------------------------------------- - - -;; -------------------------------------------------------------------------- -;; 2. Trampoline — tail-call optimization -;; -------------------------------------------------------------------------- - -(define trampoline - (fn ((val :as any)) - ;; Iteratively resolve thunks until we get an actual value. - ;; Each target implements thunk? and thunk-expr/thunk-env. - (let ((result val)) - (do - ;; Loop while result is a thunk - ;; Note: this is pseudo-iteration — bootstrap compilers convert - ;; this tail-recursive form to a while loop. - (if (thunk? result) - (trampoline (eval-expr (thunk-expr result) (thunk-env result))) - result))))) - - -;; -------------------------------------------------------------------------- -;; 2b. Strict mode — runtime type checking for primitive calls -;; -------------------------------------------------------------------------- -;; -;; When *strict* is true, primitive calls check arg types before dispatch. -;; The primitive param type registry maps name → {positional [[name type]...], -;; rest-type type-or-nil}. Stored in *prim-param-types* in the env. -;; -;; Strict mode is off by default. Hosts can enable it at startup via: -;; (set-strict! true) -;; (set-prim-param-types! types-dict) - -(define *strict* false) - -(define set-strict! - (fn (val) - (set! *strict* val))) - -(define *prim-param-types* nil) - -(define set-prim-param-types! - (fn (types) - (set! *prim-param-types* types))) - -(define value-matches-type? - (fn (val expected-type) - ;; Check if a runtime value matches a declared type string. - (cond - (= expected-type "any") true - (= expected-type "number") (number? val) - (= expected-type "string") (string? val) - (= expected-type "boolean") (boolean? val) - (= expected-type "nil") (nil? val) - (= expected-type "list") (list? val) - (= expected-type "dict") (dict? val) - (= expected-type "lambda") (lambda? val) - (= expected-type "symbol") (= (type-of val) "symbol") - (= expected-type "keyword") (= (type-of val) "keyword") - ;; Nullable: "string?" means string or nil - (and (string? expected-type) - (ends-with? expected-type "?")) - (or (nil? val) - (value-matches-type? val (slice expected-type 0 (- (string-length expected-type) 1)))) - :else true))) - -(define strict-check-args - (fn (name args) - ;; Check args against *prim-param-types* if strict mode is on. - ;; Throws on type violation. No-op if *strict* is false or types not registered. - (when (and *strict* *prim-param-types*) - (let ((spec (get *prim-param-types* name))) - (when spec - (let ((positional (get spec "positional")) - (rest-type (get spec "rest-type"))) - ;; Check positional params - (when positional - (for-each - (fn (pair) - (let ((idx (first pair)) - (param (nth pair 1)) - (p-name (first param)) - (p-type (nth param 1))) - (when (< idx (len args)) - (let ((val (nth args idx))) - (when (not (value-matches-type? val p-type)) - (error (str "Type error: " name " expected " p-type - " for param " p-name - ", got " (type-of val) " (" (str val) ")"))))))) - (map-indexed (fn (i p) (list i p)) positional))) - ;; Check rest args - (when (and rest-type (> (len args) (len (or positional (list))))) - (for-each - (fn (pair) - (let ((idx (first pair)) - (val (nth pair 1))) - (when (not (value-matches-type? val rest-type)) - (error (str "Type error: " name " expected " rest-type - " for rest arg " idx - ", got " (type-of val) " (" (str val) ")"))))) - (map-indexed (fn (i v) (list i v)) - (slice args (len (or positional (list))))))))))))) - - -;; -------------------------------------------------------------------------- -;; 3. Core evaluator — stub (overridden by CEK in fixups) -;; -------------------------------------------------------------------------- -;; -;; eval-expr and trampoline are defined as stubs here so the transpiler -;; creates the variable declarations. The CEK fixups override them with: -;; eval-expr = (expr, env) → cek-run(make-cek-state(expr, env, [])) -;; trampoline = (val) → if thunk? then eval-expr(thunk-expr, thunk-env) else val -;; All evaluation goes through the CEK machine. - -(define eval-expr - (fn (expr (env :as dict)) - ;; Stub — overridden by CEK fixup before any code runs. - ;; If this executes, CEK fixup failed to load. - (error "eval-expr: CEK fixup not loaded"))) - - -;; [REMOVED] Section 4: Tree-walk eval-list dispatch table — superseded by CEK step-eval-list - - -;; -------------------------------------------------------------------------- -;; 5. Function / lambda / component call -;; -------------------------------------------------------------------------- -;; [REMOVED] eval-call — superseded by CEK continue-with-call - -(define call-lambda - (fn ((f :as lambda) (args :as list) (caller-env :as dict)) - (let ((params (lambda-params f)) - (local (env-merge (lambda-closure f) caller-env))) - ;; Too many args is an error; too few pads with nil - (if (> (len args) (len params)) - (error (str (or (lambda-name f) "lambda") - " expects " (len params) " args, got " (len args))) - (do - ;; Bind params — provided args first, then nil for missing - (for-each - (fn (pair) (env-bind! local (first pair) (nth pair 1))) - (zip params args)) - (for-each - (fn (p) (env-bind! local p nil)) - (slice params (len args))) - ;; Return thunk for TCO - (make-thunk (lambda-body f) local)))))) - - -(define call-component - (fn ((comp :as component) (raw-args :as list) (env :as dict)) - ;; Parse keyword args and children from unevaluated arg list - (let ((parsed (parse-keyword-args raw-args env)) - (kwargs (first parsed)) - (children (nth parsed 1)) - (local (env-merge (component-closure comp) env))) - ;; Bind keyword params - (for-each - (fn (p) (env-bind! local p (or (dict-get kwargs p) nil))) - (component-params comp)) - ;; Bind children if component accepts them - (when (component-has-children? comp) - (env-bind! local "children" children)) - ;; Return thunk — body evaluated in local env - (make-thunk (component-body comp) local)))) - - -(define parse-keyword-args - (fn ((raw-args :as list) (env :as dict)) - ;; Walk args: keyword + next-val → kwargs dict, else → children list - (let ((kwargs (dict)) - (children (list)) - (i 0)) - ;; Iterative parse — bootstrap converts to while loop - (reduce - (fn (state arg) - (let ((idx (get state "i")) - (skip (get state "skip"))) - (if skip - ;; This arg was consumed as a keyword value - (assoc state "skip" false "i" (inc idx)) - (if (and (= (type-of arg) "keyword") - (< (inc idx) (len raw-args))) - ;; Keyword: evaluate next arg and store - (do - (dict-set! kwargs (keyword-name arg) - (trampoline (eval-expr (nth raw-args (inc idx)) env))) - (assoc state "skip" true "i" (inc idx))) - ;; Positional: evaluate and add to children - (do - (append! children (trampoline (eval-expr arg env))) - (assoc state "i" (inc idx))))))) - (dict "i" 0 "skip" false) - raw-args) - (list kwargs children)))) - - -;; -------------------------------------------------------------------------- -;; 6. Special forms -;; -------------------------------------------------------------------------- -;; [REMOVED] sf-if, sf-when, sf-cond, sf-case, sf-and, sf-or, sf-let -;; — all superseded by CEK step handlers in cek.sx - - -;; cond-scheme? — still needed by CEK's step-sf-cond -(define cond-scheme? - (fn ((clauses :as list)) - (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2))) - clauses))) - - -;; Named let: (let name ((x 0) (y 1)) body...) -;; Desugars to a self-recursive lambda called with initial values. -;; The loop name is bound in the body so recursive calls produce TCO thunks. -(define sf-named-let - (fn ((args :as list) (env :as dict)) - (let ((loop-name (symbol-name (first args))) - (bindings (nth args 1)) - (body (slice args 2)) - (params (list)) - (inits (list))) - ;; Extract param names and init expressions - (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - ;; Scheme-style: ((x 0) (y 1)) - (for-each - (fn (binding) - (append! params (if (= (type-of (first binding)) "symbol") - (symbol-name (first binding)) - (first binding))) - (append! inits (nth binding 1))) - bindings) - ;; Clojure-style: (x 0 y 1) - (reduce - (fn (acc pair-idx) - (do - (append! params (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") - (symbol-name (nth bindings (* pair-idx 2))) - (nth bindings (* pair-idx 2)))) - (append! inits (nth bindings (inc (* pair-idx 2)))))) - nil - (range 0 (/ (len bindings) 2)))) - ;; Build loop body (wrap in begin if multiple exprs) - (let ((loop-body (if (= (len body) 1) (first body) - (cons (make-symbol "begin") body))) - (loop-fn (make-lambda params loop-body env))) - ;; Self-reference: loop can call itself by name - (set-lambda-name! loop-fn loop-name) - (env-bind! (lambda-closure loop-fn) loop-name loop-fn) - ;; Evaluate initial values in enclosing env, then call - (let ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits))) - (call-lambda loop-fn init-vals env)))))) - - -(define sf-lambda - (fn ((args :as list) (env :as dict)) - (let ((params-expr (first args)) - (body-exprs (rest args)) - (body (if (= (len body-exprs) 1) - (first body-exprs) - (cons (make-symbol "begin") body-exprs))) - (param-names (map (fn (p) - (cond - (= (type-of p) "symbol") - (symbol-name p) - ;; Annotated param: (name :as type) → extract name - (and (= (type-of p) "list") - (= (len p) 3) - (= (type-of (nth p 1)) "keyword") - (= (keyword-name (nth p 1)) "as")) - (symbol-name (first p)) - :else p)) - params-expr))) - (make-lambda param-names body env)))) - - -(define sf-defcomp - (fn ((args :as list) (env :as dict)) - ;; (defcomp ~name (params) [:affinity :client|:server] body) - ;; Body is always the last element. Optional keyword annotations - ;; may appear between the params list and the body. - (let ((name-sym (first args)) - (params-raw (nth args 1)) - (body (last args)) - (comp-name (strip-prefix (symbol-name name-sym) "~")) - (parsed (parse-comp-params params-raw)) - (params (first parsed)) - (has-children (nth parsed 1)) - (param-types (nth parsed 2)) - (affinity (defcomp-kwarg args "affinity" "auto"))) - (let ((comp (make-component comp-name params has-children body env affinity)) - (effects (defcomp-kwarg args "effects" nil))) - ;; Store type annotations if any were declared - (when (and (not (nil? param-types)) - (not (empty? (keys param-types)))) - (component-set-param-types! comp param-types)) - ;; Store effect annotation if declared - (when (not (nil? effects)) - (let ((effect-list (if (= (type-of effects) "list") - (map (fn (e) (if (= (type-of e) "symbol") - (symbol-name e) (str e))) - effects) - (list (str effects)))) - (effect-anns (if (env-has? env "*effect-annotations*") - (env-get env "*effect-annotations*") - (dict)))) - (dict-set! effect-anns (symbol-name name-sym) effect-list) - (env-bind! env "*effect-annotations*" effect-anns))) - (env-bind! env (symbol-name name-sym) comp) - comp)))) - -(define defcomp-kwarg - (fn ((args :as list) (key :as string) default) - ;; Search for :key value between params (index 2) and body (last). - (let ((end (- (len args) 1)) - (result default)) - (for-each - (fn (i) - (when (and (= (type-of (nth args i)) "keyword") - (= (keyword-name (nth args i)) key) - (< (+ i 1) end)) - (let ((val (nth args (+ i 1)))) - (set! result (if (= (type-of val) "keyword") - (keyword-name val) val))))) - (range 2 end 1)) - result))) - -(define parse-comp-params - (fn ((params-expr :as list)) - ;; Parse (&key param1 param2 &children) → (params has-children param-types) - ;; Also accepts &rest as synonym for &children. - ;; Supports typed params: (name :as type) — a 3-element list where - ;; the second element is the keyword :as. Unannotated params get no - ;; type entry. param-types is a dict {name → type-expr} or empty dict. - (let ((params (list)) - (param-types (dict)) - (has-children false) - (in-key false)) - (for-each - (fn (p) - (if (and (= (type-of p) "list") - (= (len p) 3) - (= (type-of (first p)) "symbol") - (= (type-of (nth p 1)) "keyword") - (= (keyword-name (nth p 1)) "as")) - ;; Typed param: (name :as type) - (let ((name (symbol-name (first p))) - (ptype (nth p 2))) - ;; Convert type to string if it's a symbol - (let ((type-val (if (= (type-of ptype) "symbol") - (symbol-name ptype) - ptype))) - (when (not has-children) - (append! params name) - (dict-set! param-types name type-val)))) - ;; Untyped param or marker - (when (= (type-of p) "symbol") - (let ((name (symbol-name p))) - (cond - (= name "&key") (set! in-key true) - (= name "&rest") (set! has-children true) - (= name "&children") (set! has-children true) - has-children nil ;; skip params after &children/&rest - in-key (append! params name) - :else (append! params name)))))) - params-expr) - (list params has-children param-types)))) - - -(define sf-defisland - (fn ((args :as list) (env :as dict)) - ;; (defisland ~name (params) body) - ;; Like defcomp but creates an island (reactive component). - ;; Islands have the same calling convention as components but - ;; render with a reactive context on the client. - (let ((name-sym (first args)) - (params-raw (nth args 1)) - (body (last args)) - (comp-name (strip-prefix (symbol-name name-sym) "~")) - (parsed (parse-comp-params params-raw)) - (params (first parsed)) - (has-children (nth parsed 1))) - (let ((island (make-island comp-name params has-children body env))) - (env-bind! env (symbol-name name-sym) island) - island)))) - - -(define sf-defmacro - (fn ((args :as list) (env :as dict)) - (let ((name-sym (first args)) - (params-raw (nth args 1)) - (body (nth args 2)) - (parsed (parse-macro-params params-raw)) - (params (first parsed)) - (rest-param (nth parsed 1))) - (let ((mac (make-macro params rest-param body env (symbol-name name-sym)))) - (env-bind! env (symbol-name name-sym) mac) - mac)))) - -(define parse-macro-params - (fn ((params-expr :as list)) - ;; Parse (a b &rest rest) → ((a b) rest) - (let ((params (list)) - (rest-param nil)) - (reduce - (fn (state p) - (if (and (= (type-of p) "symbol") (= (symbol-name p) "&rest")) - (assoc state "in-rest" true) - (if (get state "in-rest") - (do (set! rest-param (if (= (type-of p) "symbol") - (symbol-name p) p)) - state) - (do (append! params (if (= (type-of p) "symbol") - (symbol-name p) p)) - state)))) - (dict "in-rest" false) - params-expr) - (list params rest-param)))) - - -(define sf-defstyle - (fn ((args :as list) (env :as dict)) - ;; (defstyle name expr) — bind name to evaluated expr (string, function, etc.) - (let ((name-sym (first args)) - (value (trampoline (eval-expr (nth args 1) env)))) - (env-bind! env (symbol-name name-sym) value) - value))) - - -;; -- deftype helpers (must be in eval.sx, not types.sx, because -;; sf-deftype is always compiled but types.sx is a spec module) -- - -(define make-type-def - (fn ((name :as string) (params :as list) body) - {:name name :params params :body body})) - -(define normalize-type-body - (fn (body) - ;; Convert AST type expressions to type representation. - ;; Symbols → strings, (union ...) → (or ...), dict keys → strings. - (cond - (nil? body) "nil" - (= (type-of body) "symbol") - (symbol-name body) - (= (type-of body) "string") - body - (= (type-of body) "keyword") - (keyword-name body) - (= (type-of body) "dict") - ;; Record type — normalize values - (map-dict (fn (k v) (normalize-type-body v)) body) - (= (type-of body) "list") - (if (empty? body) "any" - (let ((head (first body))) - (let ((head-name (if (= (type-of head) "symbol") - (symbol-name head) (str head)))) - ;; (union a b) → (or a b) - (if (= head-name "union") - (cons "or" (map normalize-type-body (rest body))) - ;; (or a b), (list-of t), (-> ...) etc. - (cons head-name (map normalize-type-body (rest body))))))) - :else (str body)))) - -(define sf-deftype - (fn ((args :as list) (env :as dict)) - ;; (deftype name body) or (deftype (name a b ...) body) - (let ((name-or-form (first args)) - (body-expr (nth args 1)) - (type-name nil) - (type-params (list))) - ;; Parse name — symbol or (symbol params...) - (if (= (type-of name-or-form) "symbol") - (set! type-name (symbol-name name-or-form)) - (when (= (type-of name-or-form) "list") - (set! type-name (symbol-name (first name-or-form))) - (set! type-params - (map (fn (p) (if (= (type-of p) "symbol") - (symbol-name p) (str p))) - (rest name-or-form))))) - ;; Normalize and store in *type-registry* - (let ((body (normalize-type-body body-expr)) - (registry (if (env-has? env "*type-registry*") - (env-get env "*type-registry*") - (dict)))) - (dict-set! registry type-name - (make-type-def type-name type-params body)) - (env-bind! env "*type-registry*" registry) - nil)))) - - -(define sf-defeffect - (fn ((args :as list) (env :as dict)) - ;; (defeffect name) — register an effect name - (let ((effect-name (if (= (type-of (first args)) "symbol") - (symbol-name (first args)) - (str (first args)))) - (registry (if (env-has? env "*effect-registry*") - (env-get env "*effect-registry*") - (list)))) - (when (not (contains? registry effect-name)) - (append! registry effect-name)) - (env-bind! env "*effect-registry*" registry) - nil))) - - -(define qq-expand - (fn (template (env :as dict)) - (if (not (= (type-of template) "list")) - template - (if (empty? template) - (list) - (let ((head (first template))) - (if (and (= (type-of head) "symbol") (= (symbol-name head) "unquote")) - (trampoline (eval-expr (nth template 1) env)) - ;; Walk children, handling splice-unquote - (reduce - (fn (result item) - (if (and (= (type-of item) "list") - (= (len item) 2) - (= (type-of (first item)) "symbol") - (= (symbol-name (first item)) "splice-unquote")) - (let ((spliced (trampoline (eval-expr (nth item 1) env)))) - (if (= (type-of spliced) "list") - (concat result spliced) - (if (nil? spliced) result (concat result (list spliced))))) - (concat result (list (qq-expand item env))))) - (list) - template))))))) - - -;; -------------------------------------------------------------------------- -;; 6c. letrec — mutually recursive local bindings -;; -------------------------------------------------------------------------- -;; -;; (letrec ((even? (fn (n) (if (= n 0) true (odd? (- n 1))))) -;; (odd? (fn (n) (if (= n 0) false (even? (- n 1)))))) -;; (even? 10)) -;; -;; All bindings are first set to nil in the local env, then all values -;; are evaluated (so they can see each other's names), then lambda -;; closures are patched to include the final bindings. -;; -------------------------------------------------------------------------- - -(define sf-letrec - (fn ((args :as list) (env :as dict)) - (let ((bindings (first args)) - (body (rest args)) - (local (env-extend env)) - (names (list)) - (val-exprs (list))) - ;; First pass: bind all names to nil - (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - ;; Scheme-style - (for-each - (fn (binding) - (let ((vname (if (= (type-of (first binding)) "symbol") - (symbol-name (first binding)) - (first binding)))) - (append! names vname) - (append! val-exprs (nth binding 1)) - (env-bind! local vname nil))) - bindings) - ;; Clojure-style - (reduce - (fn (acc pair-idx) - (let ((vname (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") - (symbol-name (nth bindings (* pair-idx 2))) - (nth bindings (* pair-idx 2)))) - (val-expr (nth bindings (inc (* pair-idx 2))))) - (append! names vname) - (append! val-exprs val-expr) - (env-bind! local vname nil))) - nil - (range 0 (/ (len bindings) 2)))) - ;; Second pass: evaluate values (they can see each other's names) - (let ((values (map (fn (e) (trampoline (eval-expr e local))) val-exprs))) - ;; Bind final values - (for-each - (fn (pair) (env-bind! local (first pair) (nth pair 1))) - (zip names values)) - ;; Patch lambda closures so they see the final bindings - (for-each - (fn (val) - (when (lambda? val) - (for-each - (fn (n) (env-bind! (lambda-closure val) n (env-get local n))) - names))) - values)) - ;; Evaluate body - (for-each - (fn (e) (trampoline (eval-expr e local))) - (slice body 0 (dec (len body)))) - (make-thunk (last body) local)))) - - -;; -------------------------------------------------------------------------- -;; 6d. dynamic-wind — entry/exit guards -;; -------------------------------------------------------------------------- -;; -;; (dynamic-wind before-thunk body-thunk after-thunk) -;; -;; All three are zero-argument functions (thunks): -;; 1. Call before-thunk -;; 2. Call body-thunk, capture result -;; 3. Call after-thunk (always, even on error) -;; 4. Return body result -;; -;; The wind stack is maintained so that when continuations jump across -;; dynamic-wind boundaries, the correct before/after thunks fire. -;; Without active continuations, this is equivalent to try/finally. -;; -;; Platform requirements: -;; (push-wind! before after) — push wind record onto stack -;; (pop-wind!) — pop wind record from stack -;; (call-thunk f env) — call a zero-arg function -;; -------------------------------------------------------------------------- - -(define sf-dynamic-wind - (fn ((args :as list) (env :as dict)) - (let ((before (trampoline (eval-expr (first args) env))) - (body (trampoline (eval-expr (nth args 1) env))) - (after (trampoline (eval-expr (nth args 2) env)))) - ;; Delegate to platform — needs try/finally for error safety - (dynamic-wind-call before body after env)))) - - -;; -------------------------------------------------------------------------- -;; 6a2. scope — unified render-time dynamic scope primitive -;; -------------------------------------------------------------------------- -;; -;; (scope name body...) or (scope name :value v body...) -;; Push a named scope with optional value and empty accumulator, -;; evaluate body, pop scope. Returns last body result. -;; -;; `provide` is sugar: (provide name value body...) = (scope name :value value body...) - -(define sf-scope - (fn ((args :as list) (env :as dict)) - (let ((name (trampoline (eval-expr (first args) env))) - (rest (slice args 1)) - (val nil) - (body-exprs nil)) - ;; Check for :value keyword - (if (and (>= (len rest) 2) (= (type-of (first rest)) "keyword") (= (keyword-name (first rest)) "value")) - (do (set! val (trampoline (eval-expr (nth rest 1) env))) - (set! body-exprs (slice rest 2))) - (set! body-exprs rest)) - (scope-push! name val) - (let ((result nil)) - (for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs) - (scope-pop! name) - result)))) - - -;; provide — sugar for scope with a value -;; (provide name value body...) → (scope name :value value body...) - -(define sf-provide - (fn ((args :as list) (env :as dict)) - (let ((name (trampoline (eval-expr (first args) env))) - (val (trampoline (eval-expr (nth args 1) env))) - (body-exprs (slice args 2)) - (result nil)) - (scope-push! name val) - (for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs) - (scope-pop! name) - result))) - - -;; -------------------------------------------------------------------------- -;; 6b. Macro expansion -;; -------------------------------------------------------------------------- - -(define expand-macro - (fn ((mac :as macro) (raw-args :as list) (env :as dict)) - (let ((local (env-merge (macro-closure mac) env))) - ;; Bind positional params (unevaluated) - (for-each - (fn (pair) - (env-bind! local (first pair) - (if (< (nth pair 1) (len raw-args)) - (nth raw-args (nth pair 1)) - nil))) - (map-indexed (fn (i p) (list p i)) (macro-params mac))) - ;; Bind &rest param - (when (macro-rest-param mac) - (env-bind! local (macro-rest-param mac) - (slice raw-args (len (macro-params mac))))) - ;; Evaluate body → new AST - (trampoline (eval-expr (macro-body mac) local))))) - - -;; [REMOVED] Section 7: Tree-walk HO forms — superseded by CEK step-ho-* in cek.sx - -;; -------------------------------------------------------------------------- -;; 8. Primitives — pure functions available in all targets -;; -------------------------------------------------------------------------- -;; These are the ~80 built-in functions. Each target implements them -;; natively but they MUST have identical semantics. This section serves -;; as the specification — bootstrap compilers use it for reference. -;; -;; Primitives are NOT defined here as SX lambdas (that would be circular). -;; Instead, this is a declarative registry that bootstrap compilers read. -;; -------------------------------------------------------------------------- - -;; See primitives.sx for the full specification. - - -;; -------------------------------------------------------------------------- -;; 9. Platform interface — must be provided by each target -;; -------------------------------------------------------------------------- -;; -;; Type inspection: -;; (type-of x) → "number" | "string" | "boolean" | "nil" -;; | "symbol" | "keyword" | "list" | "dict" -;; | "lambda" | "component" | "macro" | "thunk" -;; | "spread" -;; (symbol-name sym) → string -;; (keyword-name kw) → string -;; -;; Constructors: -;; (make-lambda params body env) → Lambda -;; (make-component name params has-children body env affinity) → Component -;; (make-macro params rest-param body env name) → Macro -;; (make-thunk expr env) → Thunk -;; -;; Accessors: -;; (lambda-params f) → list of strings -;; (lambda-body f) → expr -;; (lambda-closure f) → env -;; (lambda-name f) → string or nil -;; (set-lambda-name! f n) → void -;; (component-params c) → list of strings -;; (component-body c) → expr -;; (component-closure c) → env -;; (component-has-children? c) → boolean -;; (component-affinity c) → "auto" | "client" | "server" -;; -;; (make-island name params has-children body env) → Island -;; (island? x) → boolean -;; ;; Islands reuse component accessors: component-params, component-body, etc. -;; -;; (make-spread attrs) → Spread (attrs dict injected onto parent element) -;; (spread? x) → boolean -;; (spread-attrs s) → dict -;; -;; (macro-params m) → list of strings -;; (macro-rest-param m) → string or nil -;; (macro-body m) → expr -;; (macro-closure m) → env -;; (thunk? x) → boolean -;; (thunk-expr t) → expr -;; (thunk-env t) → env -;; -;; Predicates: -;; (callable? x) → boolean (native function or lambda) -;; (lambda? x) → boolean -;; (component? x) → boolean -;; (island? x) → boolean -;; (macro? x) → boolean -;; (primitive? name) → boolean (is name a registered primitive?) -;; (get-primitive name) → function -;; -;; Environment: -;; (env-has? env name) → boolean -;; (env-get env name) → value -;; (env-bind! env name val) → void (create binding on THIS env, no chain walk) -;; (env-set! env name val) → void (mutate existing binding, walks scope chain) -;; (env-extend env) → new env inheriting from env -;; (env-merge base overlay) → new env with overlay on top -;; -;; Mutation helpers (for parse-keyword-args): -;; (dict-set! d key val) → void -;; (dict-get d key) → value or nil -;; (append! lst val) → void (mutating append) -;; -;; Error: -;; (error msg) → raise/throw with message -;; (inspect x) → string representation for debugging -;; -;; Utility: -;; (strip-prefix s prefix) → string with prefix removed (or s unchanged) -;; (apply f args) → call f with args list -;; (zip lists...) → list of tuples -;; -;; -;; Dynamic wind (for dynamic-wind): -;; (push-wind! before after) → void (push wind record onto stack) -;; (pop-wind!) → void (pop wind record from stack) -;; (call-thunk f env) → value (call a zero-arg function) -;; -;; Render-time accumulators: -;; (collect! bucket value) → void (add to named bucket, deduplicated) -;; (collected bucket) → list (all values in bucket) -;; (clear-collected! bucket) → void (empty the bucket) -;; -------------------------------------------------------------------------- diff --git a/spec/cek.sx b/spec/evaluator.sx similarity index 53% rename from spec/cek.sx rename to spec/evaluator.sx index 3f152ff..3515576 100644 --- a/spec/cek.sx +++ b/spec/evaluator.sx @@ -1,17 +1,1104 @@ ;; ========================================================================== -;; cek.sx — Explicit CEK machine evaluator +;; evaluator.sx — The SX evaluator specification ;; -;; Replaces the implicit CEK (tree-walk + trampoline) with explicit -;; C/E/K data structures. Each evaluation step is a pure function from -;; state to state. Enables stepping, serialization, migration. +;; This is the canonical, single-file specification of SX evaluation. +;; All evaluation goes through the CEK machine (explicit control, +;; environment, and continuation). There is no tree-walk interpreter. ;; -;; The CEK uses the frame types defined in frames.sx. -;; eval-expr remains as the public API — it creates a CEK state and runs. +;; Structure: +;; Part 1: CEK frames — state and continuation frame constructors +;; Part 2: Evaluation utilities — lambda/component call, keyword arg +;; parsing, macro expansion, quasiquote, definition forms +;; Part 3: CEK machine — step function, frame dispatch, call dispatch ;; -;; Requires: frames.sx loaded first. +;; The evaluator is written in a restricted subset of SX that bootstrap +;; compilers (JS, Python) can transpile to native code. +;; +;; Platform interface (must be provided by each host): +;; See Part 2 section headers for type constructors, env operations, +;; and rendering primitives. ;; ========================================================================== +;; ************************************************************************** +;; Part 1: CEK Frames — state, continuation, and frame constructors +;; ************************************************************************** + +;; -------------------------------------------------------------------------- +;; 1. CEK State constructors +;; -------------------------------------------------------------------------- + +(define make-cek-state + (fn (control env kont) + {:control control :env env :kont kont :phase "eval" :value nil})) + +(define make-cek-value + (fn (value env kont) + {:control nil :env env :kont kont :phase "continue" :value value})) + +(define cek-terminal? + (fn (state) + (and (= (get state "phase") "continue") + (empty? (get state "kont"))))) + +(define cek-control (fn (s) (get s "control"))) +(define cek-env (fn (s) (get s "env"))) +(define cek-kont (fn (s) (get s "kont"))) +(define cek-phase (fn (s) (get s "phase"))) +(define cek-value (fn (s) (get s "value"))) + + +;; -------------------------------------------------------------------------- +;; 2. Frame constructors +;; -------------------------------------------------------------------------- +;; Each frame type is a dict with a "type" key and frame-specific data. + +;; IfFrame: waiting for condition value +;; After condition evaluates, choose then or else branch +(define make-if-frame + (fn (then-expr else-expr env) + {:type "if" :then then-expr :else else-expr :env env})) + +;; WhenFrame: waiting for condition value +;; If truthy, evaluate body exprs sequentially +(define make-when-frame + (fn (body-exprs env) + {:type "when" :body body-exprs :env env})) + +;; BeginFrame: sequential evaluation +;; Remaining expressions to evaluate after current one +(define make-begin-frame + (fn (remaining env) + {:type "begin" :remaining remaining :env env})) + +;; LetFrame: binding evaluation in progress +;; name = current binding name, remaining = remaining (name val) pairs +;; body = body expressions to evaluate after all bindings +(define make-let-frame + (fn (name remaining body local) + {:type "let" :name name :remaining remaining :body body :env local})) + +;; DefineFrame: waiting for value to bind +(define make-define-frame + (fn (name env has-effects effect-list) + {:type "define" :name name :env env + :has-effects has-effects :effect-list effect-list})) + +;; SetFrame: waiting for value to assign +(define make-set-frame + (fn (name env) + {:type "set" :name name :env env})) + +;; ArgFrame: evaluating function arguments +;; f = function value (already evaluated), evaled = already evaluated args +;; remaining = remaining arg expressions +(define make-arg-frame + (fn (f evaled remaining env raw-args head-name) + {:type "arg" :f f :evaled evaled :remaining remaining :env env + :raw-args raw-args :head-name (or head-name nil)})) + +;; CallFrame: about to call with fully evaluated args +(define make-call-frame + (fn (f args env) + {:type "call" :f f :args args :env env})) + +;; CondFrame: evaluating cond clauses +(define make-cond-frame + (fn (remaining env scheme?) + {:type "cond" :remaining remaining :env env :scheme scheme?})) + +;; CaseFrame: evaluating case clauses +(define make-case-frame + (fn (match-val remaining env) + {:type "case" :match-val match-val :remaining remaining :env env})) + +;; ThreadFirstFrame: pipe threading +(define make-thread-frame + (fn (remaining env) + {:type "thread" :remaining remaining :env env})) + +;; MapFrame: higher-order map/map-indexed in progress +(define make-map-frame + (fn (f remaining results env) + {:type "map" :f f :remaining remaining :results results :env env :indexed false})) + +(define make-map-indexed-frame + (fn (f remaining results env) + {:type "map" :f f :remaining remaining :results results :env env :indexed true})) + +;; FilterFrame: higher-order filter in progress +(define make-filter-frame + (fn (f remaining results current-item env) + {:type "filter" :f f :remaining remaining :results results + :current-item current-item :env env})) + +;; ReduceFrame: higher-order reduce in progress +(define make-reduce-frame + (fn (f remaining env) + {:type "reduce" :f f :remaining remaining :env env})) + +;; ForEachFrame: higher-order for-each in progress +(define make-for-each-frame + (fn (f remaining env) + {:type "for-each" :f f :remaining remaining :env env})) + +;; SomeFrame: higher-order some (short-circuit on first truthy) +(define make-some-frame + (fn (f remaining env) + {:type "some" :f f :remaining remaining :env env})) + +;; EveryFrame: higher-order every? (short-circuit on first falsy) +(define make-every-frame + (fn (f remaining env) + {:type "every" :f f :remaining remaining :env env})) + +;; ScopeFrame: scope-pop! when frame pops +(define make-scope-frame + (fn (name remaining env) + {:type "scope" :name name :remaining remaining :env env})) + +;; ResetFrame: delimiter for shift/reset continuations +(define make-reset-frame + (fn (env) + {:type "reset" :env env})) + +;; DictFrame: evaluating dict values +(define make-dict-frame + (fn (remaining results env) + {:type "dict" :remaining remaining :results results :env env})) + +;; AndFrame: short-circuit and +(define make-and-frame + (fn (remaining env) + {:type "and" :remaining remaining :env env})) + +;; OrFrame: short-circuit or +(define make-or-frame + (fn (remaining env) + {:type "or" :remaining remaining :env env})) + +;; QuasiquoteFrame (not a real frame — QQ is handled specially) + +;; DynamicWindFrame: phases of dynamic-wind +(define make-dynamic-wind-frame + (fn (phase body-thunk after-thunk env) + {:type "dynamic-wind" :phase phase + :body-thunk body-thunk :after-thunk after-thunk :env env})) + +;; ReactiveResetFrame: delimiter for reactive deref-as-shift +;; Carries an update-fn that gets called with new values on re-render. +(define make-reactive-reset-frame + (fn (env update-fn first-render?) + {:type "reactive-reset" :env env :update-fn update-fn + :first-render first-render?})) + +;; DerefFrame: awaiting evaluation of deref's argument +(define make-deref-frame + (fn (env) + {:type "deref" :env env})) + + +;; -------------------------------------------------------------------------- +;; 3. Frame accessors +;; -------------------------------------------------------------------------- + +(define frame-type (fn (f) (get f "type"))) + + +;; -------------------------------------------------------------------------- +;; 4. Continuation operations +;; -------------------------------------------------------------------------- + +(define kont-push + (fn (frame kont) (cons frame kont))) + +(define kont-top + (fn (kont) (first kont))) + +(define kont-pop + (fn (kont) (rest kont))) + +(define kont-empty? + (fn (kont) (empty? kont))) + + +;; -------------------------------------------------------------------------- +;; 5. CEK shift/reset support +;; -------------------------------------------------------------------------- +;; shift captures all frames up to the nearest ResetFrame. +;; reset pushes a ResetFrame. + +(define kont-capture-to-reset + (fn (kont) + ;; Returns (captured-frames remaining-kont). + ;; captured-frames: frames from top up to (not including) ResetFrame. + ;; remaining-kont: frames after ResetFrame. + ;; Stops at either "reset" or "reactive-reset" frames. + (define scan + (fn (k captured) + (if (empty? k) + (error "shift without enclosing reset") + (let ((frame (first k))) + (if (or (= (frame-type frame) "reset") + (= (frame-type frame) "reactive-reset")) + (list captured (rest k)) + (scan (rest k) (append captured (list frame)))))))) + (scan kont (list)))) + +;; Check if a ReactiveResetFrame exists anywhere in the continuation +(define has-reactive-reset-frame? + (fn (kont) + (if (empty? kont) false + (if (= (frame-type (first kont)) "reactive-reset") true + (has-reactive-reset-frame? (rest kont)))))) + +;; Capture frames up to nearest ReactiveResetFrame. +;; Returns (captured-frames, reset-frame, remaining-kont). +(define kont-capture-to-reactive-reset + (fn (kont) + (define scan + (fn (k captured) + (if (empty? k) + (error "reactive deref without enclosing reactive-reset") + (let ((frame (first k))) + (if (= (frame-type frame) "reactive-reset") + (list captured frame (rest k)) + (scan (rest k) (append captured (list frame)))))))) + (scan kont (list)))) + + +;; ************************************************************************** +;; Part 2: Evaluation Utilities +;; ************************************************************************** + +;; -------------------------------------------------------------------------- +;; 1. Types +;; -------------------------------------------------------------------------- +;; +;; The evaluator operates on these value types: +;; +;; number — integer or float +;; string — double-quoted text +;; boolean — true / false +;; nil — singleton null +;; symbol — unquoted identifier (e.g. div, ~card, map) +;; keyword — colon-prefixed key (e.g. :class, :id) +;; list — ordered sequence (also used as code) +;; dict — string-keyed hash map +;; lambda — closure: {params, body, closure-env, name?} +;; macro — AST transformer: {params, rest-param, body, closure-env} +;; component — UI component: {name, params, has-children, body, closure-env} +;; island — reactive component: like component but with island flag +;; thunk — deferred eval for TCO: {expr, env} +;; +;; Each target must provide: +;; (type-of x) → one of the strings above +;; (make-lambda ...) → platform Lambda value +;; (make-component ..) → platform Component value +;; (make-island ...) → platform Island value (component + island flag) +;; (make-macro ...) → platform Macro value +;; (make-thunk ...) → platform Thunk value +;; +;; These are declared in platform.sx and implemented per target. +;; -------------------------------------------------------------------------- + + +;; -------------------------------------------------------------------------- +;; 2. Trampoline — tail-call optimization +;; -------------------------------------------------------------------------- + +(define trampoline + (fn ((val :as any)) + ;; Iteratively resolve thunks until we get an actual value. + ;; Each target implements thunk? and thunk-expr/thunk-env. + (let ((result val)) + (do + ;; Loop while result is a thunk + ;; Note: this is pseudo-iteration — bootstrap compilers convert + ;; this tail-recursive form to a while loop. + (if (thunk? result) + (trampoline (eval-expr (thunk-expr result) (thunk-env result))) + result))))) + + +;; -------------------------------------------------------------------------- +;; 2b. Strict mode — runtime type checking for primitive calls +;; -------------------------------------------------------------------------- +;; +;; When *strict* is true, primitive calls check arg types before dispatch. +;; The primitive param type registry maps name → {positional [[name type]...], +;; rest-type type-or-nil}. Stored in *prim-param-types* in the env. +;; +;; Strict mode is off by default. Hosts can enable it at startup via: +;; (set-strict! true) +;; (set-prim-param-types! types-dict) + +(define *strict* false) + +(define set-strict! + (fn (val) + (set! *strict* val))) + +(define *prim-param-types* nil) + +(define set-prim-param-types! + (fn (types) + (set! *prim-param-types* types))) + +(define value-matches-type? + (fn (val expected-type) + ;; Check if a runtime value matches a declared type string. + (cond + (= expected-type "any") true + (= expected-type "number") (number? val) + (= expected-type "string") (string? val) + (= expected-type "boolean") (boolean? val) + (= expected-type "nil") (nil? val) + (= expected-type "list") (list? val) + (= expected-type "dict") (dict? val) + (= expected-type "lambda") (lambda? val) + (= expected-type "symbol") (= (type-of val) "symbol") + (= expected-type "keyword") (= (type-of val) "keyword") + ;; Nullable: "string?" means string or nil + (and (string? expected-type) + (ends-with? expected-type "?")) + (or (nil? val) + (value-matches-type? val (slice expected-type 0 (- (string-length expected-type) 1)))) + :else true))) + +(define strict-check-args + (fn (name args) + ;; Check args against *prim-param-types* if strict mode is on. + ;; Throws on type violation. No-op if *strict* is false or types not registered. + (when (and *strict* *prim-param-types*) + (let ((spec (get *prim-param-types* name))) + (when spec + (let ((positional (get spec "positional")) + (rest-type (get spec "rest-type"))) + ;; Check positional params + (when positional + (for-each + (fn (pair) + (let ((idx (first pair)) + (param (nth pair 1)) + (p-name (first param)) + (p-type (nth param 1))) + (when (< idx (len args)) + (let ((val (nth args idx))) + (when (not (value-matches-type? val p-type)) + (error (str "Type error: " name " expected " p-type + " for param " p-name + ", got " (type-of val) " (" (str val) ")"))))))) + (map-indexed (fn (i p) (list i p)) positional))) + ;; Check rest args + (when (and rest-type (> (len args) (len (or positional (list))))) + (for-each + (fn (pair) + (let ((idx (first pair)) + (val (nth pair 1))) + (when (not (value-matches-type? val rest-type)) + (error (str "Type error: " name " expected " rest-type + " for rest arg " idx + ", got " (type-of val) " (" (str val) ")"))))) + (map-indexed (fn (i v) (list i v)) + (slice args (len (or positional (list))))))))))))) + + +;; -------------------------------------------------------------------------- +;; 3. Core evaluator — stub (overridden by CEK in fixups) +;; -------------------------------------------------------------------------- +;; +;; eval-expr and trampoline are defined as stubs here so the transpiler +;; creates the variable declarations. The CEK fixups override them with: +;; eval-expr = (expr, env) → cek-run(make-cek-state(expr, env, [])) +;; trampoline = (val) → if thunk? then eval-expr(thunk-expr, thunk-env) else val +;; All evaluation goes through the CEK machine. + +(define eval-expr + (fn (expr (env :as dict)) + ;; Stub — overridden by CEK fixup before any code runs. + ;; If this executes, CEK fixup failed to load. + (error "eval-expr: CEK fixup not loaded"))) + + + + +;; -------------------------------------------------------------------------- +;; 5. Function / lambda / component call +;; -------------------------------------------------------------------------- + +(define call-lambda + (fn ((f :as lambda) (args :as list) (caller-env :as dict)) + (let ((params (lambda-params f)) + (local (env-merge (lambda-closure f) caller-env))) + ;; Too many args is an error; too few pads with nil + (if (> (len args) (len params)) + (error (str (or (lambda-name f) "lambda") + " expects " (len params) " args, got " (len args))) + (do + ;; Bind params — provided args first, then nil for missing + (for-each + (fn (pair) (env-bind! local (first pair) (nth pair 1))) + (zip params args)) + (for-each + (fn (p) (env-bind! local p nil)) + (slice params (len args))) + ;; Return thunk for TCO + (make-thunk (lambda-body f) local)))))) + + +(define call-component + (fn ((comp :as component) (raw-args :as list) (env :as dict)) + ;; Parse keyword args and children from unevaluated arg list + (let ((parsed (parse-keyword-args raw-args env)) + (kwargs (first parsed)) + (children (nth parsed 1)) + (local (env-merge (component-closure comp) env))) + ;; Bind keyword params + (for-each + (fn (p) (env-bind! local p (or (dict-get kwargs p) nil))) + (component-params comp)) + ;; Bind children if component accepts them + (when (component-has-children? comp) + (env-bind! local "children" children)) + ;; Return thunk — body evaluated in local env + (make-thunk (component-body comp) local)))) + + +(define parse-keyword-args + (fn ((raw-args :as list) (env :as dict)) + ;; Walk args: keyword + next-val → kwargs dict, else → children list + (let ((kwargs (dict)) + (children (list)) + (i 0)) + ;; Iterative parse — bootstrap converts to while loop + (reduce + (fn (state arg) + (let ((idx (get state "i")) + (skip (get state "skip"))) + (if skip + ;; This arg was consumed as a keyword value + (assoc state "skip" false "i" (inc idx)) + (if (and (= (type-of arg) "keyword") + (< (inc idx) (len raw-args))) + ;; Keyword: evaluate next arg and store + (do + (dict-set! kwargs (keyword-name arg) + (trampoline (eval-expr (nth raw-args (inc idx)) env))) + (assoc state "skip" true "i" (inc idx))) + ;; Positional: evaluate and add to children + (do + (append! children (trampoline (eval-expr arg env))) + (assoc state "i" (inc idx))))))) + (dict "i" 0 "skip" false) + raw-args) + (list kwargs children)))) + + +;; -------------------------------------------------------------------------- +;; 6. Special forms +;; -------------------------------------------------------------------------- +;; — all superseded by CEK step handlers in cek.sx + + +;; cond-scheme? — still needed by CEK's step-sf-cond +(define cond-scheme? + (fn ((clauses :as list)) + (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2))) + clauses))) + + +;; Named let: (let name ((x 0) (y 1)) body...) +;; Desugars to a self-recursive lambda called with initial values. +;; The loop name is bound in the body so recursive calls produce TCO thunks. +(define sf-named-let + (fn ((args :as list) (env :as dict)) + (let ((loop-name (symbol-name (first args))) + (bindings (nth args 1)) + (body (slice args 2)) + (params (list)) + (inits (list))) + ;; Extract param names and init expressions + (if (and (= (type-of (first bindings)) "list") + (= (len (first bindings)) 2)) + ;; Scheme-style: ((x 0) (y 1)) + (for-each + (fn (binding) + (append! params (if (= (type-of (first binding)) "symbol") + (symbol-name (first binding)) + (first binding))) + (append! inits (nth binding 1))) + bindings) + ;; Clojure-style: (x 0 y 1) + (reduce + (fn (acc pair-idx) + (do + (append! params (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") + (symbol-name (nth bindings (* pair-idx 2))) + (nth bindings (* pair-idx 2)))) + (append! inits (nth bindings (inc (* pair-idx 2)))))) + nil + (range 0 (/ (len bindings) 2)))) + ;; Build loop body (wrap in begin if multiple exprs) + (let ((loop-body (if (= (len body) 1) (first body) + (cons (make-symbol "begin") body))) + (loop-fn (make-lambda params loop-body env))) + ;; Self-reference: loop can call itself by name + (set-lambda-name! loop-fn loop-name) + (env-bind! (lambda-closure loop-fn) loop-name loop-fn) + ;; Evaluate initial values in enclosing env, then call + (let ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits))) + (call-lambda loop-fn init-vals env)))))) + + +(define sf-lambda + (fn ((args :as list) (env :as dict)) + (let ((params-expr (first args)) + (body-exprs (rest args)) + (body (if (= (len body-exprs) 1) + (first body-exprs) + (cons (make-symbol "begin") body-exprs))) + (param-names (map (fn (p) + (cond + (= (type-of p) "symbol") + (symbol-name p) + ;; Annotated param: (name :as type) → extract name + (and (= (type-of p) "list") + (= (len p) 3) + (= (type-of (nth p 1)) "keyword") + (= (keyword-name (nth p 1)) "as")) + (symbol-name (first p)) + :else p)) + params-expr))) + (make-lambda param-names body env)))) + + +(define sf-defcomp + (fn ((args :as list) (env :as dict)) + ;; (defcomp ~name (params) [:affinity :client|:server] body) + ;; Body is always the last element. Optional keyword annotations + ;; may appear between the params list and the body. + (let ((name-sym (first args)) + (params-raw (nth args 1)) + (body (last args)) + (comp-name (strip-prefix (symbol-name name-sym) "~")) + (parsed (parse-comp-params params-raw)) + (params (first parsed)) + (has-children (nth parsed 1)) + (param-types (nth parsed 2)) + (affinity (defcomp-kwarg args "affinity" "auto"))) + (let ((comp (make-component comp-name params has-children body env affinity)) + (effects (defcomp-kwarg args "effects" nil))) + ;; Store type annotations if any were declared + (when (and (not (nil? param-types)) + (not (empty? (keys param-types)))) + (component-set-param-types! comp param-types)) + ;; Store effect annotation if declared + (when (not (nil? effects)) + (let ((effect-list (if (= (type-of effects) "list") + (map (fn (e) (if (= (type-of e) "symbol") + (symbol-name e) (str e))) + effects) + (list (str effects)))) + (effect-anns (if (env-has? env "*effect-annotations*") + (env-get env "*effect-annotations*") + (dict)))) + (dict-set! effect-anns (symbol-name name-sym) effect-list) + (env-bind! env "*effect-annotations*" effect-anns))) + (env-bind! env (symbol-name name-sym) comp) + comp)))) + +(define defcomp-kwarg + (fn ((args :as list) (key :as string) default) + ;; Search for :key value between params (index 2) and body (last). + (let ((end (- (len args) 1)) + (result default)) + (for-each + (fn (i) + (when (and (= (type-of (nth args i)) "keyword") + (= (keyword-name (nth args i)) key) + (< (+ i 1) end)) + (let ((val (nth args (+ i 1)))) + (set! result (if (= (type-of val) "keyword") + (keyword-name val) val))))) + (range 2 end 1)) + result))) + +(define parse-comp-params + (fn ((params-expr :as list)) + ;; Parse (&key param1 param2 &children) → (params has-children param-types) + ;; Also accepts &rest as synonym for &children. + ;; Supports typed params: (name :as type) — a 3-element list where + ;; the second element is the keyword :as. Unannotated params get no + ;; type entry. param-types is a dict {name → type-expr} or empty dict. + (let ((params (list)) + (param-types (dict)) + (has-children false) + (in-key false)) + (for-each + (fn (p) + (if (and (= (type-of p) "list") + (= (len p) 3) + (= (type-of (first p)) "symbol") + (= (type-of (nth p 1)) "keyword") + (= (keyword-name (nth p 1)) "as")) + ;; Typed param: (name :as type) + (let ((name (symbol-name (first p))) + (ptype (nth p 2))) + ;; Convert type to string if it's a symbol + (let ((type-val (if (= (type-of ptype) "symbol") + (symbol-name ptype) + ptype))) + (when (not has-children) + (append! params name) + (dict-set! param-types name type-val)))) + ;; Untyped param or marker + (when (= (type-of p) "symbol") + (let ((name (symbol-name p))) + (cond + (= name "&key") (set! in-key true) + (= name "&rest") (set! has-children true) + (= name "&children") (set! has-children true) + has-children nil ;; skip params after &children/&rest + in-key (append! params name) + :else (append! params name)))))) + params-expr) + (list params has-children param-types)))) + + +(define sf-defisland + (fn ((args :as list) (env :as dict)) + ;; (defisland ~name (params) body) + ;; Like defcomp but creates an island (reactive component). + ;; Islands have the same calling convention as components but + ;; render with a reactive context on the client. + (let ((name-sym (first args)) + (params-raw (nth args 1)) + (body (last args)) + (comp-name (strip-prefix (symbol-name name-sym) "~")) + (parsed (parse-comp-params params-raw)) + (params (first parsed)) + (has-children (nth parsed 1))) + (let ((island (make-island comp-name params has-children body env))) + (env-bind! env (symbol-name name-sym) island) + island)))) + + +(define sf-defmacro + (fn ((args :as list) (env :as dict)) + (let ((name-sym (first args)) + (params-raw (nth args 1)) + (body (nth args 2)) + (parsed (parse-macro-params params-raw)) + (params (first parsed)) + (rest-param (nth parsed 1))) + (let ((mac (make-macro params rest-param body env (symbol-name name-sym)))) + (env-bind! env (symbol-name name-sym) mac) + mac)))) + +(define parse-macro-params + (fn ((params-expr :as list)) + ;; Parse (a b &rest rest) → ((a b) rest) + (let ((params (list)) + (rest-param nil)) + (reduce + (fn (state p) + (if (and (= (type-of p) "symbol") (= (symbol-name p) "&rest")) + (assoc state "in-rest" true) + (if (get state "in-rest") + (do (set! rest-param (if (= (type-of p) "symbol") + (symbol-name p) p)) + state) + (do (append! params (if (= (type-of p) "symbol") + (symbol-name p) p)) + state)))) + (dict "in-rest" false) + params-expr) + (list params rest-param)))) + + +(define sf-defstyle + (fn ((args :as list) (env :as dict)) + ;; (defstyle name expr) — bind name to evaluated expr (string, function, etc.) + (let ((name-sym (first args)) + (value (trampoline (eval-expr (nth args 1) env)))) + (env-bind! env (symbol-name name-sym) value) + value))) + + +;; -- deftype helpers (must be in eval.sx, not types.sx, because +;; sf-deftype is always compiled but types.sx is a spec module) -- + +(define make-type-def + (fn ((name :as string) (params :as list) body) + {:name name :params params :body body})) + +(define normalize-type-body + (fn (body) + ;; Convert AST type expressions to type representation. + ;; Symbols → strings, (union ...) → (or ...), dict keys → strings. + (cond + (nil? body) "nil" + (= (type-of body) "symbol") + (symbol-name body) + (= (type-of body) "string") + body + (= (type-of body) "keyword") + (keyword-name body) + (= (type-of body) "dict") + ;; Record type — normalize values + (map-dict (fn (k v) (normalize-type-body v)) body) + (= (type-of body) "list") + (if (empty? body) "any" + (let ((head (first body))) + (let ((head-name (if (= (type-of head) "symbol") + (symbol-name head) (str head)))) + ;; (union a b) → (or a b) + (if (= head-name "union") + (cons "or" (map normalize-type-body (rest body))) + ;; (or a b), (list-of t), (-> ...) etc. + (cons head-name (map normalize-type-body (rest body))))))) + :else (str body)))) + +(define sf-deftype + (fn ((args :as list) (env :as dict)) + ;; (deftype name body) or (deftype (name a b ...) body) + (let ((name-or-form (first args)) + (body-expr (nth args 1)) + (type-name nil) + (type-params (list))) + ;; Parse name — symbol or (symbol params...) + (if (= (type-of name-or-form) "symbol") + (set! type-name (symbol-name name-or-form)) + (when (= (type-of name-or-form) "list") + (set! type-name (symbol-name (first name-or-form))) + (set! type-params + (map (fn (p) (if (= (type-of p) "symbol") + (symbol-name p) (str p))) + (rest name-or-form))))) + ;; Normalize and store in *type-registry* + (let ((body (normalize-type-body body-expr)) + (registry (if (env-has? env "*type-registry*") + (env-get env "*type-registry*") + (dict)))) + (dict-set! registry type-name + (make-type-def type-name type-params body)) + (env-bind! env "*type-registry*" registry) + nil)))) + + +(define sf-defeffect + (fn ((args :as list) (env :as dict)) + ;; (defeffect name) — register an effect name + (let ((effect-name (if (= (type-of (first args)) "symbol") + (symbol-name (first args)) + (str (first args)))) + (registry (if (env-has? env "*effect-registry*") + (env-get env "*effect-registry*") + (list)))) + (when (not (contains? registry effect-name)) + (append! registry effect-name)) + (env-bind! env "*effect-registry*" registry) + nil))) + + +(define qq-expand + (fn (template (env :as dict)) + (if (not (= (type-of template) "list")) + template + (if (empty? template) + (list) + (let ((head (first template))) + (if (and (= (type-of head) "symbol") (= (symbol-name head) "unquote")) + (trampoline (eval-expr (nth template 1) env)) + ;; Walk children, handling splice-unquote + (reduce + (fn (result item) + (if (and (= (type-of item) "list") + (= (len item) 2) + (= (type-of (first item)) "symbol") + (= (symbol-name (first item)) "splice-unquote")) + (let ((spliced (trampoline (eval-expr (nth item 1) env)))) + (if (= (type-of spliced) "list") + (concat result spliced) + (if (nil? spliced) result (concat result (list spliced))))) + (concat result (list (qq-expand item env))))) + (list) + template))))))) + + +;; -------------------------------------------------------------------------- +;; 6c. letrec — mutually recursive local bindings +;; -------------------------------------------------------------------------- +;; +;; (letrec ((even? (fn (n) (if (= n 0) true (odd? (- n 1))))) +;; (odd? (fn (n) (if (= n 0) false (even? (- n 1)))))) +;; (even? 10)) +;; +;; All bindings are first set to nil in the local env, then all values +;; are evaluated (so they can see each other's names), then lambda +;; closures are patched to include the final bindings. +;; -------------------------------------------------------------------------- + +(define sf-letrec + (fn ((args :as list) (env :as dict)) + (let ((bindings (first args)) + (body (rest args)) + (local (env-extend env)) + (names (list)) + (val-exprs (list))) + ;; First pass: bind all names to nil + (if (and (= (type-of (first bindings)) "list") + (= (len (first bindings)) 2)) + ;; Scheme-style + (for-each + (fn (binding) + (let ((vname (if (= (type-of (first binding)) "symbol") + (symbol-name (first binding)) + (first binding)))) + (append! names vname) + (append! val-exprs (nth binding 1)) + (env-bind! local vname nil))) + bindings) + ;; Clojure-style + (reduce + (fn (acc pair-idx) + (let ((vname (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") + (symbol-name (nth bindings (* pair-idx 2))) + (nth bindings (* pair-idx 2)))) + (val-expr (nth bindings (inc (* pair-idx 2))))) + (append! names vname) + (append! val-exprs val-expr) + (env-bind! local vname nil))) + nil + (range 0 (/ (len bindings) 2)))) + ;; Second pass: evaluate values (they can see each other's names) + (let ((values (map (fn (e) (trampoline (eval-expr e local))) val-exprs))) + ;; Bind final values + (for-each + (fn (pair) (env-bind! local (first pair) (nth pair 1))) + (zip names values)) + ;; Patch lambda closures so they see the final bindings + (for-each + (fn (val) + (when (lambda? val) + (for-each + (fn (n) (env-bind! (lambda-closure val) n (env-get local n))) + names))) + values)) + ;; Evaluate body + (for-each + (fn (e) (trampoline (eval-expr e local))) + (slice body 0 (dec (len body)))) + (make-thunk (last body) local)))) + + +;; -------------------------------------------------------------------------- +;; 6d. dynamic-wind — entry/exit guards +;; -------------------------------------------------------------------------- +;; +;; (dynamic-wind before-thunk body-thunk after-thunk) +;; +;; All three are zero-argument functions (thunks): +;; 1. Call before-thunk +;; 2. Call body-thunk, capture result +;; 3. Call after-thunk (always, even on error) +;; 4. Return body result +;; +;; The wind stack is maintained so that when continuations jump across +;; dynamic-wind boundaries, the correct before/after thunks fire. +;; Without active continuations, this is equivalent to try/finally. +;; +;; Platform requirements: +;; (push-wind! before after) — push wind record onto stack +;; (pop-wind!) — pop wind record from stack +;; (call-thunk f env) — call a zero-arg function +;; -------------------------------------------------------------------------- + +(define sf-dynamic-wind + (fn ((args :as list) (env :as dict)) + (let ((before (trampoline (eval-expr (first args) env))) + (body (trampoline (eval-expr (nth args 1) env))) + (after (trampoline (eval-expr (nth args 2) env)))) + ;; Delegate to platform — needs try/finally for error safety + (dynamic-wind-call before body after env)))) + + +;; -------------------------------------------------------------------------- +;; 6a2. scope — unified render-time dynamic scope primitive +;; -------------------------------------------------------------------------- +;; +;; (scope name body...) or (scope name :value v body...) +;; Push a named scope with optional value and empty accumulator, +;; evaluate body, pop scope. Returns last body result. +;; +;; `provide` is sugar: (provide name value body...) = (scope name :value value body...) + +(define sf-scope + (fn ((args :as list) (env :as dict)) + (let ((name (trampoline (eval-expr (first args) env))) + (rest (slice args 1)) + (val nil) + (body-exprs nil)) + ;; Check for :value keyword + (if (and (>= (len rest) 2) (= (type-of (first rest)) "keyword") (= (keyword-name (first rest)) "value")) + (do (set! val (trampoline (eval-expr (nth rest 1) env))) + (set! body-exprs (slice rest 2))) + (set! body-exprs rest)) + (scope-push! name val) + (let ((result nil)) + (for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs) + (scope-pop! name) + result)))) + + +;; provide — sugar for scope with a value +;; (provide name value body...) → (scope name :value value body...) + +(define sf-provide + (fn ((args :as list) (env :as dict)) + (let ((name (trampoline (eval-expr (first args) env))) + (val (trampoline (eval-expr (nth args 1) env))) + (body-exprs (slice args 2)) + (result nil)) + (scope-push! name val) + (for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs) + (scope-pop! name) + result))) + + +;; -------------------------------------------------------------------------- +;; 6b. Macro expansion +;; -------------------------------------------------------------------------- + +(define expand-macro + (fn ((mac :as macro) (raw-args :as list) (env :as dict)) + (let ((local (env-merge (macro-closure mac) env))) + ;; Bind positional params (unevaluated) + (for-each + (fn (pair) + (env-bind! local (first pair) + (if (< (nth pair 1) (len raw-args)) + (nth raw-args (nth pair 1)) + nil))) + (map-indexed (fn (i p) (list p i)) (macro-params mac))) + ;; Bind &rest param + (when (macro-rest-param mac) + (env-bind! local (macro-rest-param mac) + (slice raw-args (len (macro-params mac))))) + ;; Evaluate body → new AST + (trampoline (eval-expr (macro-body mac) local))))) + + + +;; -------------------------------------------------------------------------- +;; 8. Primitives — pure functions available in all targets +;; -------------------------------------------------------------------------- +;; These are the ~80 built-in functions. Each target implements them +;; natively but they MUST have identical semantics. This section serves +;; as the specification — bootstrap compilers use it for reference. +;; +;; Primitives are NOT defined here as SX lambdas (that would be circular). +;; Instead, this is a declarative registry that bootstrap compilers read. +;; -------------------------------------------------------------------------- + +;; See primitives.sx for the full specification. + + +;; -------------------------------------------------------------------------- +;; 9. Platform interface — must be provided by each target +;; -------------------------------------------------------------------------- +;; +;; Type inspection: +;; (type-of x) → "number" | "string" | "boolean" | "nil" +;; | "symbol" | "keyword" | "list" | "dict" +;; | "lambda" | "component" | "macro" | "thunk" +;; | "spread" +;; (symbol-name sym) → string +;; (keyword-name kw) → string +;; +;; Constructors: +;; (make-lambda params body env) → Lambda +;; (make-component name params has-children body env affinity) → Component +;; (make-macro params rest-param body env name) → Macro +;; (make-thunk expr env) → Thunk +;; +;; Accessors: +;; (lambda-params f) → list of strings +;; (lambda-body f) → expr +;; (lambda-closure f) → env +;; (lambda-name f) → string or nil +;; (set-lambda-name! f n) → void +;; (component-params c) → list of strings +;; (component-body c) → expr +;; (component-closure c) → env +;; (component-has-children? c) → boolean +;; (component-affinity c) → "auto" | "client" | "server" +;; +;; (make-island name params has-children body env) → Island +;; (island? x) → boolean +;; ;; Islands reuse component accessors: component-params, component-body, etc. +;; +;; (make-spread attrs) → Spread (attrs dict injected onto parent element) +;; (spread? x) → boolean +;; (spread-attrs s) → dict +;; +;; (macro-params m) → list of strings +;; (macro-rest-param m) → string or nil +;; (macro-body m) → expr +;; (macro-closure m) → env +;; (thunk? x) → boolean +;; (thunk-expr t) → expr +;; (thunk-env t) → env +;; +;; Predicates: +;; (callable? x) → boolean (native function or lambda) +;; (lambda? x) → boolean +;; (component? x) → boolean +;; (island? x) → boolean +;; (macro? x) → boolean +;; (primitive? name) → boolean (is name a registered primitive?) +;; (get-primitive name) → function +;; +;; Environment: +;; (env-has? env name) → boolean +;; (env-get env name) → value +;; (env-bind! env name val) → void (create binding on THIS env, no chain walk) +;; (env-set! env name val) → void (mutate existing binding, walks scope chain) +;; (env-extend env) → new env inheriting from env +;; (env-merge base overlay) → new env with overlay on top +;; +;; Mutation helpers (for parse-keyword-args): +;; (dict-set! d key val) → void +;; (dict-get d key) → value or nil +;; (append! lst val) → void (mutating append) +;; +;; Error: +;; (error msg) → raise/throw with message +;; (inspect x) → string representation for debugging +;; +;; Utility: +;; (strip-prefix s prefix) → string with prefix removed (or s unchanged) +;; (apply f args) → call f with args list +;; (zip lists...) → list of tuples +;; +;; +;; Dynamic wind (for dynamic-wind): +;; (push-wind! before after) → void (push wind record onto stack) +;; (pop-wind!) → void (pop wind record from stack) +;; (call-thunk f env) → value (call a zero-arg function) +;; +;; Render-time accumulators: +;; (collect! bucket value) → void (add to named bucket, deduplicated) +;; (collected bucket) → list (all values in bucket) +;; (clear-collected! bucket) → void (empty the bucket) +;; -------------------------------------------------------------------------- + + +;; ************************************************************************** +;; Part 3: CEK Machine — the sole evaluator +;; ************************************************************************** + ;; -------------------------------------------------------------------------- ;; 1. Run loop — drive the CEK machine to completion ;; -------------------------------------------------------------------------- diff --git a/spec/frames.sx b/spec/frames.sx deleted file mode 100644 index 6212498..0000000 --- a/spec/frames.sx +++ /dev/null @@ -1,262 +0,0 @@ -;; ========================================================================== -;; frames.sx — CEK machine frame types -;; -;; Defines the continuation frame types used by the explicit CEK evaluator. -;; Each frame represents a "what to do next" when a sub-evaluation completes. -;; -;; A CEK state is a dict: -;; {:control expr — expression being evaluated (or nil in continue phase) -;; :env env — current environment -;; :kont list — continuation: list of frames (stack, head = top) -;; :phase "eval"|"continue" -;; :value any} — value produced (only in continue phase) -;; -;; Two-phase step function: -;; step-eval: control is expression → dispatch → push frame + new control -;; step-continue: value produced → pop frame → dispatch → new state -;; -;; Terminal state: phase = "continue" and kont is empty → value is final result. -;; ========================================================================== - - -;; -------------------------------------------------------------------------- -;; 1. CEK State constructors -;; -------------------------------------------------------------------------- - -(define make-cek-state - (fn (control env kont) - {:control control :env env :kont kont :phase "eval" :value nil})) - -(define make-cek-value - (fn (value env kont) - {:control nil :env env :kont kont :phase "continue" :value value})) - -(define cek-terminal? - (fn (state) - (and (= (get state "phase") "continue") - (empty? (get state "kont"))))) - -(define cek-control (fn (s) (get s "control"))) -(define cek-env (fn (s) (get s "env"))) -(define cek-kont (fn (s) (get s "kont"))) -(define cek-phase (fn (s) (get s "phase"))) -(define cek-value (fn (s) (get s "value"))) - - -;; -------------------------------------------------------------------------- -;; 2. Frame constructors -;; -------------------------------------------------------------------------- -;; Each frame type is a dict with a "type" key and frame-specific data. - -;; IfFrame: waiting for condition value -;; After condition evaluates, choose then or else branch -(define make-if-frame - (fn (then-expr else-expr env) - {:type "if" :then then-expr :else else-expr :env env})) - -;; WhenFrame: waiting for condition value -;; If truthy, evaluate body exprs sequentially -(define make-when-frame - (fn (body-exprs env) - {:type "when" :body body-exprs :env env})) - -;; BeginFrame: sequential evaluation -;; Remaining expressions to evaluate after current one -(define make-begin-frame - (fn (remaining env) - {:type "begin" :remaining remaining :env env})) - -;; LetFrame: binding evaluation in progress -;; name = current binding name, remaining = remaining (name val) pairs -;; body = body expressions to evaluate after all bindings -(define make-let-frame - (fn (name remaining body local) - {:type "let" :name name :remaining remaining :body body :env local})) - -;; DefineFrame: waiting for value to bind -(define make-define-frame - (fn (name env has-effects effect-list) - {:type "define" :name name :env env - :has-effects has-effects :effect-list effect-list})) - -;; SetFrame: waiting for value to assign -(define make-set-frame - (fn (name env) - {:type "set" :name name :env env})) - -;; ArgFrame: evaluating function arguments -;; f = function value (already evaluated), evaled = already evaluated args -;; remaining = remaining arg expressions -(define make-arg-frame - (fn (f evaled remaining env raw-args head-name) - {:type "arg" :f f :evaled evaled :remaining remaining :env env - :raw-args raw-args :head-name (or head-name nil)})) - -;; CallFrame: about to call with fully evaluated args -(define make-call-frame - (fn (f args env) - {:type "call" :f f :args args :env env})) - -;; CondFrame: evaluating cond clauses -(define make-cond-frame - (fn (remaining env scheme?) - {:type "cond" :remaining remaining :env env :scheme scheme?})) - -;; CaseFrame: evaluating case clauses -(define make-case-frame - (fn (match-val remaining env) - {:type "case" :match-val match-val :remaining remaining :env env})) - -;; ThreadFirstFrame: pipe threading -(define make-thread-frame - (fn (remaining env) - {:type "thread" :remaining remaining :env env})) - -;; MapFrame: higher-order map/map-indexed in progress -(define make-map-frame - (fn (f remaining results env) - {:type "map" :f f :remaining remaining :results results :env env :indexed false})) - -(define make-map-indexed-frame - (fn (f remaining results env) - {:type "map" :f f :remaining remaining :results results :env env :indexed true})) - -;; FilterFrame: higher-order filter in progress -(define make-filter-frame - (fn (f remaining results current-item env) - {:type "filter" :f f :remaining remaining :results results - :current-item current-item :env env})) - -;; ReduceFrame: higher-order reduce in progress -(define make-reduce-frame - (fn (f remaining env) - {:type "reduce" :f f :remaining remaining :env env})) - -;; ForEachFrame: higher-order for-each in progress -(define make-for-each-frame - (fn (f remaining env) - {:type "for-each" :f f :remaining remaining :env env})) - -;; SomeFrame: higher-order some (short-circuit on first truthy) -(define make-some-frame - (fn (f remaining env) - {:type "some" :f f :remaining remaining :env env})) - -;; EveryFrame: higher-order every? (short-circuit on first falsy) -(define make-every-frame - (fn (f remaining env) - {:type "every" :f f :remaining remaining :env env})) - -;; ScopeFrame: scope-pop! when frame pops -(define make-scope-frame - (fn (name remaining env) - {:type "scope" :name name :remaining remaining :env env})) - -;; ResetFrame: delimiter for shift/reset continuations -(define make-reset-frame - (fn (env) - {:type "reset" :env env})) - -;; DictFrame: evaluating dict values -(define make-dict-frame - (fn (remaining results env) - {:type "dict" :remaining remaining :results results :env env})) - -;; AndFrame: short-circuit and -(define make-and-frame - (fn (remaining env) - {:type "and" :remaining remaining :env env})) - -;; OrFrame: short-circuit or -(define make-or-frame - (fn (remaining env) - {:type "or" :remaining remaining :env env})) - -;; QuasiquoteFrame (not a real frame — QQ is handled specially) - -;; DynamicWindFrame: phases of dynamic-wind -(define make-dynamic-wind-frame - (fn (phase body-thunk after-thunk env) - {:type "dynamic-wind" :phase phase - :body-thunk body-thunk :after-thunk after-thunk :env env})) - -;; ReactiveResetFrame: delimiter for reactive deref-as-shift -;; Carries an update-fn that gets called with new values on re-render. -(define make-reactive-reset-frame - (fn (env update-fn first-render?) - {:type "reactive-reset" :env env :update-fn update-fn - :first-render first-render?})) - -;; DerefFrame: awaiting evaluation of deref's argument -(define make-deref-frame - (fn (env) - {:type "deref" :env env})) - - -;; -------------------------------------------------------------------------- -;; 3. Frame accessors -;; -------------------------------------------------------------------------- - -(define frame-type (fn (f) (get f "type"))) - - -;; -------------------------------------------------------------------------- -;; 4. Continuation operations -;; -------------------------------------------------------------------------- - -(define kont-push - (fn (frame kont) (cons frame kont))) - -(define kont-top - (fn (kont) (first kont))) - -(define kont-pop - (fn (kont) (rest kont))) - -(define kont-empty? - (fn (kont) (empty? kont))) - - -;; -------------------------------------------------------------------------- -;; 5. CEK shift/reset support -;; -------------------------------------------------------------------------- -;; shift captures all frames up to the nearest ResetFrame. -;; reset pushes a ResetFrame. - -(define kont-capture-to-reset - (fn (kont) - ;; Returns (captured-frames remaining-kont). - ;; captured-frames: frames from top up to (not including) ResetFrame. - ;; remaining-kont: frames after ResetFrame. - ;; Stops at either "reset" or "reactive-reset" frames. - (define scan - (fn (k captured) - (if (empty? k) - (error "shift without enclosing reset") - (let ((frame (first k))) - (if (or (= (frame-type frame) "reset") - (= (frame-type frame) "reactive-reset")) - (list captured (rest k)) - (scan (rest k) (append captured (list frame)))))))) - (scan kont (list)))) - -;; Check if a ReactiveResetFrame exists anywhere in the continuation -(define has-reactive-reset-frame? - (fn (kont) - (if (empty? kont) false - (if (= (frame-type (first kont)) "reactive-reset") true - (has-reactive-reset-frame? (rest kont)))))) - -;; Capture frames up to nearest ReactiveResetFrame. -;; Returns (captured-frames, reset-frame, remaining-kont). -(define kont-capture-to-reactive-reset - (fn (kont) - (define scan - (fn (k captured) - (if (empty? k) - (error "reactive deref without enclosing reactive-reset") - (let ((frame (first k))) - (if (= (frame-type frame) "reactive-reset") - (list captured frame (rest k)) - (scan (rest k) (append captured (list frame)))))))) - (scan kont (list))))