diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index b760b60..137bf26 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-14T10:27:39Z"; + var SX_VERSION = "2026-03-14T10:44:25Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -3922,7 +3922,10 @@ callExpr.push(dictGet(kwargs, k)); } } var makeThreadFrame = function(remaining, env) { return {"type": "thread", "remaining": remaining, "env": env}; }; // make-map-frame - var makeMapFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env}; }; + var makeMapFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env, "indexed": false}; }; + + // make-map-indexed-frame + var makeMapIndexedFrame = function(f, remaining, results, env) { return {"type": "map", "f": f, "remaining": remaining, "results": results, "env": env, "indexed": true}; }; // 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}; }; @@ -3933,6 +3936,12 @@ callExpr.push(dictGet(kwargs, k)); } } // make-for-each-frame var makeForEachFrame = function(f, remaining, env) { return {"type": "for-each", "f": f, "remaining": remaining, "env": env}; }; + // make-some-frame + var makeSomeFrame = function(f, remaining, env) { return {"type": "some", "f": f, "remaining": remaining, "env": env}; }; + + // make-every-frame + var makeEveryFrame = function(f, remaining, env) { return {"type": "every", "f": f, "remaining": remaining, "env": env}; }; + // make-scope-frame var makeScopeFrame = function(name, remaining, env) { return {"type": "scope", "name": name, "remaining": remaining, "env": env}; }; @@ -4440,7 +4449,7 @@ return scan(kont, []); }; 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")) ? makeCekValue(hoMapIndexed(args, env), env, kont) : (isSxTruthy((name == "filter")) ? stepHoFilter(args, env, kont) : (isSxTruthy((name == "reduce")) ? stepHoReduce(args, env, kont) : (isSxTruthy((name == "some")) ? makeCekValue(hoSome(args, env), env, kont) : (isSxTruthy((name == "every?")) ? makeCekValue(hoEvery(args, env), env, kont) : (isSxTruthy((name == "for-each")) ? stepHoForEach(args, env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() { + 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)))))))))))))))))))))))))))))))))))))))))))); @@ -4582,16 +4591,54 @@ return forEach(function(d) { return cekCall(d, NIL); }, subDisposers); }); var stepEvalCall = function(head, args, env, kont) { return makeCekState(head, env, kontPush(makeArgFrame(NIL, [], args, env, args), kont)); }; // step-ho-map - var stepHoMap = function(args, env, kont) { return makeCekValue(hoMap(args, env), env, kont); }; + 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))); +})(); }; + + // 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))); +})(); }; // step-ho-filter - var stepHoFilter = function(args, env, kont) { return makeCekValue(hoFilter(args, env), env, kont); }; + 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))); +})(); }; // step-ho-reduce - var stepHoReduce = function(args, env, kont) { return makeCekValue(hoReduce(args, env), env, kont); }; + 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))); +})(); }; + + // 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))); +})(); }; + + // 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))); +})(); }; // step-ho-for-each - var stepHoForEach = function(args, env, kont) { return makeCekValue(hoForEach(args, env), env, kont); }; + 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))); +})(); }; // step-continue var stepContinue = function(state) { return (function() { @@ -4741,7 +4788,51 @@ return forEach(function(d) { return cekCall(d, NIL); }, subDisposers); }); 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))); -})() : error((String("Unknown frame type: ") + String(ft)))))))))))))))))))); +})() : (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)))))))))))))))))))))))))); })()); })(); }; diff --git a/shared/sx/ref/cek.sx b/shared/sx/ref/cek.sx index 118ce7c..b5918ba 100644 --- a/shared/sx/ref/cek.sx +++ b/shared/sx/ref/cek.sx @@ -168,11 +168,11 @@ ;; Higher-order forms (= name "map") (step-ho-map args env kont) - (= name "map-indexed") (make-cek-value (ho-map-indexed args env) env kont) + (= name "map-indexed") (step-ho-map-indexed args env kont) (= name "filter") (step-ho-filter args env kont) (= name "reduce") (step-ho-reduce args env kont) - (= name "some") (make-cek-value (ho-some args env) env kont) - (= name "every?") (make-cek-value (ho-every args env) env kont) + (= name "some") (step-ho-some args env kont) + (= name "every?") (step-ho-every args env kont) (= name "for-each") (step-ho-for-each args env kont) ;; Macro expansion @@ -477,23 +477,74 @@ ;; 7. Higher-order form step handlers ;; -------------------------------------------------------------------------- +;; CEK-native higher-order forms — each callback invocation goes through +;; continue-with-call so deref-as-shift works inside callbacks. +;; Function and collection args are evaluated via tree-walk (simple exprs), +;; then the loop is driven by CEK frames. + (define step-ho-map (fn (args env kont) - ;; Evaluate function, then collection - ;; For now, delegate to existing ho-map (it's a tight loop) - (make-cek-value (ho-map args env) env kont))) + (let ((f (trampoline (eval-expr (first args) env))) + (coll (trampoline (eval-expr (nth args 1) env)))) + (if (empty? coll) + (make-cek-value (list) env kont) + (continue-with-call f (list (first coll)) env (list) + (kont-push (make-map-frame f (rest coll) (list) env) kont)))))) + +(define step-ho-map-indexed + (fn (args env kont) + (let ((f (trampoline (eval-expr (first args) env))) + (coll (trampoline (eval-expr (nth args 1) env)))) + (if (empty? coll) + (make-cek-value (list) env kont) + (continue-with-call f (list 0 (first coll)) env (list) + (kont-push (make-map-indexed-frame f (rest coll) (list) env) kont)))))) (define step-ho-filter (fn (args env kont) - (make-cek-value (ho-filter args env) env kont))) + (let ((f (trampoline (eval-expr (first args) env))) + (coll (trampoline (eval-expr (nth args 1) env)))) + (if (empty? coll) + (make-cek-value (list) env kont) + (continue-with-call f (list (first coll)) env (list) + (kont-push (make-filter-frame f (rest coll) (list) (first coll) env) kont)))))) (define step-ho-reduce (fn (args env kont) - (make-cek-value (ho-reduce args env) env kont))) + (let ((f (trampoline (eval-expr (first args) env))) + (init (trampoline (eval-expr (nth args 1) env))) + (coll (trampoline (eval-expr (nth args 2) env)))) + (if (empty? coll) + (make-cek-value init env kont) + (continue-with-call f (list init (first coll)) env (list) + (kont-push (make-reduce-frame f (rest coll) env) kont)))))) + +(define step-ho-some + (fn (args env kont) + (let ((f (trampoline (eval-expr (first args) env))) + (coll (trampoline (eval-expr (nth args 1) env)))) + (if (empty? coll) + (make-cek-value false env kont) + (continue-with-call f (list (first coll)) env (list) + (kont-push (make-some-frame f (rest coll) env) kont)))))) + +(define step-ho-every + (fn (args env kont) + (let ((f (trampoline (eval-expr (first args) env))) + (coll (trampoline (eval-expr (nth args 1) env)))) + (if (empty? coll) + (make-cek-value true env kont) + (continue-with-call f (list (first coll)) env (list) + (kont-push (make-every-frame f (rest coll) env) kont)))))) (define step-ho-for-each (fn (args env kont) - (make-cek-value (ho-for-each args env) env kont))) + (let ((f (trampoline (eval-expr (first args) env))) + (coll (trampoline (eval-expr (nth args 1) env)))) + (if (empty? coll) + (make-cek-value nil env kont) + (continue-with-call f (list (first coll)) env (list) + (kont-push (make-for-each-frame f (rest coll) env) kont)))))) ;; -------------------------------------------------------------------------- @@ -809,6 +860,84 @@ (make-scope-frame name (rest remaining) fenv) rest-k)))) + ;; --- MapFrame: callback result for map/map-indexed --- + (= ft "map") + (let ((f (get frame "f")) + (remaining (get frame "remaining")) + (results (get frame "results")) + (indexed (get frame "indexed")) + (fenv (get frame "env"))) + (let ((new-results (append results (list value)))) + (if (empty? remaining) + (make-cek-value new-results fenv rest-k) + (let ((call-args (if indexed + (list (len new-results) (first remaining)) + (list (first remaining)))) + (next-frame (if indexed + (make-map-indexed-frame f (rest remaining) new-results fenv) + (make-map-frame f (rest remaining) new-results fenv)))) + (continue-with-call f call-args fenv (list) + (kont-push next-frame rest-k)))))) + + ;; --- FilterFrame: predicate result --- + (= ft "filter") + (let ((f (get frame "f")) + (remaining (get frame "remaining")) + (results (get frame "results")) + (current-item (get frame "current-item")) + (fenv (get frame "env"))) + (let ((new-results (if value + (append results (list current-item)) + results))) + (if (empty? remaining) + (make-cek-value new-results fenv rest-k) + (continue-with-call f (list (first remaining)) fenv (list) + (kont-push (make-filter-frame f (rest remaining) new-results (first remaining) fenv) rest-k))))) + + ;; --- ReduceFrame: accumulator step --- + (= ft "reduce") + (let ((f (get frame "f")) + (remaining (get frame "remaining")) + (fenv (get frame "env"))) + (if (empty? remaining) + (make-cek-value value fenv rest-k) + (continue-with-call f (list value (first remaining)) fenv (list) + (kont-push (make-reduce-frame f (rest remaining) fenv) rest-k)))) + + ;; --- ForEachFrame: side effect, discard result --- + (= ft "for-each") + (let ((f (get frame "f")) + (remaining (get frame "remaining")) + (fenv (get frame "env"))) + (if (empty? remaining) + (make-cek-value nil fenv rest-k) + (continue-with-call f (list (first remaining)) fenv (list) + (kont-push (make-for-each-frame f (rest remaining) fenv) rest-k)))) + + ;; --- SomeFrame: short-circuit on first truthy --- + (= ft "some") + (let ((f (get frame "f")) + (remaining (get frame "remaining")) + (fenv (get frame "env"))) + (if value + (make-cek-value value fenv rest-k) + (if (empty? remaining) + (make-cek-value false fenv rest-k) + (continue-with-call f (list (first remaining)) fenv (list) + (kont-push (make-some-frame f (rest remaining) fenv) rest-k))))) + + ;; --- EveryFrame: short-circuit on first falsy --- + (= ft "every") + (let ((f (get frame "f")) + (remaining (get frame "remaining")) + (fenv (get frame "env"))) + (if (not value) + (make-cek-value false fenv rest-k) + (if (empty? remaining) + (make-cek-value true fenv rest-k) + (continue-with-call f (list (first remaining)) fenv (list) + (kont-push (make-every-frame f (rest remaining) fenv) rest-k))))) + :else (error (str "Unknown frame type: " ft)))))))) diff --git a/shared/sx/ref/frames.sx b/shared/sx/ref/frames.sx index c6f597c..05e27c3 100644 --- a/shared/sx/ref/frames.sx +++ b/shared/sx/ref/frames.sx @@ -112,10 +112,14 @@ (fn (remaining env) {:type "thread" :remaining remaining :env env})) -;; MapFrame: higher-order map in progress +;; 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})) + {: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 @@ -133,6 +137,16 @@ (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) diff --git a/shared/sx/ref/sx_ref.py b/shared/sx/ref/sx_ref.py index aad3ff5..1afef04 100644 --- a/shared/sx/ref/sx_ref.py +++ b/shared/sx/ref/sx_ref.py @@ -3256,7 +3256,11 @@ def make_thread_frame(remaining, env): # make-map-frame def make_map_frame(f, remaining, results, env): - return {'type': 'map', 'f': f, 'remaining': remaining, 'results': results, 'env': env} + return {'type': 'map', 'f': f, 'remaining': remaining, 'results': results, 'env': env, 'indexed': False} + +# make-map-indexed-frame +def make_map_indexed_frame(f, remaining, results, env): + return {'type': 'map', 'f': f, 'remaining': remaining, 'results': results, 'env': env, 'indexed': True} # make-filter-frame def make_filter_frame(f, remaining, results, current_item, env): @@ -3270,6 +3274,14 @@ def make_reduce_frame(f, remaining, env): def make_for_each_frame(f, remaining, env): return {'type': 'for-each', 'f': f, 'remaining': remaining, 'env': env} +# make-some-frame +def make_some_frame(f, remaining, env): + return {'type': 'some', 'f': f, 'remaining': remaining, 'env': env} + +# make-every-frame +def make_every_frame(f, remaining, env): + return {'type': 'every', 'f': f, 'remaining': remaining, 'env': env} + # make-scope-frame def make_scope_frame(name, remaining, env): return {'type': 'scope', 'name': name, 'remaining': remaining, 'env': env} @@ -3994,15 +4006,15 @@ def step_eval_list(expr, env, kont): elif sx_truthy((name == 'map')): return step_ho_map(args, env, kont) elif sx_truthy((name == 'map-indexed')): - return make_cek_value(ho_map_indexed(args, env), env, kont) + return step_ho_map_indexed(args, env, kont) elif sx_truthy((name == 'filter')): return step_ho_filter(args, env, kont) elif sx_truthy((name == 'reduce')): return step_ho_reduce(args, env, kont) elif sx_truthy((name == 'some')): - return make_cek_value(ho_some(args, env), env, kont) + return step_ho_some(args, env, kont) elif sx_truthy((name == 'every?')): - return make_cek_value(ho_every(args, env), env, kont) + return step_ho_every(args, env, kont) elif sx_truthy((name == 'for-each')): return step_ho_for_each(args, env, kont) elif sx_truthy((env_has(env, name) if not sx_truthy(env_has(env, name)) else is_macro(env_get(env, name)))): @@ -4178,19 +4190,67 @@ def step_eval_call(head, args, env, kont): # step-ho-map def step_ho_map(args, env, kont): - return make_cek_value(ho_map(args, env), env, kont) + f = trampoline(eval_expr(first(args), env)) + coll = trampoline(eval_expr(nth(args, 1), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value([], env, kont) + else: + return continue_with_call(f, [first(coll)], env, [], kont_push(make_map_frame(f, rest(coll), [], env), kont)) + +# step-ho-map-indexed +def step_ho_map_indexed(args, env, kont): + f = trampoline(eval_expr(first(args), env)) + coll = trampoline(eval_expr(nth(args, 1), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value([], env, kont) + else: + return continue_with_call(f, [0, first(coll)], env, [], kont_push(make_map_indexed_frame(f, rest(coll), [], env), kont)) # step-ho-filter def step_ho_filter(args, env, kont): - return make_cek_value(ho_filter(args, env), env, kont) + f = trampoline(eval_expr(first(args), env)) + coll = trampoline(eval_expr(nth(args, 1), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value([], env, kont) + else: + return continue_with_call(f, [first(coll)], env, [], kont_push(make_filter_frame(f, rest(coll), [], first(coll), env), kont)) # step-ho-reduce def step_ho_reduce(args, env, kont): - return make_cek_value(ho_reduce(args, env), env, kont) + f = trampoline(eval_expr(first(args), env)) + init = trampoline(eval_expr(nth(args, 1), env)) + coll = trampoline(eval_expr(nth(args, 2), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value(init, env, kont) + else: + return continue_with_call(f, [init, first(coll)], env, [], kont_push(make_reduce_frame(f, rest(coll), env), kont)) + +# step-ho-some +def step_ho_some(args, env, kont): + f = trampoline(eval_expr(first(args), env)) + coll = trampoline(eval_expr(nth(args, 1), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value(False, env, kont) + else: + return continue_with_call(f, [first(coll)], env, [], kont_push(make_some_frame(f, rest(coll), env), kont)) + +# step-ho-every +def step_ho_every(args, env, kont): + f = trampoline(eval_expr(first(args), env)) + coll = trampoline(eval_expr(nth(args, 1), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value(True, env, kont) + else: + return continue_with_call(f, [first(coll)], env, [], kont_push(make_every_frame(f, rest(coll), env), kont)) # step-ho-for-each def step_ho_for_each(args, env, kont): - return make_cek_value(ho_for_each(args, env), env, kont) + f = trampoline(eval_expr(first(args), env)) + coll = trampoline(eval_expr(nth(args, 1), env)) + if sx_truthy(empty_p(coll)): + return make_cek_value(NIL, env, kont) + else: + return continue_with_call(f, [first(coll)], env, [], kont_push(make_for_each_frame(f, rest(coll), env), kont)) # step-continue def step_continue(state): @@ -4400,6 +4460,68 @@ def step_continue(state): return make_cek_value(value, fenv, rest_k) else: return make_cek_state(first(remaining), fenv, kont_push(make_scope_frame(name, rest(remaining), fenv), rest_k)) + elif sx_truthy((ft == 'map')): + f = get(frame, 'f') + remaining = get(frame, 'remaining') + results = get(frame, 'results') + indexed = get(frame, 'indexed') + fenv = get(frame, 'env') + new_results = append(results, [value]) + if sx_truthy(empty_p(remaining)): + return make_cek_value(new_results, fenv, rest_k) + else: + call_args = ([len(new_results), first(remaining)] if sx_truthy(indexed) else [first(remaining)]) + next_frame = (make_map_indexed_frame(f, rest(remaining), new_results, fenv) if sx_truthy(indexed) else make_map_frame(f, rest(remaining), new_results, fenv)) + return continue_with_call(f, call_args, fenv, [], kont_push(next_frame, rest_k)) + elif sx_truthy((ft == 'filter')): + f = get(frame, 'f') + remaining = get(frame, 'remaining') + results = get(frame, 'results') + current_item = get(frame, 'current-item') + fenv = get(frame, 'env') + new_results = (append(results, [current_item]) if sx_truthy(value) else results) + if sx_truthy(empty_p(remaining)): + return make_cek_value(new_results, fenv, rest_k) + else: + return continue_with_call(f, [first(remaining)], fenv, [], kont_push(make_filter_frame(f, rest(remaining), new_results, first(remaining), fenv), rest_k)) + elif sx_truthy((ft == 'reduce')): + f = get(frame, 'f') + remaining = get(frame, 'remaining') + fenv = get(frame, 'env') + if sx_truthy(empty_p(remaining)): + return make_cek_value(value, fenv, rest_k) + else: + return continue_with_call(f, [value, first(remaining)], fenv, [], kont_push(make_reduce_frame(f, rest(remaining), fenv), rest_k)) + elif sx_truthy((ft == 'for-each')): + f = get(frame, 'f') + remaining = get(frame, 'remaining') + fenv = get(frame, 'env') + if sx_truthy(empty_p(remaining)): + return make_cek_value(NIL, fenv, rest_k) + else: + return continue_with_call(f, [first(remaining)], fenv, [], kont_push(make_for_each_frame(f, rest(remaining), fenv), rest_k)) + elif sx_truthy((ft == 'some')): + f = get(frame, 'f') + remaining = get(frame, 'remaining') + fenv = get(frame, 'env') + if sx_truthy(value): + return make_cek_value(value, fenv, rest_k) + else: + if sx_truthy(empty_p(remaining)): + return make_cek_value(False, fenv, rest_k) + else: + return continue_with_call(f, [first(remaining)], fenv, [], kont_push(make_some_frame(f, rest(remaining), fenv), rest_k)) + elif sx_truthy((ft == 'every')): + f = get(frame, 'f') + remaining = get(frame, 'remaining') + fenv = get(frame, 'env') + if sx_truthy((not sx_truthy(value))): + return make_cek_value(False, fenv, rest_k) + else: + if sx_truthy(empty_p(remaining)): + return make_cek_value(True, fenv, rest_k) + else: + return continue_with_call(f, [first(remaining)], fenv, [], kont_push(make_every_frame(f, rest(remaining), fenv), rest_k)) else: return error(sx_str('Unknown frame type: ', ft)) diff --git a/shared/sx/ref/test-cek-reactive.sx b/shared/sx/ref/test-cek-reactive.sx index 0669dcd..7d8ef41 100644 --- a/shared/sx/ref/test-cek-reactive.sx +++ b/shared/sx/ref/test-cek-reactive.sx @@ -209,3 +209,71 @@ (reset! s 3))) ;; batch should coalesce — effect runs once, not three times (assert-equal 2 (deref count))))) + + +;; -------------------------------------------------------------------------- +;; CEK-native higher-order forms +;; -------------------------------------------------------------------------- + +(defsuite "CEK higher-order forms" + (deftest "map through CEK" + (let ((result (eval-expr-cek + (sx-parse-one "(map (fn (x) (* x 2)) (list 1 2 3))") + (test-env)))) + (assert-equal (list 2 4 6) result))) + + (deftest "map-indexed through CEK" + (let ((result (eval-expr-cek + (sx-parse-one "(map-indexed (fn (i x) (+ i x)) (list 10 20 30))") + (test-env)))) + (assert-equal (list 10 21 32) result))) + + (deftest "filter through CEK" + (let ((result (eval-expr-cek + (sx-parse-one "(filter (fn (x) (> x 2)) (list 1 2 3 4 5))") + (test-env)))) + (assert-equal (list 3 4 5) result))) + + (deftest "reduce through CEK" + (let ((result (eval-expr-cek + (sx-parse-one "(reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3))") + (test-env)))) + (assert-equal 6 result))) + + (deftest "some through CEK" + (let ((result (eval-expr-cek + (sx-parse-one "(some (fn (x) (> x 3)) (list 1 2 3 4 5))") + (test-env)))) + (assert-true result))) + + (deftest "some returns false when none match" + (let ((result (eval-expr-cek + (sx-parse-one "(some (fn (x) (> x 10)) (list 1 2 3))") + (test-env)))) + (assert-false result))) + + (deftest "every? through CEK" + (let ((result (eval-expr-cek + (sx-parse-one "(every? (fn (x) (> x 0)) (list 1 2 3))") + (test-env)))) + (assert-true result))) + + (deftest "every? returns false on first falsy" + (let ((result (eval-expr-cek + (sx-parse-one "(every? (fn (x) (> x 2)) (list 1 2 3))") + (test-env)))) + (assert-false result))) + + (deftest "for-each through CEK" + (let ((log (list))) + (env-set! (test-env) "test-log" log) + (eval-expr-cek + (sx-parse-one "(for-each (fn (x) (append! test-log x)) (list 1 2 3))") + (test-env)) + (assert-equal (list 1 2 3) log))) + + (deftest "map on empty list" + (let ((result (eval-expr-cek + (sx-parse-one "(map (fn (x) x) (list))") + (test-env)))) + (assert-equal (list) result))))