coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

erlang: ring.erl + call/cc suspension rewrite (+4 ring tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-24 22:24:17 +00:00
parent 97513e5b96
commit 2a3340f8e1
4 changed files with 170 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
lib/erlang/transpile.sx
View File

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