diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index aec52dfb..4d1d49f4 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -88,6 +88,26 @@ (range h (len items))) out))) +;; Read the i'th entry (relative to head) without popping. +(define + er-q-nth + (fn (q i) (nth (get q :items) (+ (get q :head-idx) i)))) + +;; Remove entry at logical index i, shift tail in. +(define + er-q-delete-at! + (fn + (q i) + (let + ((h (get q :head-idx)) (items (get q :items)) (new (list))) + (for-each + (fn + (j) + (when (not (= j (+ h i))) (append! new (nth items j)))) + (range h (len items))) + (dict-set! q :items new) + (dict-set! q :head-idx 0)))) + ;; ── pids ───────────────────────────────────────────────────────── (define er-mk-pid (fn (id) {:id id :tag "pid"})) (define er-pid? (fn (v) (er-is-tagged? v "pid"))) @@ -251,25 +271,57 @@ (get proc :pid))))) ;; ── scheduler loop ────────────────────────────────────────────── -;; Drain all runnable processes to completion. Synchronous — each -;; spawned process runs its :initial-fun front-to-back with no yielding. -;; receive-driven suspension arrives in the next roadmap step. +;; 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. +(define er-suspend-marker {:tag "er-suspend-marker"}) + (define - er-sched-drain! + er-suspended? + (fn + (v) + (and + (= (type-of v) "dict") + (= (get v :tag) "er-suspend-marker")))) + +(define + er-sched-run-all! (fn () (let ((pid (er-sched-next-runnable!))) (when (not (= pid nil)) - (er-sched-set-current! pid) - (er-proc-set! pid :state "running") - (let - ((fv (er-proc-field pid :initial-fun))) - (when - (not (= fv nil)) - (er-apply-fun fv (list)))) - (er-proc-set! pid :state "dead") - (er-proc-set! pid :exit-reason (er-mk-atom "normal")) - (er-sched-set-current! nil) - (er-sched-drain!))))) + (er-sched-step! pid) + (er-sched-run-all!))))) + +(define + er-sched-step! + (fn + (pid) + (er-sched-set-current! pid) + (er-proc-set! pid :state "running") + (let + ((prev-k (er-proc-field pid :continuation)) + (result-ref (list nil))) + (if + (= prev-k nil) + (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)))) + (let + ((r (nth result-ref 0))) + (cond + (er-suspended? r) nil + :else (do + (er-proc-set! pid :state "dead") + (er-proc-set! pid :exit-reason (er-mk-atom "normal")) + (er-proc-set! pid :exit-result r) + (er-proc-set! pid :continuation nil))))) + (er-sched-set-current! nil))) diff --git a/lib/erlang/tests/eval.sx b/lib/erlang/tests/eval.sx index cd8347ba..ab2ba4f3 100644 --- a/lib/erlang/tests/eval.sx +++ b/lib/erlang/tests/eval.sx @@ -327,6 +327,48 @@ (er-io-buffer-content)) "true;true") +;; ── ! (send) + receive ────────────────────────────────────────── +(er-eval-test "self-send + receive" + (nm (ev "Me = self(), Me ! hello, receive Msg -> Msg end")) "hello") +(er-eval-test "send returns msg" + (nm (ev "Me = self(), Msg = Me ! ok, Me ! x, receive _ -> Msg end")) "ok") +(er-eval-test "receive int" + (ev "Me = self(), Me ! 42, receive N -> N + 1 end") 43) +(er-eval-test "receive with pattern" + (ev "Me = self(), Me ! {ok, 7}, receive {ok, V} -> V * 2 end") 14) +(er-eval-test "receive with guard" + (ev "Me = self(), Me ! 5, receive N when N > 0 -> positive end") + (er-mk-atom "positive")) +(er-eval-test "receive skips non-match" + (nm (ev "Me = self(), Me ! wrong, Me ! right, receive right -> ok end")) + "ok") +(er-eval-test "receive selective leaves others" + (nm (ev "Me = self(), Me ! a, Me ! b, receive b -> got_b end")) + "got_b") +(er-eval-test "two receives consume both" + (ev "Me = self(), Me ! 1, Me ! 2, X = receive A -> A end, Y = receive B -> B end, X + Y") 3) + +;; ── spawn + send + receive (real process communication) ───────── +(er-eval-test "spawn sends back" + (nm + (ev "Me = self(), spawn(fun () -> Me ! pong end), receive pong -> got_pong end")) + "got_pong") +(er-eval-test "ping-pong" + (do + (er-io-flush!) + (ev "Me = self(), Child = spawn(fun () -> receive {ping, From} -> From ! pong end end), Child ! {ping, Me}, receive pong -> io:format(\"pong~n\") end") + (er-io-buffer-content)) + "pong\n") +(er-eval-test "echo server" + (ev "Me = self(), Echo = spawn(fun () -> receive {From, Msg} -> From ! Msg end end), Echo ! {Me, 99}, receive R -> R end") 99) + +;; ── receive with multiple clauses ──────────────────────────────── +(er-eval-test "receive multi-clause" + (nm (ev "Me = self(), Me ! foo, receive ok -> a; foo -> b; bar -> c end")) + "b") +(er-eval-test "receive nested tuple" + (ev "Me = self(), Me ! {result, {ok, 42}}, receive {result, {ok, V}} -> V end") 42) + (define er-eval-test-summary (str "eval " er-eval-test-pass "/" er-eval-test-count)) diff --git a/lib/erlang/transpile.sx b/lib/erlang/transpile.sx index f92d4405..672509d3 100644 --- a/lib/erlang/transpile.sx +++ b/lib/erlang/transpile.sx @@ -64,20 +64,27 @@ ((body (er-parse-body st))) (er-sched-init!) (let - ((main (er-proc-new! (er-env-new)))) - (er-sched-next-runnable!) - (er-sched-set-current! (get main :pid)) - (er-proc-set! (get main :pid) :state "running") + ((env (er-env-new))) (let - ((result (er-eval-body body (get main :env)))) - (er-proc-set! (get main :pid) :state "dead") - (er-proc-set! - (get main :pid) - :exit-reason - (er-mk-atom "normal")) - (er-sched-set-current! nil) - (er-sched-drain!) - result)))))) + ((main-fun + (er-mk-fun + (list + {:patterns (list) + :body body + :guards (list) + :name nil}) + env))) + (let + ((main-proc (er-proc-new! env))) + (dict-set! main-proc :initial-fun main-fun) + (er-sched-run-all!) + (let + ((main-pid (get main-proc :pid))) + (if + (not (= (er-proc-field main-pid :state) "dead")) + (error + "Erlang: deadlock — main process never terminated") + (er-proc-field main-pid :exit-result)))))))))) (define er-eval-body @@ -113,6 +120,8 @@ (= ty "case") (er-eval-case node env) (= ty "call") (er-eval-call node env) (= ty "fun") (er-eval-fun node env) + (= ty "send") (er-eval-send node env) + (= ty "receive") (er-eval-receive node env) (= ty "match") (er-eval-match node env) :else (error (str "Erlang eval: unsupported node type '" ty "'")))))) @@ -917,3 +926,94 @@ (append! out (er-format-value (nth elems i)))) (range 1 (len elems))) (reduce str "" out))))) + +;; ── send: Pid ! Msg ────────────────────────────────────────────── +(define + er-eval-send + (fn + (node env) + (let + ((to-val (er-eval-expr (get node :to) env)) + (msg-val (er-eval-expr (get node :msg) env))) + (if + (not (er-pid? to-val)) + (error "Erlang: '!': target is not a pid") + (do + (when + (er-proc-exists? to-val) + (er-proc-mailbox-push! to-val msg-val) + (when + (= (er-proc-field to-val :state) "waiting") + (er-proc-set! to-val :state "runnable") + (er-sched-enqueue! to-val))) + msg-val))))) + +;; ── receive (selective, delimited-continuation suspension) ────── +(define + er-eval-receive + (fn + (node env) + (let + ((pid (er-sched-current-pid))) + (er-eval-receive-loop node pid env)))) + +(define + er-eval-receive-loop + (fn + (node pid env) + (let + ((r (er-try-receive (get node :clauses) pid env))) + (if + (get r :matched) + (get r :value) + (do + (shift + k + (do + (er-proc-set! pid :continuation k) + (er-proc-set! pid :state "waiting") + er-suspend-marker)) + (er-eval-receive-loop 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 + er-try-receive + (fn + (clauses pid env) + (let + ((mbox (er-proc-field pid :mailbox))) + (er-try-receive-loop clauses mbox env 0)))) + +(define + er-try-receive-loop + (fn + (clauses mbox env i) + (if + (>= i (er-q-len mbox)) + {:matched false} + (let + ((msg (er-q-nth mbox i)) + (cr (er-try-receive-clauses clauses msg env 0))) + (if + (get cr :matched) + (do (er-q-delete-at! mbox i) cr) + (er-try-receive-loop clauses mbox env (+ i 1))))))) + +(define + er-try-receive-clauses + (fn + (clauses msg env i) + (if + (>= i (len clauses)) + {:matched false} + (let + ((c (nth clauses i)) (snap (er-env-copy env))) + (if + (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} + (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 05cf96a5..5bce58ef 100644 --- a/plans/erlang-on-sx.md +++ b/plans/erlang-on-sx.md @@ -66,7 +66,7 @@ Core mapping: ### Phase 3 — processes + mailboxes + receive (THE SHOWCASE) - [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 -- [ ] `!` (send), `receive ... end` with selective pattern matching +- [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) - [ ] `exit/1`, basic process termination - [ ] Classic programs in `lib/erlang/tests/programs/`: @@ -99,6 +99,7 @@ Core mapping: _Newest first._ +- **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 ``. 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. - **2026-04-24 core BIFs + funs green** — Phase 2 complete. Added to `lib/erlang/transpile.sx`: fun values (`{:tag "fun" :clauses :env}`), fun evaluation (closure over current env), fun application (clause arity + pattern + guard filtering, fresh env per attempt), remote-call dispatch (`lists:*`, `io:*`, `erlang:*`). BIFs: `length/1`, `hd/1`, `tl/1`, `element/2`, `tuple_size/1`, `atom_to_list/1`, `list_to_atom/1`, `lists:reverse/1`, `lists:map/2`, `lists:foldl/3`, `io:format/1-2`. `io:format` writes to a capture buffer (`er-io-buffer`, `er-io-flush!`, `er-io-buffer-content`) and returns `ok` — supports `~n`, `~p`/`~w`/`~s`, `~~`. 35 new eval tests. Total eval 130/130; erlang suite 244/244. **Phase 2 complete — Phase 3 (processes, scheduler, receive) is next.**