diff --git a/lib/erlang/runtime.sx b/lib/erlang/runtime.sx index c8d19a27..03aaad5d 100644 --- a/lib/erlang/runtime.sx +++ b/lib/erlang/runtime.sx @@ -150,6 +150,7 @@ :current nil :processes {} :registered {} + :ets {} :runnable (er-q-new)}))) (define er-sched (fn () (nth er-scheduler 0))) @@ -1025,3 +1026,179 @@ (define er-load-supervisor! (fn () (erlang-load-module er-supervisor-source))) + +;; ── ETS-lite ──────────────────────────────────────────────────── +;; Each table is a mutable list of tuples; key is the tuple's first +;; element (keypos=1, the default). Tables live on the scheduler +;; under `:ets` keyed by the registering atom name. Set semantics: +;; `insert/2` replaces an existing entry with the same key. +(define er-ets-tables (fn () (get (er-sched) :ets))) + +(define + er-bif-ets-new + (fn + (vs) + (cond + (not (= (len vs) 2)) (error "Erlang: ets:new/2: arity") + :else (let + ((name (nth vs 0))) + (cond + (not (er-atom? name)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (dict-has? (er-ets-tables) (get name :name)) + (raise + (er-mk-error-marker + (er-mk-tuple (list (er-mk-atom "badarg") name)))) + :else (do + (dict-set! (er-ets-tables) (get name :name) (list)) + name)))))) + +(define + er-ets-resolve + (fn + (id) + (cond + (not (er-atom? id)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (not (dict-has? (er-ets-tables) (get id :name))) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (get (er-ets-tables) (get id :name))))) + +(define + er-bif-ets-insert + (fn + (vs) + (cond + (not (= (len vs) 2)) (error "Erlang: ets:insert/2: arity") + :else (let + ((tab (er-ets-resolve (nth vs 0))) + (entry (nth vs 1))) + (cond + (not (er-tuple? entry)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (= (len (get entry :elements)) 0) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (do + (er-ets-replace-or-append! tab entry) + (er-mk-atom "true"))))))) + +(define + er-ets-replace-or-append! + (fn + (tab entry) + (let + ((key (nth (get entry :elements) 0)) + (replaced (list false))) + (for-each + (fn + (i) + (when + (er-equal? (nth (get (nth tab i) :elements) 0) key) + (set-nth! tab i entry) + (set-nth! replaced 0 true))) + (range 0 (len tab))) + (when (not (nth replaced 0)) (append! tab entry))))) + +(define + er-bif-ets-lookup + (fn + (vs) + (cond + (not (= (len vs) 2)) (error "Erlang: ets:lookup/2: arity") + :else (let + ((tab (er-ets-resolve (nth vs 0))) + (key (nth vs 1)) + (out (er-mk-nil))) + (for-each + (fn + (i) + (let + ((j (- (- (len tab) 1) i)) + (entry (nth tab (- (- (len tab) 1) i)))) + (when + (er-equal? (nth (get entry :elements) 0) key) + (set! out (er-mk-cons entry out))))) + (range 0 (len tab))) + out)))) + +(define + er-bif-ets-delete + (fn + (vs) + (cond + (= (len vs) 1) (er-ets-delete-table! (nth vs 0)) + (= (len vs) 2) (er-ets-delete-key! (nth vs 0) (nth vs 1)) + :else (error "Erlang: ets:delete: arity")))) + +(define + er-ets-delete-table! + (fn + (id) + (cond + (not (er-atom? id)) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + (not (dict-has? (er-ets-tables) (get id :name))) + (raise (er-mk-error-marker (er-mk-atom "badarg"))) + :else (do + (dict-delete! (er-ets-tables) (get id :name)) + (er-mk-atom "true"))))) + +(define + er-ets-delete-key! + (fn + (id key) + (let + ((tab (er-ets-resolve id)) (out (list))) + (for-each + (fn + (i) + (let + ((entry (nth tab i))) + (when + (not (er-equal? (nth (get entry :elements) 0) key)) + (append! out entry)))) + (range 0 (len tab))) + (dict-set! (er-ets-tables) (get id :name) out) + (er-mk-atom "true")))) + +(define + er-bif-ets-tab2list + (fn + (vs) + (let + ((tab (er-ets-resolve (er-bif-arg1 vs "ets:tab2list"))) (out (er-mk-nil))) + (for-each + (fn + (i) + (let + ((j (- (- (len tab) 1) i))) + (set! out (er-mk-cons (nth tab j) out)))) + (range 0 (len tab))) + out))) + +(define + er-bif-ets-info + (fn + (vs) + (cond + (= (len vs) 2) + (let + ((tab (er-ets-resolve (nth vs 0))) (key (nth vs 1))) + (cond + (and (er-atom? key) (= (get key :name) "size")) (len tab) + :else (er-mk-atom "undefined"))) + :else (error "Erlang: ets:info: arity")))) + +(define + er-apply-ets-bif + (fn + (name vs) + (cond + (= name "new") (er-bif-ets-new vs) + (= name "insert") (er-bif-ets-insert vs) + (= name "lookup") (er-bif-ets-lookup vs) + (= name "delete") (er-bif-ets-delete vs) + (= name "tab2list") (er-bif-ets-tab2list vs) + (= name "info") (er-bif-ets-info vs) + :else (error + (str "Erlang: undefined 'ets:" name "/" (len vs) "'"))))) diff --git a/lib/erlang/scoreboard.json b/lib/erlang/scoreboard.json index cf98c8d9..639149b7 100644 --- a/lib/erlang/scoreboard.json +++ b/lib/erlang/scoreboard.json @@ -1,11 +1,11 @@ { "language": "erlang", - "total_pass": 477, - "total": 477, + "total_pass": 490, + "total": 490, "suites": [ {"name":"tokenize","pass":62,"total":62,"status":"ok"}, {"name":"parse","pass":52,"total":52,"status":"ok"}, - {"name":"eval","pass":293,"total":293,"status":"ok"}, + {"name":"eval","pass":306,"total":306,"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 86429df7..e17aad1d 100644 --- a/lib/erlang/scoreboard.md +++ b/lib/erlang/scoreboard.md @@ -1,12 +1,12 @@ # Erlang-on-SX Scoreboard -**Total: 477 / 477 tests passing** +**Total: 490 / 490 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | tokenize | 62 | 62 | | ✅ | parse | 52 | 52 | -| ✅ | eval | 293 | 293 | +| ✅ | eval | 306 | 306 | | ✅ | 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 e2ad5eb9..2bb54aae 100644 --- a/lib/erlang/tests/eval.sx +++ b/lib/erlang/tests/eval.sx @@ -994,6 +994,55 @@ (er-eval-test "build with size var" (ev "X = 7, byte_size(<>)") 2) +;; ── ETS-lite ────────────────────────────────────────────────── +(er-eval-test "ets:new returns name" + (nm (ev "ets:new(t1, [set])")) "t1") +(er-eval-test "ets:insert returns true" + (nm (ev "T = ets:new(t2, [set]), ets:insert(T, {foo, 1})")) "true") +(er-eval-test "ets:lookup hit" + (ev "T = ets:new(t3, [set]), ets:insert(T, {foo, 42}), [{foo, V}] = ets:lookup(T, foo), V") + 42) +(er-eval-test "ets:lookup miss returns []" + (get (ev "T = ets:new(t4, [set]), ets:lookup(T, no_such)") :tag) "nil") +(er-eval-test "ets:insert replaces (set semantics)" + (ev "T = ets:new(t5, [set]), ets:insert(T, {x, 1}), ets:insert(T, {x, 2}), ets:insert(T, {x, 3}), [{x, V}] = ets:lookup(T, x), V") + 3) +(er-eval-test "ets:info size grows" + (ev "T = ets:new(t6, [set]), ets:insert(T, {a, 1}), ets:insert(T, {b, 2}), ets:insert(T, {c, 3}), ets:info(T, size)") + 3) +(er-eval-test "ets:info size after delete" + (ev "T = ets:new(t7, [set]), ets:insert(T, {a, 1}), ets:insert(T, {b, 2}), ets:delete(T, a), ets:info(T, size)") + 1) +(er-eval-test "ets:tab2list length" + (ev "T = ets:new(t8, [set]), ets:insert(T, {a, 1}), ets:insert(T, {b, 2}), ets:insert(T, {c, 3}), length(ets:tab2list(T))") + 3) +(er-eval-test "ets:delete table returns true" + (nm (ev "T = ets:new(t9, [set]), ets:delete(T)")) "true") +(er-eval-test "ets:lookup after table delete" + (do + (ev "P = spawn(fun () -> T = ets:new(t10, [set]), ets:delete(T), ets:lookup(T, x) end), receive after 0 -> ok end") + (let ((reason (er-proc-field (er-mk-pid 1) :exit-reason))) + (cond + (er-atom? reason) (get reason :name) + :else (nm reason)))) + "badarg") + +;; Sum a column via lookup chain. +(er-eval-test "ets aggregate" + (ev "T = ets:new(t11, [set]), ets:insert(T, {a, 10}), ets:insert(T, {b, 20}), ets:insert(T, {c, 30}), [{a, A}] = ets:lookup(T, a), [{b, B}] = ets:lookup(T, b), [{c, C}] = ets:lookup(T, c), A + B + C") + 60) + +;; Tuple key (non-atom). +(er-eval-test "ets tuple key" + (nm + (ev "T = ets:new(t12, [set]), ets:insert(T, {{x, 1}, hello}), [{{x, 1}, V}] = ets:lookup(T, {x, 1}), V")) + "hello") + +;; Tables are independent. +(er-eval-test "ets two tables independent" + (ev "T1 = ets:new(t13, [set]), T2 = ets:new(t14, [set]), ets:insert(T1, {x, 1}), ets:insert(T2, {x, 99}), [{x, A}] = ets:lookup(T1, x), [{x, B}] = ets:lookup(T2, x), A + B") + 100) + (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 d3d7bd18..72893644 100644 --- a/lib/erlang/transpile.sx +++ b/lib/erlang/transpile.sx @@ -718,6 +718,7 @@ (= mod "lists") (er-apply-lists-bif name vs) (= mod "io") (er-apply-io-bif name vs) (= mod "erlang") (er-apply-bif name vs) + (= mod "ets") (er-apply-ets-bif name vs) :else (error (str "Erlang: undefined module '" mod "'"))))) diff --git a/plans/erlang-on-sx.md b/plans/erlang-on-sx.md index b27b0a15..80e405ae 100644 --- a/plans/erlang-on-sx.md +++ b/plans/erlang-on-sx.md @@ -92,13 +92,14 @@ Core mapping: ### Phase 6 — the rest - [x] List comprehensions `[X*2 || X <- L]` — **12 new eval tests**; generators, filters, multiple generators (cartesian), pattern-matching gens (`{ok, V} <- ...`) - [x] Binary pattern matching `<>` — **21 new eval tests**; literal construction, byte/multi-byte segments, `Rest/binary` tail capture, `is_binary/1`, `byte_size/1` -- [ ] ETS-lite (in-memory tables via SX dicts) +- [x] ETS-lite (in-memory tables via SX dicts) — **13 new eval tests**; `ets:new/2`, `insert/2`, `lookup/2`, `delete/1-2`, `tab2list/1`, `info/2` (size); set semantics with full Erlang-term keys - [ ] More BIFs — target 200+ test corpus green ## Progress log _Newest first._ +- **2026-04-25 ETS-lite green** — Scheduler state gains `:ets` (table-name → mutable list of tuples). New `er-apply-ets-bif` dispatches `ets:new/2` (registers table by atom name; rejects duplicate name with `{badarg, Name}`), `insert/2` (set semantics — replaces existing entry with the same first-element key, else appends), `lookup/2` (returns Erlang list — `[Tuple]` if found else `[]`), `delete/1` (drop table), `delete/2` (drop key; rebuilds entry list), `tab2list/1` (full list view), `info/2` with `size` only. Keys are full Erlang terms compared via `er-equal?`. 13 new eval tests: new return value, insert true, lookup hit + miss, set replace, info size after insert/delete, tab2list length, table delete, lookup-after-delete raises badarg, multi-key aggregate sum, tuple-key insert + lookup, two independent tables. Total suite 490/490. - **2026-04-25 binary pattern matching green** — Parser additions: `<<...>>` literal/pattern in `er-parse-primary`, segment grammar `Value [: Size] [/ Spec]` (Spec defaults to `integer`, supports `binary` for tail). Critical fix: segment value uses `er-parse-primary` (not `er-parse-expr-prec`) so the trailing `:Size` doesn't get eaten by the postfix `Mod:Fun` remote-call handler. Runtime value: `{:tag "binary" :bytes (list of int 0-255)}`. Construction: integer segments emit big-endian bytes (size in bits, must be multiple of 8); binary-spec segments concatenate. Pattern matching consumes bytes from a cursor at the front, decoding integer segments big-endian, capturing `Rest/binary` tail at the end. Whole-binary length must consume exactly. New BIFs: `is_binary/1`, `byte_size/1`. Binaries participate in `er-equal?` (byte-wise) and format as `<>`. 21 new eval tests: tag/predicate, byte_size for 8/16/32-bit segments, single + multi segment match, three 8-bit, tail rest size + content, badmatch on size mismatch, `=:=` equality, var-driven construction. Total suite 477/477. - **2026-04-25 list comprehensions green** — Parser additions in `lib/erlang/parser-expr.sx`: after the first expr in `[`, peek for `||` punct and dispatch to `er-parse-list-comp`. Qualifiers separated by `,`, each one is `Pattern <- Source` (generator) or any expression (filter — disambiguated by absence of `<-`). AST: `{:type "lc" :head E :qualifiers [...]}` with each qualifier `{:kind "gen"/"filter" ...}`. Evaluator (`er-eval-lc` in transpile.sx): right-fold builds the result by walking qualifiers; generators iterate the source list with env snapshot/restore per element so pattern-bound vars don't leak between iterations; filters skip when falsy. Pattern-matching generators are silently skipped on no-match (e.g. `[V || {ok, V} <- ...]`). 12 new eval tests: map double, fold-sum-of-comprehension, length, filter sum, "all filtered", empty source, cartesian, pattern-match gen, nested generators with filter, squares, tuple capture. Total suite 456/456. - **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.**