erlang: receive...after Ms timeout clause (+9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-24 21:01:39 +00:00
parent d191f7cd9e
commit e2e801e38a
4 changed files with 125 additions and 6 deletions

View File

@@ -193,6 +193,8 @@
:continuation nil
:receive-pats nil
:trap-exit false
:has-timeout false
:timed-out false
:exit-reason nil}))
(dict-set! (er-sched-processes) (er-pid-key pid) proc)
(er-sched-enqueue! pid)
@@ -292,10 +294,40 @@
()
(let
((pid (er-sched-next-runnable!)))
(when
(cond
(not (= pid nil))
(er-sched-step! pid)
(er-sched-run-all!)))))
(do (er-sched-step! pid) (er-sched-run-all!))
;; Queue empty — fire one pending receive-with-timeout and go again.
(er-sched-fire-one-timeout!) (er-sched-run-all!)
:else nil))))
;; Wake one waiting process whose receive had an `after Ms` clause.
;; Returns true if one fired. In our synchronous model "time passes"
;; once the runnable queue drains — timeouts only fire then.
(define
er-sched-fire-one-timeout!
(fn
()
(let
((ks (keys (er-sched-processes))) (fired (list false)))
(for-each
(fn
(k)
(when
(not (nth fired 0))
(let
((p (get (er-sched-processes) k)))
(when
(and
(= (get p :state) "waiting")
(get p :has-timeout))
(dict-set! p :timed-out true)
(dict-set! p :has-timeout false)
(dict-set! p :state "runnable")
(er-sched-enqueue! (get p :pid))
(set-nth! fired 0 true)))))
ks)
(nth fired 0))))
(define
er-sched-step!

View File

@@ -369,6 +369,37 @@
(er-eval-test "receive nested tuple"
(ev "Me = self(), Me ! {result, {ok, 42}}, receive {result, {ok, V}} -> V end") 42)
;; ── receive ... after ... ───────────────────────────────────────
(er-eval-test "after 0 empty mailbox"
(nm (ev "receive _ -> got after 0 -> timeout end"))
"timeout")
(er-eval-test "after 0 match wins"
(nm (ev "Me = self(), Me ! ok, receive ok -> got after 0 -> timeout end"))
"got")
(er-eval-test "after 0 non-match fires timeout"
(nm (ev "Me = self(), Me ! wrong, receive right -> got after 0 -> timeout end"))
"timeout")
(er-eval-test "after 0 leaves non-match"
(ev "Me = self(), Me ! wrong, receive right -> got after 0 -> to end, receive X -> X end")
(er-mk-atom "wrong"))
(er-eval-test "after Ms no sender — timeout fires"
(nm (ev "receive _ -> got after 100 -> timed_out end"))
"timed_out")
(er-eval-test "after Ms with sender — match wins"
(nm (ev "Me = self(), spawn(fun () -> Me ! hi end), receive hi -> got after 100 -> to end"))
"got")
(er-eval-test "after Ms computed"
(nm (ev "Ms = 50, receive _ -> got after Ms -> done end"))
"done")
(er-eval-test "after 0 body side effect"
(do (er-io-flush!)
(ev "receive _ -> ok after 0 -> io:format(\"to~n\") end")
(er-io-buffer-content))
"to\n")
(er-eval-test "after zero poll selective"
(ev "Me = self(), Me ! first, Me ! second, X = receive second -> got_second after 0 -> to end, Y = receive first -> got_first after 0 -> to end, {X, Y}")
(er-mk-tuple (list (er-mk-atom "got_second") (er-mk-atom "got_first"))))
(define
er-eval-test-summary
(str "eval " er-eval-test-pass "/" er-eval-test-count))

View File

@@ -954,8 +954,12 @@
(fn
(node env)
(let
((pid (er-sched-current-pid)))
(er-eval-receive-loop node pid env))))
((pid (er-sched-current-pid))
(after-node (get node :after-ms)))
(if
(= after-node nil)
(er-eval-receive-loop node pid env)
(er-eval-receive-with-after node pid env after-node)))))
(define
er-eval-receive-loop
@@ -975,6 +979,57 @@
er-suspend-marker))
(er-eval-receive-loop node pid env))))))
(define
er-eval-receive-with-after
(fn
(node pid env after-node)
(let
((ms (er-eval-expr after-node env)))
(cond
(and (er-atom? ms) (= (get ms :name) "infinity"))
(er-eval-receive-loop node pid env)
(= ms 0) (er-eval-receive-poll node pid env)
:else (er-eval-receive-timed node pid env)))))
;; after 0 — poll once; on no match, run the after-body immediately.
(define
er-eval-receive-poll
(fn
(node pid env)
(let
((r (er-try-receive (get node :clauses) pid env)))
(if
(get r :matched)
(get r :value)
(er-eval-body (get node :after-body) env)))))
;; after Ms — suspend; on resume check :timed-out. When the scheduler
;; runs out of other work it fires one pending timeout per round.
(define
er-eval-receive-timed
(fn
(node pid env)
(let
((r (er-try-receive (get node :clauses) pid env)))
(if
(get r :matched)
(get r :value)
(do
(er-proc-set! pid :has-timeout true)
(shift
k
(do
(er-proc-set! pid :continuation k)
(er-proc-set! pid :state "waiting")
er-suspend-marker))
(if
(er-proc-field pid :timed-out)
(do
(er-proc-set! pid :timed-out false)
(er-proc-set! pid :has-timeout false)
(er-eval-body (get node :after-body) env))
(er-eval-receive-timed node pid env)))))))
;; Scan mailbox in arrival order. For each msg, try every clause.
;; On first match: remove that msg from mailbox and return body value.
(define

View File

@@ -67,7 +67,7 @@ Core mapping:
- [x] Scheduler in `runtime.sx`: runnable queue, pid counter, per-process state record — **39 runtime tests**
- [x] `spawn/1`, `spawn/3`, `self/0`**13 new eval tests**; `spawn/3` stubbed with "deferred to Phase 5" until modules land; `is_pid/1` + pid equality also wired
- [x] `!` (send), `receive ... end` with selective pattern matching — **13 new eval tests**; delimited continuations (`shift`/`reset`) power receive suspension; sync scheduler loop
- [ ] `receive ... after Ms -> ...` timeout clause (use SX timer primitive)
- [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
- [ ] `exit/1`, basic process termination
- [ ] Classic programs in `lib/erlang/tests/programs/`:
- [ ] `ring.erl` — N processes in a ring, pass a token around M times
@@ -99,6 +99,7 @@ Core mapping:
_Newest first._
- **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.
- **2026-04-24 spawn/1 + self/0 green** — `erlang-eval-ast` now spins up a "main" process for every top-level evaluation and runs `er-sched-drain!` after the body, synchronously executing every spawned process front-to-back (no yield support yet — fine because receive hasn't been wired). BIFs added in `lib/erlang/runtime.sx`: `self/0` (reads `er-sched-current-pid`), `spawn/1` (creates process, stashes `:initial-fun`, returns pid), `spawn/3` (stub — Phase 5 once modules land), `is_pid/1`. Pids added to `er-equal?` (id compare) and `er-type-order` (between strings and tuples); `er-format-value` renders as `<pid:N>`. 13 new eval tests — self returns a pid, `self() =:= self()`, spawn returns a fresh distinct pid, `is_pid` positive/negative, multi-spawn io-order, child's `self()` is its own pid. Total eval 143/143; runtime 39/39; suite 296/296. Next: `!` (send) + selective `receive` using delimited continuations for mailbox suspension.
- **2026-04-24 scheduler foundation green** — `lib/erlang/runtime.sx` + `lib/erlang/tests/runtime.sx`. Amortised-O(1) FIFO queue (`er-q-new`, `er-q-push!`, `er-q-pop!`, `er-q-peek`, `er-q-compact!` at 128-entry head drift), tagged pids `{:tag "pid" :id N}` with `er-pid?`/`er-pid-equal?`, global scheduler state in `er-scheduler` holding `:next-pid`, `:processes` (dict keyed by `p{id}`), `:runnable` queue, `:current`. Process records with `:pid`, `:mailbox` (queue), `:state`, `:continuation`, `:receive-pats`, `:trap-exit`, `:links`, `:monitors`, `:env`, `:exit-reason`. 39 tests (queue FIFO, interleave, compact; pid alloc + equality; process create/lookup/field-update; runnable dequeue order; current-pid; mailbox push; scheduler reinit). Total erlang suite 283/283. Next: `spawn/1`, `!`, `receive` wired into the evaluator.