From 21cb9cf51aff3a5df1246096527cd489ea3582e8 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 16:15:48 +0000 Subject: [PATCH] =?UTF-8?q?spec:=20coroutine=20primitive=20=E2=80=94=20mak?= =?UTF-8?q?e-coroutine/resume/yield=20via=20perform/cek-step-loop?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit spec/coroutines.sx: define-library with make-coroutine, coroutine-resume, coroutine-yield, coroutine?, coroutine-alive?. Built on existing perform/ cek-step-loop/cek-resume suspension machinery. spec/tests/test-coroutines.sx: 17 tests — multi-yield, final return, arg passthrough, alive? predicate, nested coroutines, recursive iteration, independent coroutine interleaving. Key: coroutine body must use (define loop (fn…)) not named let — named let transpiles to cek_call→cek_run which rejects IO suspension. All 17/17 pass. Co-Authored-By: Claude Sonnet 4.6 --- plans/agent-briefings/primitives-loop.md | 6 +- spec/coroutines.sx | 56 +++++++ spec/evaluator.sx | 2 + spec/primitives.sx | 2 + spec/tests/test-coroutines.sx | 202 +++++++++++++++++++++++ 5 files changed, 267 insertions(+), 1 deletion(-) create mode 100644 spec/coroutines.sx create mode 100644 spec/tests/test-coroutines.sx diff --git a/plans/agent-briefings/primitives-loop.md b/plans/agent-briefings/primitives-loop.md index 6794f587..afea1cc0 100644 --- a/plans/agent-briefings/primitives-loop.md +++ b/plans/agent-briefings/primitives-loop.md @@ -124,9 +124,12 @@ Erlang `try...after` (currently uses double-nested guard workaround). Unify Ruby fibers, Lua coroutines, Tcl coroutines — all currently reimplemented separately using call/cc+perform/resume. -- [ ] Spec: add `make-coroutine`, `coroutine-resume`, `coroutine-yield`, `coroutine?`, +- [x] Spec: add `make-coroutine`, `coroutine-resume`, `coroutine-yield`, `coroutine?`, `coroutine-alive?` to `spec/primitives.sx`. Build on existing `perform`/`cek-resume` machinery — coroutines ARE perform/resume with a stable identity. + Implemented as `spec/coroutines.sx` define-library; `make-coroutine` stub in evaluator.sx. + 17/17 coroutine tests pass (OCaml). Drives iteration via define+fn recursion (not named let — + named let uses cek_call→cek_run which errors on IO suspension). - [ ] OCaml: implement coroutine type; wire resume/yield through CEK suspension. - [ ] JS bootstrapper: update. - [ ] Tests: 25+ tests — multi-yield, final return, arg passthrough, alive? predicate, @@ -663,6 +666,7 @@ Brief each language's loop agent (or do inline) after rebasing their branch onto _Newest first._ +- 2026-04-26: Phase 4 Spec step done — spec/coroutines.sx define-library with make-coroutine/coroutine-resume/coroutine-yield/coroutine?/coroutine-alive?; make-coroutine stub in evaluator.sx; 17/17 coroutine tests pass (OCaml). Key insight: coroutine body must use (define loop (fn...)) + (loop 0) not named let — named let uses cek_call→cek_run which errors on IO suspension. - 2026-04-26: Phase 3 complete — OCaml+JS done. CallccContinuation gains winders-depth int; make_callcc_continuation/callcc_continuation_winders_len wired; wind-after/wind-return CekFrame fields fixed (cf_f=after-thunk, cf_extra=winders-len, cf_name=body-result); get_val + transpiler.sx updated. 8/8 dynamic-wind tests pass on OCaml; 235/235 (callcc+guard+do+r7rs) zero regressions. Committed 6602ec8c. - 2026-04-26: Phase 3 Spec+Tests done — dynamic-wind CEK implementation: wind-after/wind-return frames, *winders* stack, kont-unwind-to-handler, wind-escape-to. callcc frame stores winders-len in continuation; callcc-continuation? calls wind-escape-to before escape. 8/8 dynamic-wind tests pass (normal return, raise, call/cc, nested LIFO, guard ordering). 1948/2500 JS (+8). Zero regressions. Committed a9d5a108. - 2026-04-26: Phase 2 complete — Verify+Commit done. OCaml 4874/394, JS 1940/2500 (+60). No regressions. 6 JS-only failures are float≡int platform-inherent. Phase 2 fully landed across 4 commits. diff --git a/spec/coroutines.sx b/spec/coroutines.sx new file mode 100644 index 00000000..64726f81 --- /dev/null +++ b/spec/coroutines.sx @@ -0,0 +1,56 @@ +(define-library + (sx coroutines) + (export + make-coroutine + coroutine? + coroutine-alive? + coroutine-yield + coroutine-handle-result + coroutine-resume) + (begin + (define make-coroutine (fn (thunk) {:suspension nil :thunk thunk :type "coroutine" :state "ready"})) + (define + coroutine? + (fn (v) (and (dict? v) (= (get v "type") "coroutine")))) + (define + coroutine-alive? + (fn (c) (and (coroutine? c) (not (= (get c "state") "dead"))))) + (define coroutine-yield (fn (val) (perform {:value val :op "coroutine-yield"}))) + (define + coroutine-handle-result + (fn + (c result) + (if + (cek-terminal? result) + (do (dict-set! c "state" "dead") {:done true :value (cek-value result)}) + (let + ((request (cek-io-request result))) + (if + (and (dict? request) (= (get request "op") "coroutine-yield")) + (do + (dict-set! c "state" "suspended") + (dict-set! c "suspension" result) + {:done false :value (get request "value")}) + (perform request)))))) + (define + coroutine-resume + (fn + (c val) + (cond + (not (coroutine? c)) + (error "coroutine-resume: not a coroutine") + (= (get c "state") "dead") + (error "coroutine-resume: coroutine is dead") + (= (get c "state") "ready") + (do + (dict-set! c "state" "running") + (coroutine-handle-result + c + (cek-step-loop + (make-cek-state (list (get c "thunk")) (make-env) (list))))) + (= (get c "state") "suspended") + (do + (dict-set! c "state" "running") + (coroutine-handle-result c (cek-resume (get c "suspension") val))) + :else (error + (str "coroutine-resume: unexpected state: " (get c "state")))))))) diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 75d7f399..b60623e3 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -4431,6 +4431,8 @@ (val) (if (thunk? val) (eval-expr-cek (thunk-expr val) (thunk-env val)) val))) +(define make-coroutine (fn (thunk) {:suspension nil :thunk thunk :type "coroutine" :state "ready"})) + (define eval-expr (fn (expr (env :as dict)) (cek-run (make-cek-state expr env (list))))) diff --git a/spec/primitives.sx b/spec/primitives.sx index 4cf7dd56..4a18cb90 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -797,3 +797,5 @@ :params ((source :as string)) :returns "list" :doc "Parse SX source string into a list of AST expressions.") + +(define-module :stdlib.coroutines) diff --git a/spec/tests/test-coroutines.sx b/spec/tests/test-coroutines.sx new file mode 100644 index 00000000..1ca47240 --- /dev/null +++ b/spec/tests/test-coroutines.sx @@ -0,0 +1,202 @@ +(import (sx coroutines)) + +(defsuite + "coroutine" + (deftest + "coroutine? recognizes coroutine objects" + (let + ((co (make-coroutine (fn () nil)))) + (assert (coroutine? co)) + (assert= false (coroutine? 42)) + (assert= false (coroutine? "hello")) + (assert= false (coroutine? nil)) + (assert= false (coroutine? (list))))) + (deftest + "coroutine-alive? true for ready coroutine" + (let + ((co (make-coroutine (fn () nil)))) + (assert (coroutine-alive? co)))) + (deftest + "coroutine-alive? false for non-coroutine" + (assert= false (coroutine-alive? 42))) + (deftest + "immediate return — done true, value is body result" + (let + ((co (make-coroutine (fn () 42)))) + (let + ((r (coroutine-resume co nil))) + (assert= true (get r "done")) + (assert= 42 (get r "value"))))) + (deftest + "immediate nil return" + (let + ((co (make-coroutine (fn () nil)))) + (let + ((r (coroutine-resume co nil))) + (assert= true (get r "done")) + (assert= nil (get r "value"))))) + (deftest + "coroutine-alive? false after completion" + (let + ((co (make-coroutine (fn () nil)))) + (coroutine-resume co nil) + (assert= false (coroutine-alive? co)))) + (deftest + "single yield — done false on yield, done true on finish" + (let + ((co (make-coroutine (fn () (coroutine-yield 10) 20)))) + (let + ((r1 (coroutine-resume co nil))) + (let + ((r2 (coroutine-resume co nil))) + (assert= false (get r1 "done")) + (assert= 10 (get r1 "value")) + (assert= true (get r2 "done")) + (assert= 20 (get r2 "value")))))) + (deftest + "coroutine-alive? true between yield and next resume" + (let + ((co (make-coroutine (fn () (coroutine-yield nil) nil)))) + (assert (coroutine-alive? co)) + (coroutine-resume co nil) + (assert (coroutine-alive? co)) + (coroutine-resume co nil) + (assert= false (coroutine-alive? co)))) + (deftest + "three yields then return" + (let + ((co (make-coroutine (fn () (coroutine-yield "a") (coroutine-yield "b") (coroutine-yield "c") "z")))) + (let + ((r1 (coroutine-resume co nil))) + (let + ((r2 (coroutine-resume co nil))) + (let + ((r3 (coroutine-resume co nil))) + (let + ((r4 (coroutine-resume co nil))) + (assert= "a" (get r1 "value")) + (assert= false (get r1 "done")) + (assert= "b" (get r2 "value")) + (assert= false (get r2 "done")) + (assert= "c" (get r3 "value")) + (assert= false (get r3 "done")) + (assert= "z" (get r4 "value")) + (assert= true (get r4 "done")))))))) + (deftest + "final return vs yield — done flag distinguishes them" + (let + ((co (make-coroutine (fn () (coroutine-yield "yielded") "returned")))) + (let + ((y (coroutine-resume co nil))) + (let + ((r (coroutine-resume co nil))) + (assert= false (get y "done")) + (assert= "yielded" (get y "value")) + (assert= true (get r "done")) + (assert= "returned" (get r "value")))))) + (deftest + "resume val becomes yield return value" + (let + ((co (make-coroutine (fn () (let ((received (coroutine-yield "first"))) received))))) + (let + ((r1 (coroutine-resume co nil))) + (let + ((r2 (coroutine-resume co 99))) + (assert= "first" (get r1 "value")) + (assert= false (get r1 "done")) + (assert= 99 (get r2 "value")) + (assert= true (get r2 "done")))))) + (deftest + "multiple resume values passed through yields" + (let + ((co (make-coroutine (fn () (let ((a (coroutine-yield 1))) (let ((b (coroutine-yield 2))) (+ a b))))))) + (let + ((r1 (coroutine-resume co nil))) + (let + ((r2 (coroutine-resume co 10))) + (let + ((r3 (coroutine-resume co 20))) + (assert= 1 (get r1 "value")) + (assert= 2 (get r2 "value")) + (assert= true (get r3 "done")) + (assert= 30 (get r3 "value"))))))) + (deftest + "coroutine captures lexical environment" + (let + ((x 10) + (co + (make-coroutine + (fn () (coroutine-yield (* x 2)) (* x 3))))) + (let + ((r1 (coroutine-resume co nil))) + (let + ((r2 (coroutine-resume co nil))) + (assert= 20 (get r1 "value")) + (assert= 30 (get r2 "value")))))) + (deftest + "resuming dead coroutine raises error" + (let + ((co (make-coroutine (fn () nil)))) + (coroutine-resume co nil) + (assert-throws (fn () (coroutine-resume co nil))))) + (deftest + "coroutine drives iteration via recursive body" + (let + ((co (make-coroutine (fn () (define loop (fn (i) (when (< i 4) (coroutine-yield i) (loop (+ i 1))))) (loop 0)))) + (results (list))) + (let + drive + () + (let + ((r (coroutine-resume co nil))) + (when + (not (get r "done")) + (append! results (get r "value")) + (drive)))) + (assert= 4 (len results)) + (assert= 0 (nth results 0)) + (assert= 1 (nth results 1)) + (assert= 2 (nth results 2)) + (assert= 3 (nth results 3)))) + (deftest + "nested coroutine — inner resumed from outer body" + (let + ((inner (make-coroutine (fn () (coroutine-yield "inner-a") "inner-done"))) + (outer + (make-coroutine + (fn + () + (let + ((i1 (coroutine-resume inner nil))) + (coroutine-yield (get i1 "value"))) + (let ((i2 (coroutine-resume inner nil))) (get i2 "value")))))) + (let + ((o1 (coroutine-resume outer nil))) + (let + ((o2 (coroutine-resume outer nil))) + (assert= false (get o1 "done")) + (assert= "inner-a" (get o1 "value")) + (assert= true (get o2 "done")) + (assert= "inner-done" (get o2 "value")))))) + (deftest + "two independent coroutines interleave correctly" + (let + ((co1 (make-coroutine (fn () (coroutine-yield 1) 5))) + (co2 + (make-coroutine (fn () (coroutine-yield 2) 6)))) + (let + ((a (coroutine-resume co1 nil))) + (let + ((b (coroutine-resume co2 nil))) + (let + ((c (coroutine-resume co1 nil))) + (let + ((d (coroutine-resume co2 nil))) + (assert= false (get a "done")) + (assert= 1 (get a "value")) + (assert= false (get b "done")) + (assert= 2 (get b "value")) + (assert= true (get c "done")) + (assert= 5 (get c "value")) + (assert= true (get d "done")) + (assert= 6 (get d "value")))))))))