erlang: ring.erl + call/cc suspension rewrite (+4 ring tests)

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

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))

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 <clause 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))))))))