From 2a3340f8e1bd4232a26f4b947f83cb7a27c54a25 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 22:24:17 +0000 Subject: [PATCH] erlang: ring.erl + call/cc suspension rewrite (+4 ring tests) --- lib/erlang/runtime.sx | 34 ++++---- lib/erlang/tests/programs/ring.sx | 132 ++++++++++++++++++++++++++++++ lib/erlang/transpile.sx | 27 +++--- plans/erlang-on-sx.md | 3 +- 4 files changed, 170 insertions(+), 26 deletions(-) create mode 100644 lib/erlang/tests/programs/ring.sx diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index 9d7a15f5..ce64078d 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -293,21 +293,23 @@ (fn (vs) (cond - (= (len vs) 1) - (let - ((reason (nth vs 0))) - (shift k (er-mk-exit-marker reason))) + (= (len vs) 1) (raise (er-mk-exit-marker (nth vs 0))) (= (len vs) 2) (error "Erlang: exit/2 (signal another process) deferred to Phase 4 (links)") :else (error "Erlang: exit: wrong arity")))) ;; ── scheduler loop ────────────────────────────────────────────── -;; Each process's entry runs inside a `reset`; `receive` uses `shift` -;; to suspend (saving a continuation on the proc record). When a `!` -;; delivers a message to a waiting process we re-enqueue it — the -;; scheduler step invokes the saved continuation, which retries the -;; receive against the updated mailbox. +;; Each scheduler step wraps the process body in `guard`. `receive` +;; with no match captures a `call/cc` continuation onto the proc +;; record and then `raise`s `er-suspend-marker`; the guard catches +;; the raise and the scheduler moves on. `exit/1` raises an exit +;; marker the same way. Resumption from a saved continuation also +;; runs under a fresh `guard` so a resumed receive that needs to +;; suspend again has a handler to unwind to. `shift`/`reset` aren't +;; usable here because SX's captured delimited continuations don't +;; re-establish their own reset boundary when invoked — a second +;; suspension during replay raises "shift without enclosing reset". (define er-suspend-marker {:tag "er-suspend-marker"}) (define @@ -380,15 +382,17 @@ (let ((prev-k (er-proc-field pid :continuation)) (result-ref (list nil))) - (if - (= prev-k nil) + (guard + (c + ((er-suspended? c) (set-nth! result-ref 0 c)) + ((er-exited? c) (set-nth! result-ref 0 c))) (set-nth! result-ref 0 - (reset (er-apply-fun (er-proc-field pid :initial-fun) (list)))) - (do - (er-proc-set! pid :continuation nil) - (set-nth! result-ref 0 (prev-k nil)))) + (if + (= prev-k nil) + (er-apply-fun (er-proc-field pid :initial-fun) (list)) + (do (er-proc-set! pid :continuation nil) (prev-k nil))))) (let ((r (nth result-ref 0))) (cond diff --git a/lib/erlang/tests/programs/ring.sx b/lib/erlang/tests/programs/ring.sx new file mode 100644 index 00000000..2ef1f1cd --- /dev/null +++ b/lib/erlang/tests/programs/ring.sx @@ -0,0 +1,132 @@ +;; Ring program — N processes in a ring, token passes M times. +;; +;; Each process waits for {setup, Next} so main can tie the knot +;; (can't reference a pid before spawning it). Once wired, main +;; injects the first token; each process forwards decrementing K +;; until it hits 0, at which point it signals `done` to main. + +(define er-ring-test-count 0) +(define er-ring-test-pass 0) +(define er-ring-test-fails (list)) + +(define + er-ring-test + (fn + (name actual expected) + (set! er-ring-test-count (+ er-ring-test-count 1)) + (if + (= actual expected) + (set! er-ring-test-pass (+ er-ring-test-pass 1)) + (append! er-ring-test-fails {:actual actual :expected expected :name name})))) + +(define ring-ev erlang-eval-ast) + +(define + er-ring-program-3-6 + "Me = self(), + Spawner = fun () -> + receive {setup, Next} -> + Loop = fun () -> + receive + {token, 0, Parent} -> Parent ! done; + {token, K, Parent} -> Next ! {token, K-1, Parent}, Loop() + end + end, + Loop() + end + end, + P1 = spawn(Spawner), + P2 = spawn(Spawner), + P3 = spawn(Spawner), + P1 ! {setup, P2}, + P2 ! {setup, P3}, + P3 ! {setup, P1}, + P1 ! {token, 5, Me}, + receive done -> finished end") + +(er-ring-test + "ring N=3 M=6" + (get (ring-ev er-ring-program-3-6) :name) + "finished") + +;; Two-node ring — token bounces twice between P1 and P2. +(er-ring-test + "ring N=2 M=4" + (get (ring-ev + "Me = self(), + Spawner = fun () -> + receive {setup, Next} -> + Loop = fun () -> + receive + {token, 0, Parent} -> Parent ! done; + {token, K, Parent} -> Next ! {token, K-1, Parent}, Loop() + end + end, + Loop() + end + end, + P1 = spawn(Spawner), + P2 = spawn(Spawner), + P1 ! {setup, P2}, + P2 ! {setup, P1}, + P1 ! {token, 3, Me}, + receive done -> done end") :name) + "done") + +;; Single-node "ring" — P sends to itself M times. +(er-ring-test + "ring N=1 M=5" + (get (ring-ev + "Me = self(), + Spawner = fun () -> + receive {setup, Next} -> + Loop = fun () -> + receive + {token, 0, Parent} -> Parent ! finished_loop; + {token, K, Parent} -> Next ! {token, K-1, Parent}, Loop() + end + end, + Loop() + end + end, + P = spawn(Spawner), + P ! {setup, P}, + P ! {token, 4, Me}, + receive finished_loop -> ok end") :name) + "ok") + +;; Confirm the token really went around — count hops via io-buffer. +(er-ring-test + "ring N=3 M=9 hop count" + (do + (er-io-flush!) + (ring-ev + "Me = self(), + Spawner = fun () -> + receive {setup, Next} -> + Loop = fun () -> + receive + {token, 0, Parent} -> Parent ! done; + {token, K, Parent} -> + io:format(\"~p \", [K]), + Next ! {token, K-1, Parent}, + Loop() + end + end, + Loop() + end + end, + P1 = spawn(Spawner), + P2 = spawn(Spawner), + P3 = spawn(Spawner), + P1 ! {setup, P2}, + P2 ! {setup, P3}, + P3 ! {setup, P1}, + P1 ! {token, 8, Me}, + receive done -> done end") + (er-io-buffer-content)) + "8 7 6 5 4 3 2 1 ") + +(define + er-ring-test-summary + (str "ring " er-ring-test-pass "/" er-ring-test-count)) diff --git a/lib/erlang/transpile.sx b/lib/erlang/transpile.sx index 30409984..88bf8d68 100644 --- a/lib/erlang/transpile.sx +++ b/lib/erlang/transpile.sx @@ -972,12 +972,12 @@ (get r :matched) (get r :value) (do - (shift - k - (do + (call/cc + (fn + (k) (er-proc-set! pid :continuation k) (er-proc-set! pid :state "waiting") - er-suspend-marker)) + (raise er-suspend-marker))) (er-eval-receive-loop node pid env)))))) (define @@ -1017,12 +1017,12 @@ (get r :value) (do (er-proc-set! pid :has-timeout true) - (shift - k - (do + (call/cc + (fn + (k) (er-proc-set! pid :continuation k) (er-proc-set! pid :state "waiting") - er-suspend-marker)) + (raise er-suspend-marker))) (if (er-proc-field pid :timed-out) (do @@ -1053,9 +1053,16 @@ (cr (er-try-receive-clauses clauses msg env 0))) (if (get cr :matched) - (do (er-q-delete-at! mbox i) cr) + (do + (er-q-delete-at! mbox i) + {:value (er-eval-body (get cr :body) env) :matched true}) (er-try-receive-loop clauses mbox env (+ i 1))))))) +;; Try clauses against a message. On match: bind vars into env and +;; return `{:matched true :body }` WITHOUT evaluating the +;; body — the caller must remove the message from the mailbox first, +;; otherwise a recursive `receive` inside the body would re-match the +;; same msg and loop forever. (define er-try-receive-clauses (fn @@ -1069,7 +1076,7 @@ (and (er-match! (get c :pattern) msg env) (er-eval-guards (get c :guards) env)) - {:value (er-eval-body (get c :body) env) :matched true} + {:body (get c :body) :matched true} (do (er-env-restore! env snap) (er-try-receive-clauses clauses msg env (+ i 1)))))))) diff --git a/plans/erlang-on-sx.md b/plans/erlang-on-sx.md index ad61dd4d..236ca193 100644 --- a/plans/erlang-on-sx.md +++ b/plans/erlang-on-sx.md @@ -70,7 +70,7 @@ Core mapping: - [x] `receive ... after Ms -> ...` timeout clause (use SX timer primitive) — **9 new eval tests**; synchronous-scheduler semantics: `after 0` polls once; `after Ms` fires when runnable queue drains; `after infinity` = no timeout - [x] `exit/1`, basic process termination — **9 new eval tests**; `exit/2` (signal another) deferred to Phase 4 with links - [ ] Classic programs in `lib/erlang/tests/programs/`: - - [ ] `ring.erl` — N processes in a ring, pass a token around M times + - [x] `ring.erl` — N processes in a ring, pass a token around M times — **4 ring tests**; suspension machinery rewritten from `shift`/`reset` to `call/cc` + `raise`/`guard` - [ ] `ping_pong.erl` — two processes exchanging messages - [ ] `bank.erl` — account server (deposit/withdraw/balance) - [ ] `echo.erl` — minimal server @@ -99,6 +99,7 @@ Core mapping: _Newest first._ +- **2026-04-24 ring.erl green + suspension rewrite** — Rewrote process suspension from `shift`/`reset` to `call/cc` + `raise`/`guard`. **Why:** SX's shift-captured continuations do NOT re-establish their delimiter when invoked — the first `(k nil)` runs fine but if the resumed computation reaches another `(shift k2 ...)` it raises "shift without enclosing reset". Ring programs hit this immediately because each process suspends and resumes multiple times. `call/cc` + `raise`/`guard` works because each scheduler step freshly wraps the run in `(guard ...)`, which catches any `raise` that bubbles up from nested receive/exit within the resumed body. Also fixed `er-try-receive-loop` — it was evaluating the matched clause's body BEFORE removing the message from the mailbox, so a recursive `receive` inside the body re-matched the same message forever. Added `lib/erlang/tests/programs/ring.sx` with 4 tests (N=3 M=6, N=2 M=4, N=1 M=5 self-loop, N=3 M=9 hop-count via io-buffer). All process-communication eval tests still pass. Total suite 331/331. - **2026-04-24 exit/1 + termination green** — `exit/1` BIF uses `(shift k ...)` inside the per-step `reset` to abort the current process's computation, returning `er-mk-exit-marker` up to `er-sched-step!`. Step handler records `:exit-reason`, clears `:exit-result`, marks dead. Normal fall-off-end still records reason `normal`. `exit/2` errors with "deferred to Phase 4 (links)". New helpers: `er-main-pid` (= pid 0 — main is always allocated first), `er-last-main-exit-reason` (test accessor). 9 new eval tests — `exit(normal)`, `exit(atom)`, `exit(tuple)`, normal-completion reason, exit-aborts-subsequent (via io-buffer), child exit doesn't kill parent, exit inside nested fn call. Total eval 174/174; suite 327/327. - **2026-04-24 receive...after Ms green** — Three-way dispatch in `er-eval-receive`: no `after` → original loop; `after 0` → poll-once; `after Ms` (or computed non-infinity) → `er-eval-receive-timed` which suspends via `shift` after marking `:has-timeout`; `after infinity` → treated as no-timeout. `er-sched-run-all!` now recurses into `er-sched-fire-one-timeout!` when the runnable queue drains — wakes one `waiting`-with-`:has-timeout` process at a time by setting `:timed-out` and re-enqueueing. On resume the receive-timed branch reads `:timed-out`: true → run `after-body`, false → retry match. "Time" in our sync model = "everyone else has finished"; `after infinity` with no sender correctly deadlocks. 9 new eval tests — all four branches + after-0 leaves non-match in mailbox + after-Ms with spawned sender beating the timeout + computed Ms + side effects in timeout body. Total eval 165/165; suite 318/318. - **2026-04-24 send + selective receive green — THE SHOWCASE** — `!` (send) in `lib/erlang/transpile.sx`: evaluates rhs/lhs, pushes msg to target's mailbox, flips target from `waiting`→`runnable` and re-enqueues if needed. `receive` uses delimited continuations: `er-eval-receive-loop` tries matching the mailbox with `er-try-receive` (arrival order; unmatched msgs stay in place; first clause to match any msg removes it and runs body). On no match, `(shift k ...)` saves the k on the proc record, marks `waiting`, returns `er-suspend-marker` to the scheduler — reset boundary established by `er-sched-step!`. Scheduler loop `er-sched-run-all!` pops runnable pids and calls either `(reset ...)` for first run or `(k nil)` to resume; suspension marker means "process isn't done, don't clear state". `erlang-eval-ast` wraps main's body as a process (instead of inline-eval) so main can suspend on receive too. Queue helpers added: `er-q-nth`, `er-q-delete-at!`. 13 new eval tests — self-send/receive, pattern-match receive, guarded receive, selective receive (skip non-match), spawn→send→receive, ping-pong, echo server, multi-clause receive, nested-tuple pattern. Total eval 156/156; suite 309/309. Deadlock detected if main never terminates.