From 8e809614baa966e8a89a190e0b6145b13795ae78 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 05:43:57 +0000 Subject: [PATCH] erlang: register/whereis, Phase 5 complete (+12 tests) --- lib/erlang/runtime.sx | 101 +++++++++++++++++++++++++++++++++++++ lib/erlang/scoreboard.json | 6 +-- lib/erlang/scoreboard.md | 4 +- lib/erlang/tests/eval.sx | 59 ++++++++++++++++++++++ lib/erlang/transpile.sx | 46 +++++++++++++---- plans/erlang-on-sx.md | 3 +- 6 files changed, 202 insertions(+), 17 deletions(-) diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index 362a2a84..c8d19a27 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -149,6 +149,7 @@ :next-ref 0 :current nil :processes {} + :registered {} :runnable (er-q-new)}))) (define er-sched (fn () (nth er-scheduler 0))) @@ -324,6 +325,104 @@ er-bif-is-reference (fn (vs) (er-bool (er-ref? (er-bif-arg1 vs "is_reference"))))) +;; ── name registry ───────────────────────────────────────────── +(define er-registered (fn () (get (er-sched) :registered))) + +(define + er-bif-register + (fn + (vs) + (if + (not (= (len vs) 2)) + (error "Erlang: register/2: arity") + (let + ((name (nth vs 0)) (pid (nth vs 1))) + (cond + (not (er-atom? name)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (not (er-pid? pid)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (not (er-proc-exists? pid)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (dict-has? (er-registered) (get name :name)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (do + (dict-set! (er-registered) (get name :name) pid) + (er-mk-atom "true"))))))) + +(define + er-bif-unregister + (fn + (vs) + (let + ((name (er-bif-arg1 vs "unregister"))) + (cond + (not (er-atom? name)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (not (dict-has? (er-registered) (get name :name))) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (do + (dict-delete! (er-registered) (get name :name)) + (er-mk-atom "true")))))) + +(define + er-bif-whereis + (fn + (vs) + (let + ((name (er-bif-arg1 vs "whereis"))) + (cond + (not (er-atom? name)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (dict-has? (er-registered) (get name :name)) + (get (er-registered) (get name :name)) + :else (er-mk-atom "undefined"))))) + +(define + er-bif-registered + (fn + (vs) + (if + (not (= (len vs) 0)) + (error "Erlang: registered/0: arity") + (let + ((ks (keys (er-registered))) (out (er-mk-nil))) + (for-each + (fn + (i) + (let + ((k (nth ks (- (- (len ks) 1) i)))) + (set! out (er-mk-cons (er-mk-atom k) out)))) + (range 0 (len ks))) + out)))) + +;; Find the registered name for a pid, if any. Returns string or nil. +(define + er-find-registration + (fn + (pid) + (let + ((reg (er-registered)) (ks (keys reg)) (found (list nil))) + (for-each + (fn + (i) + (when + (= (nth found 0) nil) + (let + ((k (nth ks i))) + (when (er-pid-equal? (get reg k) pid) (set-nth! found 0 k))))) + (range 0 (len ks))) + (nth found 0)))) + +;; Drop pid from the registry (called on process death). +(define + er-unregister-pid! + (fn + (pid) + (let + ((name (er-find-registration pid))) + (when (not (= name nil)) (dict-delete! (er-registered) name))))) + (define er-bif-process-flag (fn @@ -643,12 +742,14 @@ (er-proc-set! pid :exit-reason (get r :reason)) (er-proc-set! pid :exit-result nil) (er-proc-set! pid :continuation nil) + (er-unregister-pid! pid) (er-propagate-exit! pid (get r :reason))) :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-unregister-pid! pid) (er-propagate-exit! pid (er-mk-atom "normal")))))) (er-sched-set-current! nil))) diff --git a/lib/erlang/scoreboard.json b/lib/erlang/scoreboard.json index 28db7ad5..7496762a 100644 --- a/lib/erlang/scoreboard.json +++ b/lib/erlang/scoreboard.json @@ -1,11 +1,11 @@ { "language": "erlang", - "total_pass": 432, - "total": 432, + "total_pass": 444, + "total": 444, "suites": [ {"name":"tokenize","pass":62,"total":62,"status":"ok"}, {"name":"parse","pass":52,"total":52,"status":"ok"}, - {"name":"eval","pass":248,"total":248,"status":"ok"}, + {"name":"eval","pass":260,"total":260,"status":"ok"}, {"name":"runtime","pass":39,"total":39,"status":"ok"}, {"name":"ring","pass":4,"total":4,"status":"ok"}, {"name":"ping-pong","pass":4,"total":4,"status":"ok"}, diff --git a/lib/erlang/scoreboard.md b/lib/erlang/scoreboard.md index 54747a40..ddb76d40 100644 --- a/lib/erlang/scoreboard.md +++ b/lib/erlang/scoreboard.md @@ -1,12 +1,12 @@ # Erlang-on-SX Scoreboard -**Total: 432 / 432 tests passing** +**Total: 444 / 444 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | tokenize | 62 | 62 | | ✅ | parse | 52 | 52 | -| ✅ | eval | 248 | 248 | +| ✅ | eval | 260 | 260 | | ✅ | runtime | 39 | 39 | | ✅ | ring | 4 | 4 | | ✅ | ping-pong | 4 | 4 | diff --git a/lib/erlang/tests/eval.sx b/lib/erlang/tests/eval.sx index dc0a8260..39a3f440 100644 --- a/lib/erlang/tests/eval.sx +++ b/lib/erlang/tests/eval.sx @@ -843,6 +843,65 @@ (ev "Sup = supervisor:start_link(sup7, []), receive after 5 -> ok end, supervisor:stop(Sup)"))) "ok") +;; ── register / whereis / registered ───────────────────────────── +(er-eval-test "register returns true" + (nm (ev "register(me, self())")) "true") + +(er-eval-test "whereis registered self" + (nm (ev "register(me, self()), Pid = whereis(me), if Pid =:= self() -> matched; true -> nope end")) + "matched") + +(er-eval-test "whereis undefined" + (nm (ev "whereis(no_such)")) "undefined") + +(er-eval-test "send via registered atom" + (nm (ev "register(srv, self()), srv ! hello, receive M -> M end")) + "hello") + +(er-eval-test "send to spawned registered" + (nm + (ev "Me = self(), P = spawn(fun () -> receive {From, X} -> From ! {got, X} end end), register(child, P), child ! {Me, payload}, receive {got, V} -> V end")) + "payload") + +(er-eval-test "unregister returns true" + (nm (ev "register(a, self()), unregister(a)")) "true") + +(er-eval-test "unregister then whereis" + (nm (ev "register(a, self()), unregister(a), whereis(a)")) + "undefined") + +(er-eval-test "registered/0 lists names" + (ev "register(a, self()), register(b, self()), register(c, self()), length(registered())") + 3) + +(er-eval-test "register dup raises" + (do + (ev "P = spawn(fun () -> register(d, self()), register(d, self()) end), receive after 0 -> ok end") + (let ((reason (er-proc-field (er-mk-pid 1) :exit-reason))) + (nm (if (er-atom? reason) reason (nth (get reason :elements) 0))))) + "badarg") + +(er-eval-test "unregister missing raises" + (do + (ev "P = spawn(fun () -> unregister(no_such) end), receive after 0 -> ok end") + (let ((reason (er-proc-field (er-mk-pid 1) :exit-reason))) + (nm (if (er-atom? reason) reason (nth (get reason :elements) 0))))) + "badarg") + +(er-eval-test "dead process auto-unregisters" + ;; Register a child while it's alive (still in receive). Send `die` so + ;; it exits. After scheduler drains, whereis should return undefined. + (nm + (ev "P = spawn(fun () -> receive die -> exit(killed) end end), register(was_alive, P), P ! die, receive after 5 -> ok end, whereis(was_alive)")) + "undefined") + +(er-eval-test "send to unregistered name raises" + (do + (ev "P = spawn(fun () -> no_such ! oops end), receive after 0 -> ok end") + (let ((reason (er-proc-field (er-mk-pid 1) :exit-reason))) + (nm (if (er-atom? reason) reason (nth (get reason :elements) 0))))) + "badarg") + (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 0f4189ae..5ec4ec2b 100644 --- a/lib/erlang/transpile.sx +++ b/lib/erlang/transpile.sx @@ -597,6 +597,10 @@ (= name "monitor") (er-bif-monitor vs) (= name "demonitor") (er-bif-demonitor vs) (= name "process_flag") (er-bif-process-flag vs) + (= name "register") (er-bif-register vs) + (= name "unregister") (er-bif-unregister vs) + (= name "whereis") (er-bif-whereis vs) + (= name "registered") (er-bif-registered vs) (= name "throw") (raise (er-mk-throw-marker (er-bif-arg1 vs "throw"))) (= name "error") (raise (er-mk-error-marker (er-bif-arg1 vs "error"))) :else (error @@ -966,6 +970,8 @@ (reduce str "" out))))) ;; ── send: Pid ! Msg ────────────────────────────────────────────── +;; Target may be a pid or a registered atom name. Atom resolution +;; goes through the scheduler's `:registered` table. (define er-eval-send (fn @@ -973,18 +979,36 @@ (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 + (let + ((pid (er-resolve-send-target to-val))) + (when + (er-proc-exists? pid) + (er-proc-mailbox-push! pid msg-val) (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))))) + (= (er-proc-field pid :state) "waiting") + (er-proc-set! pid :state "runnable") + (er-sched-enqueue! pid))) + msg-val)))) + +(define + er-resolve-send-target + (fn + (v) + (cond + (er-pid? v) v + (er-atom? v) + (let + ((name (get v :name))) + (if + (dict-has? (er-registered) name) + (get (er-registered) name) + (raise + (er-mk-error-marker + (er-mk-tuple + (list (er-mk-atom "badarg") v)))))) + :else (raise + (er-mk-error-marker + (er-mk-tuple (list (er-mk-atom "badarg") v))))))) ;; ── receive (selective, delimited-continuation suspension) ────── (define diff --git a/plans/erlang-on-sx.md b/plans/erlang-on-sx.md index 9f8db41a..90fb76e8 100644 --- a/plans/erlang-on-sx.md +++ b/plans/erlang-on-sx.md @@ -87,7 +87,7 @@ Core mapping: - [x] `-module(M).` loading, `M:F(...)` calls across modules — **10 new eval tests**; multi-arity, sibling calls, cross-module dispatch via `er-modules` registry - [x] `gen_server` behaviour (the big OTP win) — **10 new eval tests**; counter + LIFO stack callback modules driven via `gen_server:start_link/call/cast/stop` - [x] `supervisor` (simple one-for-one) — **7 new eval tests**; trap_exit-based restart loop; child specs are `{Id, StartFn}` pairs -- [ ] Registered processes: `register/2`, `whereis/1` +- [x] Registered processes: `register/2`, `whereis/1` — **12 new eval tests**; `unregister/1`, `registered/0`, `Name ! Msg` via registered atom; auto-unregister on death ### Phase 6 — the rest - [ ] List comprehensions `[X*2 || X <- L]` @@ -99,6 +99,7 @@ Core mapping: _Newest first._ +- **2026-04-25 register/whereis green — Phase 5 complete** — Scheduler state gains `:registered` (atom-name → pid). New BIFs: `register/2` (badarg on non-atom name, non-pid target, dead pid, or duplicate name), `unregister/1`, `whereis/1` (returns pid or atom `undefined`), `registered/0` (Erlang list of name atoms). `er-eval-send` for `Name ! Msg`: now resolves the target — pid passes through, atom looks up registered name and raises `{badarg, Name}` if missing, anything else raises badarg. Process death (in `er-sched-step!`) calls `er-unregister-pid!` to drop any registered name before `er-propagate-exit!` so monitor `{'DOWN'}` messages see the cleared registry. 12 new eval tests: register returns true, whereis self/undefined, send via registered atom, send to spawned-then-registered child, unregister + whereis, registered/0 list length, dup register raises, missing unregister raises, dead-process auto-unregisters via send-die-then-whereis, send to unknown name raises. Total suite 444/444. **Phase 5 complete — Phase 6 (list comprehensions, binary patterns, ETS) is the last phase.** - **2026-04-25 supervisor (one-for-one) green** — `er-supervisor-source` in `lib/erlang/runtime.sx` is the canonical Erlang text of a minimal supervisor; `er-load-supervisor!` registers it. Implements `start_link(Mod, Args)` (sup process traps exits, calls `Mod:init/1` to get child-spec list, runs `start_child/1` for each which links the spawned pid back to itself), `which_children/1`, `stop/1`. Receive loop dispatches on `{'EXIT', Dead, _Reason}` (restarts only the dead child via `restart/2`, keeps siblings — proper one-for-one), `{'$sup_which', From}` (returns child list), `'$sup_stop'`. Child specs are `{Id, StartFn}` where `StartFn/0` returns the new child's pid. 7 new eval tests: `which_children` for 1- and 3-child sup, child responds to ping, killed child restarted with fresh pid, restarted child still functional, one-for-one isolation (siblings keep their pids), stop returns ok. Total suite 432/432. - **2026-04-25 gen_server (OTP-lite) green** — `er-gen-server-source` in `lib/erlang/runtime.sx` is the canonical Erlang text of the behaviour; `er-load-gen-server!` registers it in the user-module table. Implements `start_link/2`, `call/2` (sync via `make_ref` + selective `receive {Ref, Reply}`), `cast/2` (async fire-and-forget returning `ok`), `stop/1`, and the receive loop dispatching `{'$gen_call', {From, Ref}, Req}` → `Mod:handle_call/3`, `{'$gen_cast', Msg}` → `Mod:handle_cast/2`, anything else → `Mod:handle_info/2`. handle_call reply tuples supported: `{reply, R, S}`, `{noreply, S}`, `{stop, R, Reply, S}`. handle_cast/info: `{noreply, S}`, `{stop, R, S}`. `Mod:F` and `M:F` where `M` is a runtime variable now work via new `er-resolve-call-name` (was bug: passed unevaluated AST node `:value` to remote dispatch). 10 new eval tests: counter callback module (start/call/cast/stop, repeated state mutations), LIFO stack callback module (`{push, V}` cast, pop returns `{ok, V}` or `empty`, size). Total suite 425/425. - **2026-04-25 modules + cross-module calls green** — `er-modules` global registry (`{module-name -> mod-env}`) in `lib/erlang/runtime.sx`. `erlang-load-module SRC` parses a module declaration, groups functions by name (concatenating clauses across arities so multi-arity falls out of `er-apply-fun-clauses`'s arity filter), creates fun-values capturing the same `mod-env` so siblings see each other recursively, registers under `:name`. `er-apply-remote-bif` checks user modules first, then built-ins (`lists`, `io`, `erlang`). `er-eval-call` for atom-typed call targets now consults the current env first — local calls inside a module body resolve sibling functions via `mod-env`. Undefined cross-module call raises `error({undef, Mod, Fun})`. 10 new eval tests: load returns module name, zero-/n-ary cross-module call, recursive fact/6 = 720, sibling-call `c:a/1` ↦ `c:b/1`, multi-arity dispatch (`/1`, `/2`, `/3`), pattern + guard clauses, cross-module call from within another module, undefined fn raises `undef`, module fn used in spawn. Total suite 415/415.