Compare commits

...

56 Commits

Author SHA1 Message Date
b7fcd17e6e Merge remote-tracking branch 'origin/loops/erlang' into loops/erlang
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m3s
2026-05-18 22:03:43 +00:00
89ce7b857d erlang: wire file:list_dir/1 against file-list-dir (Phase 8, +4 ffi tests); 729/729, progress log 2026-05-18 22:01:03 +00:00
4591ac530b erlang: wire cid:from_bytes/1 + cid:to_string/1 against cid-from-bytes/cid-from-sx (Phase 8, +7 ffi tests) 2026-05-18 22:00:41 +00:00
250d0511c0 erlang: wire crypto:hash/2 against crypto-sha256/512/sha3-256 (Phase 8, +6 ffi tests) 2026-05-18 22:00:17 +00:00
380bc69f94 Merge loops/fed-prims into architecture: fed-sx host primitives (Phases A-I)
Pure-OCaml WASM-safe crypto/CID surface + native HTTP server:
- crypto-sha256/sha512 (FIPS 180-4), crypto-sha3-256 (FIPS 202)
- cbor-encode/decode (deterministic dag-cbor), cid-from-bytes/from-sx (CIDv1)
- ed25519-verify (RFC 8032), rsa-sha256-verify (PKCS#1 v1.5, RFC 8017)
- file-list-dir (native-safe), http-listen (native-only, bin/sx_server.ml)
Unblocks Erlang Phase 8 BIFs (erlang-on-sx.md blocker -> RESOLVED).
Merged: build green, 63 crypto tests pass, WASM boot OK, http test 6/6,
Erlang conformance 715/715, no regression.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 21:33:01 +00:00
77f17cc796 Merge loops/erlang into architecture: Phases 7-10 (hot reload, FFI BIFs, BIF registry, VM opcode extension + erlang_ext); fixes cyclic-env identity hang
# Conflicts:
#	hosts/ocaml/bin/run_tests.ml
#	plans/sx-vm-opcode-extension.md
2026-05-18 20:46:04 +00:00
4548461bfc fed-prims: Phase I — handoff (RESOLVED blocker + primitive->BIF mapping)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m50s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 18:48:35 +00:00
7d9dddcc80 fed-prims: Phase H — native-only http-listen HTTP/1.1 server + curl test
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m53s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 18:25:24 +00:00
36be6bf44b fed-prims: Phase G — file-list-dir (Sys.readdir, sorted, native-safe)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m52s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 17:57:20 +00:00
c352d94cc6 erlang: log cyclic-env regression root-cause + fix in progress log 2026-05-18 17:34:24 +00:00
857fae1331 erlang: fix er-env-derived-from? to use identical? not = (cyclic-env hang on structural-= evaluators) 2026-05-18 17:33:48 +00:00
f8fc04840a fed-prims: Phase F — RSA-SHA256 PKCS#1 v1.5 verify, pure OCaml, RSA-2048 vector
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m9s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 17:32:35 +00:00
76d1e9f53a fed-prims: Phase E — Ed25519 verify (RFC 8032), pure-OCaml bignum + edwards25519
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m2s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 17:05:59 +00:00
d8b57784fe fed-prims: Phase D — CIDv1 (multihash + base32 multibase), pure OCaml, canonical IPFS vectors
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m2s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 16:36:42 +00:00
bcaaa11916 fed-prims: Phase C — dag-cbor encode/decode, pure OCaml, RFC 8949 vectors + determinism
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m8s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 16:10:36 +00:00
451bd4be62 fed-prims: Phase B — SHA3-256 (Keccak-f[1600]), pure OCaml, 4 NIST vectors
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m41s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 15:43:51 +00:00
19932a42a9 fed-prims: Phase A — SHA-256 + SHA-512, pure OCaml, 7 NIST vectors
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m33s
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-18 15:17:35 +00:00
b073a82b33 erlang: Phase 10a — trace JIT/compiler architecture, scope into 10a.1-4, block on lib/compiler.sx 2026-05-15 09:03:50 +00:00
7996bcdacf erlang: 10b BIF-complete (10/18); control opcodes correctly gated on 10a + log 2026-05-15 08:59:11 +00:00
3b6241508c erlang: Phase 10b — ELEMENT + LISTS_REVERSE real (all 10 BIF opcodes done), +6 e2e tests 2026-05-15 08:58:41 +00:00
5774065341 erlang: 10b progress — 8/18 handlers real (hot-BIFs done) + log 2026-05-15 08:51:37 +00:00
708b5a2b12 erlang: Phase 10b — 7 more real hot-BIF handlers (HD/TL/TUPLE_SIZE/IS_*), +9 e2e tests 2026-05-15 08:51:01 +00:00
e6261c2519 erlang: mark 10b in-progress (vertical slice) + progress log 2026-05-15 08:44:29 +00:00
5c7ad01bd1 erlang: Phase 10b slice — real OP_BIF_LENGTH handler, end-to-end VM proof 2026-05-15 08:43:45 +00:00
33725de03b erlang: Phase 9g — ring bench on integrated binary (no regression); scope Phase 10 2026-05-15 08:36:05 +00:00
5fd358a7a7 erlang: Phase 9i — SX dispatcher consults extension-opcode-id (+6 vm tests, 715/715) 2026-05-15 08:30:52 +00:00
783e0cb5fe erlang: tick 9h + progress log 2026-05-15 08:25:32 +00:00
72896392c8 erlang: Phase 9h — erlang_ext.ml OCaml extension (opcodes 222-239, registered at startup) 2026-05-15 08:24:57 +00:00
12b56afcd3 erlang: Phase 9a integrated (cherry-pick + force-link); plan 9h/9i added 2026-05-15 08:11:55 +00:00
509197410f vm-ext: force-link Sx_vm_extensions into sx_server.exe (extension-opcode-id now live) 2026-05-15 08:10:33 +00:00
76614da154 vm-ext: phase E — JIT skips lambdas containing extension opcodes
Adds Sx_vm.bytecode_uses_extension_opcodes — an operand-aware
bytecode scanner that walks past CONST u16, CALL_PRIM u16+u8, and
CLOSURE u16+dynamic upvalue descriptors so operand bytes that happen
to be ≥200 don't false-positive as extension opcodes.

jit_compile_lambda calls the scanner on the inner closure's bytecode.
On hit it returns None — the lambda then runs through CEK
interpretation. The VM's dispatch fallthrough still routes the
extension opcodes themselves through the registry; this change just
prevents the JIT from claiming code it has no plan for.

Tests: 7 new foundation cases — pure core eligible, head/middle/
post-CLOSURE detection, CONST + CALL_PRIM + CLOSURE-descriptor false-
positive avoidance. +7 pass vs Phase D baseline, no regressions
across 11 conformance suites.

Loop complete: acceptance criteria 1-4 met. Hand-off to the Erlang
loop — lib/erlang/vm/dispatcher.sx's Phase 9b stub can now be
replaced with a real hosts/ocaml/lib/extensions/erlang.ml consumer.
2026-05-15 08:06:35 +00:00
4dfccc244d vm-ext: phase D — extensions/ subtree + test_ext + opcode_name lookup
lib/extensions/ becomes the new home for VM extensions, wired in via
(include_subdirs unqualified). README documents the registration
pattern, opcode-ID range conventions (200-209 guest_vm, 210-219
inline test, 220-229 test_ext, 230-247 ports), and naming rules.

extensions/test_ext.ml is the canonical worked example — two
operand-less opcodes (220 push 42, 221 double TOS) carrying a per-
extension state slot (TestExtState invocation counter). Test_ext.register
called from run_tests.ml at the start of the Phase D suite, on top of
the inline test_reg from earlier suites (disjoint opcode IDs).

Sx_vm.opcode_name now consults extension_opcode_name_ref (forward ref
in the same style as extension_dispatch_ref), so disassemble shows
extension opcodes by name instead of UNKNOWN_n. Registry maintains
name_of_id_table and installs the lookup at module init.

Tests: 5 new foundation cases — primitive resolves test_ext name,
end-to-end bytecode (push + double + return → 84), disassemble shows
"test_ext.OP_TEST_PUSH_42" / "test_ext.OP_TEST_DOUBLE_TOS",
unregistered ext opcodes still fall back to UNKNOWN_n, invocation
counter records the two dispatches. +5 pass vs Phase C baseline, no
regressions across 11 conformance suites.
2026-05-15 08:06:35 +00:00
58d7445559 vm-ext: phase C — extension-opcode-id SX primitive
Registers extension-opcode-id from sx_vm_extensions.ml module init.
Lives downstream of both sx_primitives and sx_vm to avoid a build
cycle. Accepts a string or symbol; returns Integer id when the opcode
is registered, Nil otherwise.

Compilers (lib/compiler.sx) call this to emit extension opcodes by
name. Returning Nil rather than failing on unknown names lets a port's
optimization opt in per-build — missing extensions degrade to slower
correct execution.

Tests: 5 new foundation cases — registered lookup, unknown → nil,
symbol arg, zero-arg + integer-arg rejection. +5 pass vs Phase B
baseline, no regressions across 11 conformance suites.
2026-05-15 08:06:35 +00:00
4e0a92ec00 vm-ext: phase B — extension registry module
sx_vm_extension.ml: handler type, extensible extension_state variant,
EXTENSION first-class module signature.

sx_vm_extensions.ml: register / dispatch / id_of_name /
state_of_extension. install_dispatch () runs at module init,
swapping Phase A's stub for the real registry. Rejects out-of-range
opcode IDs (must be 200-247), duplicate IDs, duplicate names, and
duplicate extension names.

Tests: 9 new foundation cases — lookup hits/misses, end-to-end VM
dispatch including opcode composition, all four rejection paths.
+9 pass vs Phase A baseline, no regressions across 11 conformance
suites.
2026-05-15 08:06:35 +00:00
85728621b0 vm-ext: phase A — extension dispatch fallthrough in sx_vm.ml
Adds Invalid_opcode of int exception and extension_dispatch_ref forward
ref (default raises Invalid_opcode op), plus the |op when op >= 200 arm
before the catch-all in the bytecode dispatch loop. Partition comment
documents 1-199 core / 200-247 extensions / 248-255 reserved.

Phase B will install the real registry's dispatch into the ref at module
init, replacing this stub.

Tests: 4 new foundation cases (Invalid_opcode for 200/224/247, Eval_error
for 199 to pin the threshold). +4 pass vs baseline, no regressions.
2026-05-15 08:06:35 +00:00
64b7263c5f erlang: Phase 9g — log perf-bench blocker on 9a; conformance half clean at 709/709 2026-05-14 21:28:10 +00:00
e8a5c2e1ba erlang: Phase 9f — hot-BIF opcode table (+18 vm tests) 2026-05-14 21:26:51 +00:00
3efd735283 erlang: Phase 9e — OP_SPAWN / OP_SEND + VM-process registry (+16 vm tests) 2026-05-14 21:20:37 +00:00
10623da0b0 erlang: Phase 9d — OP_RECEIVE_SCAN stub (+10 vm tests) 2026-05-14 21:13:40 +00:00
528b24a1cd erlang: Phase 9c — OP_PERFORM / OP_HANDLE stubs (+9 vm tests) 2026-05-14 21:08:12 +00:00
25924d6212 erlang: Phase 9b — stub VM dispatcher + 3 pattern opcodes (+19 vm tests) 2026-05-14 20:52:26 +00:00
0abf05ed83 erlang: log Phase 9a (opcode-extension) as Blocker — out of scope 2026-05-14 20:46:38 +00:00
f6a6865635 erlang: sync fed-sx + opcode-ext plans; add Phase 9 (specialized opcodes) 2026-05-14 20:45:05 +00:00
6636f9c170 erlang: extract ffi test suite (637/637, ffi 14/14) 2026-05-14 20:21:51 +00:00
29fd70f17a erlang: file:read_file/write_file/delete BIFs (+10 eval tests, 633/633) 2026-05-14 20:14:31 +00:00
3d092dd78e erlang: er-to-sx / er-of-sx term marshalling (+23 runtime tests) 2026-05-14 20:07:35 +00:00
2ee5e45515 erlang: migrate BIFs onto registry, delete cond dispatchers (600/600) 2026-05-14 19:41:30 +00:00
498d2533d8 erlang: Phase 8 BIF registry foundation (+18 runtime tests, 600/600) 2026-05-14 19:34:30 +00:00
925bbd0d42 erlang: Phase 7 capstone — full hot-reload ladder green (+5 eval tests) 2026-05-14 19:29:15 +00:00
b5e93df82e erlang: verify hot-reload call dispatch semantics (+6 eval tests) 2026-05-14 19:17:59 +00:00
582baf5bfd erlang: code:which/is_loaded/all_loaded introspection (+10 eval tests) 2026-05-14 19:08:34 +00:00
cd45ebcc7a erlang: code:purge/1 + code:soft_purge/1 (+10 eval tests) 2026-05-14 19:02:24 +00:00
89a6b30501 erlang: code:load_binary/3 hot-reload BIF (+8 eval tests) 2026-05-14 18:52:45 +00:00
0c389d4696 erlang: module-version slot (Phase 7 step 1, +13 runtime tests) 2026-05-14 17:35:02 +00:00
7602ec1a69 erlang: plan Phase 7 (hot code reload) + Phase 8 (FFI BIFs) 2026-05-14 16:19:34 +00:00
2db2d8e9f7 briefing: push to origin/loops/erlang after each commit
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
2026-05-06 06:47:16 +00:00
27 changed files with 7691 additions and 123 deletions

View File

@@ -1292,6 +1292,227 @@ let run_foundation_tests () =
ignore (Sx_types.set_lambda_name (Lambda l) "my-fn"); ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l)); assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l));
Printf.printf "\nSuite: crypto-sha2\n";
(* NIST FIPS 180-4 published vectors. *)
assert_eq "sha256 empty"
(String "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")
(call "crypto-sha256" [String ""]);
assert_eq "sha256 abc"
(String "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad")
(call "crypto-sha256" [String "abc"]);
assert_eq "sha256 896-bit"
(String "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1")
(call "crypto-sha256"
[String "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"]);
assert_eq "sha256 1M 'a'"
(String "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0")
(call "crypto-sha256" [String (String.make 1000000 'a')]);
assert_eq "sha512 empty"
(String "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e")
(call "crypto-sha512" [String ""]);
assert_eq "sha512 abc"
(String "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f")
(call "crypto-sha512" [String "abc"]);
assert_eq "sha512 896-bit"
(String "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909")
(call "crypto-sha512"
[String ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"
^ "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu")]);
Printf.printf "\nSuite: crypto-sha3\n";
(* NIST FIPS 202 published vectors. *)
assert_eq "sha3-256 empty"
(String "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a")
(call "crypto-sha3-256" [String ""]);
assert_eq "sha3-256 abc"
(String "3a985da74fe225b2045c172d6bd390bd855f086e3e9d525b46bfe24511431532")
(call "crypto-sha3-256" [String "abc"]);
assert_eq "sha3-256 896-bit"
(String "41c0dba2a9d6240849100376a8235e2c82e1b9998a999e21db32dd97496d3376")
(call "crypto-sha3-256"
[String "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"]);
(* 1600-bit message: 0xa3 * 200 — exercises multi-block absorb (>136B). *)
assert_eq "sha3-256 1600-bit 0xa3"
(String "79f38adec5c20307a98ef76e8324afbfd46cfd81b22e3973c65fa1bd9de31787")
(call "crypto-sha3-256" [String (String.make 200 '\xa3')]);
Printf.printf "\nSuite: dag-cbor\n";
let mkdict pairs =
let d = Sx_types.make_dict () in
List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs;
Dict d
in
let enc v = call "cbor-encode" [v] in
(* RFC 8949 Appendix A — minimal-length deterministic encoding. *)
assert_eq "cbor 0" (String "\x00") (enc (Integer 0));
assert_eq "cbor 23" (String "\x17") (enc (Integer 23));
assert_eq "cbor 24" (String "\x18\x18") (enc (Integer 24));
assert_eq "cbor 100" (String "\x18\x64") (enc (Integer 100));
assert_eq "cbor 1000" (String "\x19\x03\xe8") (enc (Integer 1000));
assert_eq "cbor 1000000"
(String "\x1a\x00\x0f\x42\x40") (enc (Integer 1000000));
assert_eq "cbor -1" (String "\x20") (enc (Integer (-1)));
assert_eq "cbor -100" (String "\x38\x63") (enc (Integer (-100)));
assert_eq "cbor -1000" (String "\x39\x03\xe7") (enc (Integer (-1000)));
assert_eq "cbor false" (String "\xf4") (enc (Bool false));
assert_eq "cbor true" (String "\xf5") (enc (Bool true));
assert_eq "cbor null" (String "\xf6") (enc Nil);
assert_eq "cbor \"\"" (String "\x60") (enc (String ""));
assert_eq "cbor \"a\"" (String "\x61\x61") (enc (String "a"));
assert_eq "cbor \"IETF\"" (String "\x64IETF") (enc (String "IETF"));
assert_eq "cbor []" (String "\x80") (enc (List []));
assert_eq "cbor [1,2,3]"
(String "\x83\x01\x02\x03")
(enc (List [Integer 1; Integer 2; Integer 3]));
assert_eq "cbor [1,[2,3],[4,5]]"
(String "\x83\x01\x82\x02\x03\x82\x04\x05")
(enc (List [Integer 1;
List [Integer 2; Integer 3];
List [Integer 4; Integer 5]]));
assert_eq "cbor {}" (String "\xa0") (enc (mkdict []));
assert_eq "cbor {a:1,b:[2,3]}"
(String "\xa2\x61\x61\x01\x61\x62\x82\x02\x03")
(enc (mkdict ["a", Integer 1; "b", List [Integer 2; Integer 3]]));
assert_eq "cbor {a..e:A..E}"
(String "\xa5\x61\x61\x61\x41\x61\x62\x61\x42\x61\x63\x61\x43\x61\x64\x61\x44\x61\x65\x61\x45")
(enc (mkdict ["a", String "A"; "b", String "B"; "c", String "C";
"d", String "D"; "e", String "E"]));
(* Determinism: insertion order + key length must not change bytes.
Sort is length-then-bytewise → a, c, bb. *)
let d1 = mkdict ["bb", Integer 2; "a", Integer 1; "c", Integer 3] in
let d2 = mkdict ["c", Integer 3; "bb", Integer 2; "a", Integer 1] in
assert_eq "cbor det order-invariant" (enc d1) (enc d2);
assert_eq "cbor det length-then-bytewise"
(String "\xa3\x61\x61\x01\x61\x63\x03\x62\x62\x62\x02")
(enc d1);
(* Round-trip: decode . encode = identity (structural). *)
let roundtrip name v =
assert_eq ("cbor rt " ^ name) v (call "cbor-decode" [enc v])
in
roundtrip "int" (Integer 42);
roundtrip "neg" (Integer (-99999));
roundtrip "str" (String "hello world");
roundtrip "bool" (Bool true);
roundtrip "nil" Nil;
roundtrip "nested"
(List [Integer 1; String "x"; List [Bool false; Nil]]);
roundtrip "dict"
(mkdict ["k", List [Integer 7]; "name", String "z"]);
Printf.printf "\nSuite: cid\n";
let mh_sha256 s = Sx_cid.multihash 0x12 (Sx_cid.unhex (Sx_sha2.sha256_hex s)) in
(* Authoritative vectors (independently derived; match well-known
IPFS CIDs). raw "abc" and raw "" — codec 0x55. *)
assert_eq "cid raw abc"
(String "bafkreif2pall7dybz7vecqka3zo24irdwabwdi4wc55jznaq75q7eaavvu")
(call "cid-from-bytes" [Integer 0x55; String (mh_sha256 "abc")]);
assert_eq "cid raw empty"
(String "bafkreihdwdcefgh4dqkjv67uzcmw7ojee6xedzdetojuzjevtenxquvyku")
(call "cid-from-bytes" [Integer 0x55; String (mh_sha256 "")]);
(* dag-cbor {} — canonical empty-map CID (sha2-256, codec 0x71). *)
assert_eq "cid dag-cbor {}"
(String "bafyreigbtj4x7ip5legnfznufuopl4sg4knzc2cof6duas4b3q2fy6swua")
(call "cid-from-sx" [mkdict []]);
(* Determinism: dict key insertion order must not change the CID. *)
let cda = call "cid-from-sx" [mkdict ["b", Integer 2; "a", Integer 1]] in
let cdb = call "cid-from-sx" [mkdict ["a", Integer 1; "b", Integer 2]] in
assert_eq "cid det order-invariant" cda cdb;
assert_true "cid multibase 'b' prefix"
(Bool (match call "cid-from-sx" [mkdict []] with
| String s -> String.length s > 1 && s.[0] = 'b'
| _ -> false));
Printf.printf "\nSuite: ed25519\n";
let hx = Sx_ed25519.unhex in
let edv pk msg sg = call "ed25519-verify"
[String (hx pk); String (hx msg); String (hx sg)] in
(* RFC 8032 §7.1 TEST 1-3 (deterministic; re-derived independently). *)
assert_eq "ed25519 RFC T1"
(Bool true)
(edv "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a"
""
"e5564300c360ac729086e2cc806e828a84877f1eb8e5d974d873e065224901555fb8821590a33bacc61e39701cf9b46bd25bf5f0595bbe24655141438e7a100b");
assert_eq "ed25519 RFC T2"
(Bool true)
(edv "3d4017c3e843895a92b70aa74d1b7ebc9c982ccf2ec4968cc0cd55f12af4660c"
"72"
"92a009a9f0d4cab8720e820b5f642540a2b27b5416503f8fb3762223ebdb69da085ac1e43e15996e458f3613d0f11d8c387b2eaeb4302aeeb00d291612bb0c00");
assert_eq "ed25519 RFC T3"
(Bool true)
(edv "fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025"
"af82"
"6291d657deec24024827e69c3abe01a30ce548a284743a445e3680d7db5ac3ac18ff9b538d16f290ae67f760984dc6594a7c15e9716ed28dc027beceea1ec40a");
(* Tampered message -> false. *)
assert_eq "ed25519 tampered msg"
(Bool false)
(edv "fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025"
"af83"
"6291d657deec24024827e69c3abe01a30ce548a284743a445e3680d7db5ac3ac18ff9b538d16f290ae67f760984dc6594a7c15e9716ed28dc027beceea1ec40a");
(* Tampered signature -> false. *)
assert_eq "ed25519 tampered sig"
(Bool false)
(edv "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a"
""
"f5564300c360ac729086e2cc806e828a84877f1eb8e5d974d873e065224901555fb8821590a33bacc61e39701cf9b46bd25bf5f0595bbe24655141438e7a100b");
(* Total: wrong-length pubkey / sig -> false, no exception. *)
assert_eq "ed25519 short pubkey"
(Bool false)
(call "ed25519-verify" [String "abc"; String ""; String (String.make 64 '\000')]);
assert_eq "ed25519 short sig"
(Bool false)
(call "ed25519-verify"
[String (hx "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a");
String ""; String "short"]);
assert_eq "ed25519 non-string args"
(Bool false)
(call "ed25519-verify" [Integer 1; Integer 2; Integer 3]);
Printf.printf "\nSuite: rsa-sha256\n";
(* Fixed RSA-2048 vector: one-off python-cryptography keygen +
PKCS1v15/SHA-256 sign of "fed-sx phase F rsa test". *)
let rhx = Sx_rsa.unhex in
let spki = rhx "30820122300d06092a864886f70d01010105000382010f003082010a0282010100a117b573480bce5a08b54a98384001df26d062e9173caaee2e3a2d0045c6d16f99b2a1e7fb60763f65f95f8c39ff82c18b8590338042914331db3440a06d2dbe65a2f82c82f37d293f67a8b57a1f9014b55150a093cfee90257ef3b4a215d5ab002579bd92b6fcb3536777d51b639347d01e307ddafb209073dd9b8d6a507157c44c624a19b3b9275931472462870ae02132630159132a85c1c889adfb358b6bbd3760ce3fffe6285964833a10ee436d5bc33dfab7f9ed630a74e9a32e5688f5a7797f7cc839ad2494dd1c4c4a8fab844cd26208794bf2602c16b9d12bde434066d8c0dd2d20489f4070f883bae2b4508ead4a1b80b44c576e9e37bdb5df69f10203010001" in
let rmsg = rhx "6665642d73782070686173652046207273612074657374" in
let rsig = rhx "5e1593d674ed15c0172546d38efdf1aebd252f4b0c0dfbe1f7996fd569d0bfd9f3e8689ea2b14aa45b5fc3f0a05d4f23c6b02b8820d71f6998ea3b5b0d071bb33142236e388b1226ece3ec447d33b38999f189c37564cf052cf038de94c67b2ddf9a97d5a73554bb88818f615824517209a4083258965adace55658f344104eaa0d5f2f44ea00cfac8754674aade87b40d955cccd1ccd9b7649a08b66ce3bc5dba2de96b3e859488ded3ef9fb3744a1e3495fd14841d8319b3cc08054c729d1c02739ee314eba2b20fac46e463f47eb67183d8455583eca73ba37448164612dd9cd77877135d30d12084c2843f986a5b8ad59c6600f9855b91d7cbdf7c6c4b0e" in
let rsav s m g = call "rsa-sha256-verify" [String s; String m; String g] in
assert_eq "rsa valid" (Bool true) (rsav spki rmsg rsig);
assert_eq "rsa tampered msg" (Bool false)
(rsav spki (rmsg ^ "x") rsig);
assert_eq "rsa tampered sig" (Bool false)
(rsav spki rmsg
(rhx "5f1593d674ed15c0172546d38efdf1aebd252f4b0c0dfbe1f7996fd569d0bfd9f3e8689ea2b14aa45b5fc3f0a05d4f23c6b02b8820d71f6998ea3b5b0d071bb33142236e388b1226ece3ec447d33b38999f189c37564cf052cf038de94c67b2ddf9a97d5a73554bb88818f615824517209a4083258965adace55658f344104eaa0d5f2f44ea00cfac8754674aade87b40d955cccd1ccd9b7649a08b66ce3bc5dba2de96b3e859488ded3ef9fb3744a1e3495fd14841d8319b3cc08054c729d1c02739ee314eba2b20fac46e463f47eb67183d8455583eca73ba37448164612dd9cd77877135d30d12084c2843f986a5b8ad59c6600f9855b91d7cbdf7c6c4b0e"));
assert_eq "rsa garbage spki" (Bool false)
(rsav "not der" rmsg rsig);
assert_eq "rsa non-string args" (Bool false)
(call "rsa-sha256-verify" [Integer 1; Integer 2; Integer 3]);
Printf.printf "\nSuite: file-list-dir\n";
let expect_err nm f =
(try ignore (f ());
incr fail_count; Printf.printf " FAIL: %s — no error\n" nm
with Eval_error _ ->
incr pass_count; Printf.printf " PASS: %s\n" nm
| _ ->
incr fail_count; Printf.printf " FAIL: %s — wrong exn\n" nm)
in
let tmp = Filename.temp_file "fld" "" in
Sys.remove tmp; Unix.mkdir tmp 0o755;
let touch n = let oc = open_out (Filename.concat tmp n) in close_out oc in
touch "b.txt"; touch "a.txt"; touch "c.txt";
assert_eq "file-list-dir sorted"
(List [String "a.txt"; String "b.txt"; String "c.txt"])
(call "file-list-dir" [String tmp]);
expect_err "file-list-dir missing"
(fun () -> call "file-list-dir" [String (Filename.concat tmp "nope")]);
expect_err "file-list-dir not-a-dir"
(fun () -> call "file-list-dir" [String (Filename.concat tmp "a.txt")]);
expect_err "file-list-dir arity"
(fun () -> call "file-list-dir" []);
(* best-effort cleanup *)
(try List.iter (fun n -> Sys.remove (Filename.concat tmp n))
["a.txt"; "b.txt"; "c.txt"]; Unix.rmdir tmp
with _ -> ());
Printf.printf "\nSuite: vm-extension-dispatch\n"; Printf.printf "\nSuite: vm-extension-dispatch\n";
let make_bc op = ({ let make_bc op = ({
vc_arity = 0; vc_rest_arity = -1; vc_locals = 0; vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
@@ -1599,6 +1820,213 @@ let run_foundation_tests () =
Printf.printf " FAIL: invocation_count: %s\n" Printf.printf " FAIL: invocation_count: %s\n"
(match other with Some n -> string_of_int n | None -> "None")); (match other with Some n -> string_of_int n | None -> "None"));
Printf.printf "\nSuite: extensions/erlang_ext (Phase 9h)\n";
(* Register the Erlang opcode namespace. Disjoint id range (200-217)
from test_ext (220/221) so they coexist. *)
Erlang_ext.register ();
(match prim [String "erlang.OP_PATTERN_TUPLE"] with
| Integer 222 ->
incr pass_count;
Printf.printf " PASS: extension-opcode-id erlang.OP_PATTERN_TUPLE = 222\n"
| other ->
incr fail_count;
Printf.printf " FAIL: erlang.OP_PATTERN_TUPLE: got %s\n"
(Sx_types.inspect other));
(match prim [String "erlang.OP_BIF_IS_TUPLE"] with
| Integer 239 ->
incr pass_count;
Printf.printf " PASS: extension-opcode-id erlang.OP_BIF_IS_TUPLE = 239\n"
| other ->
incr fail_count;
Printf.printf " FAIL: erlang.OP_BIF_IS_TUPLE: got %s\n"
(Sx_types.inspect other));
(match prim [String "erlang.OP_NONEXISTENT"] with
| Nil ->
incr pass_count;
Printf.printf " PASS: unknown erlang opcode -> nil\n"
| other ->
incr fail_count;
Printf.printf " FAIL: unknown erlang opcode: got %s\n"
(Sx_types.inspect other));
(* Phase 10b vertical slice: erlang.OP_BIF_LENGTH (230) is a REAL
handler. Build [CONST 0; OP_BIF_LENGTH; RETURN] with an Erlang
list [1,2,3] in the constant pool; expect Integer 3. Proves the
full path: bytecode -> Sx_vm extension fallthrough -> erlang_ext
handler -> correct stack result. *)
(let mk_dict kvs =
let h = Hashtbl.create 4 in
List.iter (fun (k, v) -> Hashtbl.replace h k v) kvs;
Sx_types.Dict h in
let er_nil = mk_dict [("tag", Sx_types.String "nil")] in
let er_cons hd tl =
mk_dict [("tag", Sx_types.String "cons");
("head", hd); ("tail", tl)] in
let lst = er_cons (Sx_types.Integer 1)
(er_cons (Sx_types.Integer 2)
(er_cons (Sx_types.Integer 3) er_nil)) in
let code = ({
vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
vc_bytecode = [| 1; 0; 0; 230; 50 |];
vc_constants = [| lst |];
vc_bytecode_list = None; vc_constants_list = None;
} : Sx_types.vm_code) in
let globals = Hashtbl.create 1 in
try
match Sx_vm.execute_module code globals with
| Integer 3 ->
incr pass_count;
Printf.printf " PASS: erlang.OP_BIF_LENGTH [1,2,3] -> 3 (real handler, end-to-end)\n"
| other ->
incr fail_count;
Printf.printf " FAIL: OP_BIF_LENGTH result: got %s\n"
(Sx_types.inspect other)
with exn ->
incr fail_count;
Printf.printf " FAIL: OP_BIF_LENGTH raised: %s\n"
(Printexc.to_string exn));
(* More real handlers (Phase 10b batch): build a list/tuple constant
and exercise HD/TL/TUPLE_SIZE/IS_* end-to-end through the VM. *)
(let mk_dict kvs =
let h = Hashtbl.create 4 in
List.iter (fun (k, v) -> Hashtbl.replace h k v) kvs;
Sx_types.Dict h in
let er_nil = mk_dict [("tag", Sx_types.String "nil")] in
let er_cons hd tl = mk_dict [("tag", Sx_types.String "cons");
("head", hd); ("tail", tl)] in
let er_tuple es = mk_dict [("tag", Sx_types.String "tuple");
("elements", Sx_types.List es)] in
let er_atom nm = mk_dict [("tag", Sx_types.String "atom");
("name", Sx_types.String nm)] in
let lst3 = er_cons (Sx_types.Integer 7)
(er_cons (Sx_types.Integer 8)
(er_cons (Sx_types.Integer 9) er_nil)) in
let tup3 = er_tuple [Sx_types.Integer 1; Sx_types.Integer 2;
Sx_types.Integer 3] in
let run consts bc =
let code = ({
vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
vc_bytecode = bc; vc_constants = consts;
vc_bytecode_list = None; vc_constants_list = None;
} : Sx_types.vm_code) in
Sx_vm.execute_module code (Hashtbl.create 1) in
let nm = function
| Sx_types.Dict d ->
(match Hashtbl.find_opt d "name" with
| Some (Sx_types.String s) -> s | _ -> "?")
| _ -> "?" in
let check label want got =
if got = want then begin
incr pass_count;
Printf.printf " PASS: %s\n" label
end else begin
incr fail_count;
Printf.printf " FAIL: %s: got %s\n" label (Sx_types.inspect got)
end in
(* HD [7,8,9] -> 7 *)
check "OP_BIF_HD [7,8,9] -> 7" (Sx_types.Integer 7)
(run [| lst3 |] [| 1;0;0; 231; 50 |]);
(* TL [7,8,9] -> [8,9], check its HD = 8 *)
check "OP_BIF_TL then HD -> 8" (Sx_types.Integer 8)
(run [| lst3 |] [| 1;0;0; 232; 231; 50 |]);
(* TUPLE_SIZE {1,2,3} -> 3 *)
check "OP_BIF_TUPLE_SIZE {1,2,3} -> 3" (Sx_types.Integer 3)
(run [| tup3 |] [| 1;0;0; 234; 50 |]);
(* IS_INTEGER 42 -> true ; IS_INTEGER [..] -> false *)
(match run [| Sx_types.Integer 42 |] [| 1;0;0; 236; 50 |] with
| v when nm v = "true" ->
incr pass_count; Printf.printf " PASS: OP_BIF_IS_INTEGER 42 -> true\n"
| v -> incr fail_count;
Printf.printf " FAIL: IS_INTEGER 42: got %s\n" (Sx_types.inspect v));
(match run [| lst3 |] [| 1;0;0; 236; 50 |] with
| v when nm v = "false" ->
incr pass_count; Printf.printf " PASS: OP_BIF_IS_INTEGER list -> false\n"
| v -> incr fail_count;
Printf.printf " FAIL: IS_INTEGER list: got %s\n" (Sx_types.inspect v));
(* IS_ATOM atom -> true ; IS_LIST nil -> true ; IS_TUPLE tuple -> true *)
(match run [| er_atom "ok" |] [| 1;0;0; 237; 50 |] with
| v when nm v = "true" ->
incr pass_count; Printf.printf " PASS: OP_BIF_IS_ATOM ok -> true\n"
| v -> incr fail_count;
Printf.printf " FAIL: IS_ATOM: got %s\n" (Sx_types.inspect v));
(match run [| er_nil |] [| 1;0;0; 238; 50 |] with
| v when nm v = "true" ->
incr pass_count; Printf.printf " PASS: OP_BIF_IS_LIST nil -> true\n"
| v -> incr fail_count;
Printf.printf " FAIL: IS_LIST nil: got %s\n" (Sx_types.inspect v));
(match run [| tup3 |] [| 1;0;0; 239; 50 |] with
| v when nm v = "true" ->
incr pass_count; Printf.printf " PASS: OP_BIF_IS_TUPLE {..} -> true\n"
| v -> incr fail_count;
Printf.printf " FAIL: IS_TUPLE: got %s\n" (Sx_types.inspect v));
(match run [| tup3 |] [| 1;0;0; 238; 50 |] with
| v when nm v = "false" ->
incr pass_count; Printf.printf " PASS: OP_BIF_IS_LIST tuple -> false\n"
| v -> incr fail_count;
Printf.printf " FAIL: IS_LIST tuple: got %s\n" (Sx_types.inspect v));
(* ELEMENT: element(2, {1,2,3}) -> 2. Calling convention: push
Index then Tuple; opcode pops Tuple (TOS) then Index. *)
check "OP_BIF_ELEMENT element(2,{1,2,3}) -> 2" (Sx_types.Integer 2)
(run [| Sx_types.Integer 2; tup3 |] [| 1;0;0; 1;1;0; 233; 50 |]);
check "OP_BIF_ELEMENT element(1,{1,2,3}) -> 1" (Sx_types.Integer 1)
(run [| Sx_types.Integer 1; tup3 |] [| 1;0;0; 1;1;0; 233; 50 |]);
(* ELEMENT out of range raises *)
(let raised =
(try ignore (run [| Sx_types.Integer 9; tup3 |]
[| 1;0;0; 1;1;0; 233; 50 |]); false
with Sx_types.Eval_error _ -> true) in
if raised then begin
incr pass_count;
Printf.printf " PASS: OP_BIF_ELEMENT out-of-range raises\n"
end else begin
incr fail_count;
Printf.printf " FAIL: OP_BIF_ELEMENT out-of-range should raise\n"
end);
(* LISTS_REVERSE [7,8,9] -> [9,8,7]; verify HD = 9 then HD of TL = 8 *)
check "OP_BIF_LISTS_REVERSE then HD -> 9" (Sx_types.Integer 9)
(run [| lst3 |] [| 1;0;0; 235; 231; 50 |]);
check "OP_BIF_LISTS_REVERSE then TL,HD -> 8" (Sx_types.Integer 8)
(run [| lst3 |] [| 1;0;0; 235; 232; 231; 50 |]);
(* reverse preserves length *)
check "OP_BIF_LISTS_REVERSE then LENGTH -> 3" (Sx_types.Integer 3)
(run [| lst3 |] [| 1;0;0; 235; 230; 50 |]));
(* A still-stubbed opcode (222 = erlang.OP_PATTERN_TUPLE) raises the
not-wired Eval_error — confirms the honest-failure path remains
for opcodes whose real handlers haven't landed. *)
(let globals = Hashtbl.create 1 in
try
ignore (Sx_vm.execute_module (make_bc_seq [| 222; 50 |]) globals);
incr fail_count;
Printf.printf " FAIL: erlang.OP_PATTERN_TUPLE dispatch should have raised\n"
with
| Sx_types.Eval_error msg
when (let needle = "not yet wired" in
let nl = String.length needle and ml = String.length msg in
let rec scan i =
if i + nl > ml then false
else if String.sub msg i nl = needle then true
else scan (i + 1)
in scan 0) ->
incr pass_count;
Printf.printf " PASS: erlang opcode dispatch raises not-wired error\n"
| exn ->
incr fail_count;
Printf.printf " FAIL: unexpected exn: %s\n" (Printexc.to_string exn));
(match Erlang_ext.dispatch_count () with
| Some n when n >= 1 ->
incr pass_count;
Printf.printf " PASS: erlang_ext state recorded %d dispatch(es)\n" n
| other ->
incr fail_count;
Printf.printf " FAIL: dispatch_count: %s\n"
(match other with Some n -> string_of_int n | None -> "None"));
Printf.printf "\nSuite: jit extension-opcode awareness\n"; Printf.printf "\nSuite: jit extension-opcode awareness\n";
let scan = Sx_vm.bytecode_uses_extension_opcodes in let scan = Sx_vm.bytecode_uses_extension_opcodes in
let no_consts = [||] in let no_consts = [||] in

View File

@@ -18,6 +18,20 @@
open Sx_types open Sx_types
(* Force-link Sx_vm_extensions so its module-init runs: installs the
extension dispatch fallthrough and registers the `extension-opcode-id`
SX primitive. Without a reference here OCaml dead-code-eliminates the
module from sx_server.exe (it's only otherwise reached from run_tests),
leaving guest-language opcode extensions (Erlang Phase 9, etc.)
invisible to the runtime. The applied call is a harmless lookup. *)
let () = ignore (Sx_vm_extensions.id_of_name "")
(* Register the Erlang opcode extension (Phase 9h) so
`extension-opcode-id "erlang.OP_*"` resolves to the host ids the SX
stub dispatcher consults. Guarded: a double-register raises Failure,
which we swallow so a re-entered server process doesn't die. *)
let () = try Erlang_ext.register () with Failure _ -> ()
(* ====================================================================== *) (* ====================================================================== *)
(* Font measurement via otfm — reads OpenType/TrueType font tables *) (* Font measurement via otfm — reads OpenType/TrueType font tables *)
(* ====================================================================== *) (* ====================================================================== *)
@@ -708,6 +722,139 @@ let setup_evaluator_bridge env =
match args with match args with
| [e; expr] -> Sx_ref.eval_expr expr e | [e; expr] -> Sx_ref.eval_expr expr e
| _ -> raise (Eval_error "eval-in-env: (env expr)")); | _ -> raise (Eval_error "eval-in-env: (env expr)"));
(* fed-sx Milestone 1 Step 8 transport. NATIVE ONLY — sockets +
threads; deliberately absent from the WASM kernel (registered
here in bin/, never in lib/sx_primitives.ml). Minimal HTTP/1.1,
Connection: close. handler : req-dict -> resp-dict where
req = {:method :path :query :headers :body},
resp = {:status :headers :body}. Never returns. *)
Sx_primitives.register "http-listen" (fun args ->
let strip_cr s =
let n = String.length s in
if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
in
match args with
| [port_v; handler] ->
let port = match port_v with
| Integer n -> n
| Number f -> int_of_float f
| _ -> raise (Eval_error "http-listen: (port handler)") in
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
Unix.setsockopt sock Unix.SO_REUSEADDR true;
Unix.bind sock
(Unix.ADDR_INET (Unix.inet_addr_loopback, port));
Unix.listen sock 64;
(* SX runtime is shared across threads — serialize handler calls. *)
let mtx = Mutex.create () in
let reason = function
| 200 -> "OK" | 201 -> "Created" | 204 -> "No Content"
| 301 -> "Moved Permanently" | 302 -> "Found"
| 400 -> "Bad Request" | 401 -> "Unauthorized"
| 403 -> "Forbidden" | 404 -> "Not Found"
| 405 -> "Method Not Allowed" | 500 -> "Internal Server Error"
| _ -> "OK" in
let handle fd =
(try
let ic = Unix.in_channel_of_descr fd in
let oc = Unix.out_channel_of_descr fd in
let reqline = strip_cr (input_line ic) in
(match String.split_on_char ' ' reqline with
| meth :: target :: _ ->
let path, query =
match String.index_opt target '?' with
| Some i ->
String.sub target 0 i,
String.sub target (i + 1)
(String.length target - i - 1)
| None -> target, "" in
let headers = Sx_types.make_dict () in
let clen = ref 0 in
let rec rdh () =
let h = strip_cr (input_line ic) in
if h = "" then ()
else begin
(match String.index_opt h ':' with
| Some i ->
let name =
String.lowercase_ascii
(String.trim (String.sub h 0 i)) in
let value =
String.trim
(String.sub h (i + 1)
(String.length h - i - 1)) in
Hashtbl.replace headers name (String value);
if name = "content-length" then
(try clen := int_of_string value with _ -> ())
| None -> ());
rdh ()
end in
rdh ();
let body =
if !clen > 0 then begin
let b = Bytes.create !clen in
really_input ic b 0 !clen;
Bytes.unsafe_to_string b
end else "" in
let req = Sx_types.make_dict () in
Hashtbl.replace req "method" (String meth);
Hashtbl.replace req "path" (String path);
Hashtbl.replace req "query" (String query);
Hashtbl.replace req "headers" (Dict headers);
Hashtbl.replace req "body" (String body);
Mutex.lock mtx;
let resp =
(try Sx_runtime.sx_call handler [Dict req]
with e -> Mutex.unlock mtx; raise e) in
Mutex.unlock mtx;
let getk k = match resp with
| Dict h -> Hashtbl.find_opt h k | _ -> None in
let status = match getk "status" with
| Some (Integer n) -> n
| Some (Number f) -> int_of_float f
| _ -> 200 in
let rbody = match getk "body" with
| Some (String s) -> s
| Some v -> Sx_types.value_to_string v
| None -> "" in
let rhdrs = match getk "headers" with
| Some (Dict h) ->
Hashtbl.fold (fun k v acc ->
(k, (match v with
| String s -> s
| v -> Sx_types.value_to_string v)) :: acc)
h []
| _ -> [] in
let buf = Buffer.create 256 in
Buffer.add_string buf
(Printf.sprintf "HTTP/1.1 %d %s\r\n" status
(reason status));
List.iter (fun (k, v) ->
Buffer.add_string buf
(Printf.sprintf "%s: %s\r\n" k v)) rhdrs;
if not (List.exists
(fun (k, _) ->
String.lowercase_ascii k = "content-type")
rhdrs)
then Buffer.add_string buf
"Content-Type: text/plain\r\n";
Buffer.add_string buf
(Printf.sprintf "Content-Length: %d\r\n"
(String.length rbody));
Buffer.add_string buf "Connection: close\r\n\r\n";
Buffer.add_string buf rbody;
output_string oc (Buffer.contents buf);
flush oc
| _ -> ())
with _ -> ());
(try Unix.close fd with _ -> ())
in
while true do
let fd, _ = Unix.accept sock in
ignore (Thread.create handle fd)
done;
Nil
| _ -> raise (Eval_error "http-listen: (port handler)"));
bind "trampoline" (fun args -> bind "trampoline" (fun args ->
match args with match args with
| [v] -> | [v] ->

49
hosts/ocaml/bin/test_http.sh Executable file
View File

@@ -0,0 +1,49 @@
#!/usr/bin/env bash
# Phase H test — native-only http-listen primitive.
# Starts sx_server with a tiny SX echo handler, drives it with curl
# (GET / POST / 404 / custom header), asserts, then kills it.
set -u
cd "$(dirname "$0")/.."
SRV=_build/default/bin/sx_server.exe
PORT=${HTTP_TEST_PORT:-8911}
PASS=0
FAIL=0
ok() { echo " PASS: $1"; PASS=$((PASS+1)); }
bad() { echo " FAIL: $1$2"; FAIL=$((FAIL+1)); }
if [ ! -x "$SRV" ]; then
echo "build sx_server.exe first (dune build bin/sx_server.exe)"; exit 1
fi
H='(begin (define (h req) (if (= (get req "path") "/echo") {:status 200 :headers {"X-Echo" (get req "method")} :body (str "M=" (get req "method") " P=" (get req "path") " Q=" (get req "query") " B=" (get req "body"))} {:status 404 :body "nope"})) (http-listen '"$PORT"' h))'
ESC=${H//\"/\\\"}
{ printf '(epoch 1)\n(eval "%s")\n' "$ESC"; sleep 30; } | "$SRV" >/tmp/test_http_srv.out 2>&1 &
SVPID=$!
trap 'kill $SVPID 2>/dev/null; wait 2>/dev/null' EXIT
up=0
for _ in $(seq 1 50); do
curl -s -o /dev/null "http://127.0.0.1:$PORT/echo" 2>/dev/null && { up=1; break; }
sleep 0.2
done
[ "$up" = 1 ] || { echo " FAIL: server did not start"; cat /tmp/test_http_srv.out; exit 1; }
# GET with query + custom response header.
g=$(curl -s -i "http://127.0.0.1:$PORT/echo?x=1" | tr -d '\r')
echo "$g" | grep -q '^HTTP/1.1 200 OK' && ok "GET status 200" || bad "GET status" "$g"
echo "$g" | grep -q '^X-Echo: GET' && ok "GET custom header" || bad "GET header" "$g"
echo "$g" | grep -q '^M=GET P=/echo Q=x=1 B=$' && ok "GET echo body" || bad "GET body" "$g"
# POST with body.
p=$(curl -s -X POST --data 'hello' "http://127.0.0.1:$PORT/echo")
[ "$p" = 'M=POST P=/echo Q= B=hello' ] && ok "POST body echoed" || bad "POST body" "$p"
# 404 path.
n=$(curl -s -i "http://127.0.0.1:$PORT/missing" | tr -d '\r')
echo "$n" | grep -q '^HTTP/1.1 404 Not Found' && ok "404 status" || bad "404 status" "$n"
echo "$n" | grep -q '^nope$' && ok "404 body" || bad "404 body" "$n"
echo "Results: $PASS passed, $FAIL failed"
[ "$FAIL" = 0 ]

View File

@@ -0,0 +1,278 @@
(** {1 [erlang_ext] — Erlang-on-SX VM opcode extension (Phase 9h)}
Registers the Erlang opcode namespace in [Sx_vm_extensions] so that
[extension-opcode-id "erlang.OP_*"] resolves to a stable id. The SX
stub dispatcher in [lib/erlang/vm/dispatcher.sx] consults these ids
(Phase 9i) and falls back to its own local ids when the host
extension is absent.
Opcode ids occupy 222-239 in the extension partition (200-247).
222+ is chosen to clear the test extensions' reserved ids
(test_reg 210/211, test_ext 220/221) so all three coexist in
run_tests; production sx_server only registers this one. Names
mirror the SX stub dispatcher exactly:
- 222 erlang.OP_PATTERN_TUPLE - 231 erlang.OP_BIF_HD
- 223 erlang.OP_PATTERN_LIST - 232 erlang.OP_BIF_TL
- 224 erlang.OP_PATTERN_BINARY - 233 erlang.OP_BIF_ELEMENT
- 225 erlang.OP_PERFORM - 234 erlang.OP_BIF_TUPLE_SIZE
- 226 erlang.OP_HANDLE - 235 erlang.OP_BIF_LISTS_REVERSE
- 227 erlang.OP_RECEIVE_SCAN - 236 erlang.OP_BIF_IS_INTEGER
- 228 erlang.OP_SPAWN - 237 erlang.OP_BIF_IS_ATOM
- 229 erlang.OP_SEND - 238 erlang.OP_BIF_IS_LIST
- 230 erlang.OP_BIF_LENGTH - 239 erlang.OP_BIF_IS_TUPLE
{2 Handler status}
The bytecode compiler does not yet emit these opcodes — Erlang
programs run through the general CEK path and the working
specialization path is the SX stub dispatcher. So every handler
here raises a descriptive [Eval_error] rather than silently
corrupting the VM stack. This keeps the extension honest: the
namespace is registered and disassembles by name, [extension-opcode-id]
works, but actually dispatching an opcode (which only happens once a
future phase teaches the compiler to emit them) fails loudly with a
pointer to the phase that will wire it. Real stack-machine handlers
land alongside compiler emission in a later phase. *)
open Sx_types
(** Per-instance state: invocation counter, purely to exercise the
[extension_state] machinery (mirrors [test_ext]). *)
type Sx_vm_extension.extension_state += ErlangExtState of {
mutable dispatched : int;
}
let not_wired name =
raise (Eval_error
(Printf.sprintf
"%s: bytecode emission not yet wired (Phase 9j) — \
Erlang runs via CEK; specialization path is the SX stub \
dispatcher in lib/erlang/vm/dispatcher.sx"
name))
module M : Sx_vm_extension.EXTENSION = struct
let name = "erlang"
let init () = ErlangExtState { dispatched = 0 }
let opcodes st =
let bump () = match st with
| ErlangExtState s -> s.dispatched <- s.dispatched + 1
| _ -> ()
in
let op id nm =
(id, nm, (fun (_vm : Sx_vm.vm) (_frame : Sx_vm.frame) ->
bump (); not_wired nm))
in
(* Phase 10b vertical slice: one REAL register-machine handler.
erlang.OP_BIF_LENGTH (230) — pops an Erlang list off the VM
stack and pushes its length. Proves the full path works:
extension-opcode-id -> bytecode -> Sx_vm dispatch fallthrough
-> this handler -> correct stack result. The remaining 17
opcodes still raise not_wired until their handlers + compiler
emission land. Erlang lists are tagged dicts:
nil = {"tag" -> String "nil"}
cons = {"tag" -> String "cons"; "head" -> v; "tail" -> v} *)
let er_tag d =
match Hashtbl.find_opt d "tag" with
| Some (String s) -> s | _ -> ""
in
let op_bif_length =
(230, "erlang.OP_BIF_LENGTH",
(fun (vm : Sx_vm.vm) (_frame : Sx_vm.frame) ->
bump ();
let v = Sx_vm.pop vm in
let rec walk acc node =
match node with
| Dict d ->
(match er_tag d with
| "nil" -> acc
| "cons" ->
(match Hashtbl.find_opt d "tail" with
| Some t -> walk (acc + 1) t
| None -> raise (Eval_error
"erlang.OP_BIF_LENGTH: cons cell without :tail"))
| _ -> raise (Eval_error
"erlang.OP_BIF_LENGTH: not a proper list"))
| _ -> raise (Eval_error
"erlang.OP_BIF_LENGTH: not a proper list")
in
Sx_vm.push vm (Integer (walk 0 v))))
in
(* Phase 10b — simple hot-BIF handlers. Erlang bool is the atom
{"tag"->"atom"; "name"->"true"|"false"}; mk_atom builds it. *)
let mk_atom nm =
let h = Hashtbl.create 2 in
Hashtbl.replace h "tag" (String "atom");
Hashtbl.replace h "name" (String nm);
Dict h
in
let er_bool b = mk_atom (if b then "true" else "false") in
let is_tag v t = match v with
| Dict d -> er_tag d = t
| _ -> false
in
let op_bif_hd =
(231, "erlang.OP_BIF_HD",
(fun (vm : Sx_vm.vm) _f ->
bump ();
match Sx_vm.pop vm with
| Dict d when er_tag d = "cons" ->
(match Hashtbl.find_opt d "head" with
| Some h -> Sx_vm.push vm h
| None -> raise (Eval_error "erlang.OP_BIF_HD: cons without :head"))
| _ -> raise (Eval_error "erlang.OP_BIF_HD: not a cons")))
in
let op_bif_tl =
(232, "erlang.OP_BIF_TL",
(fun (vm : Sx_vm.vm) _f ->
bump ();
match Sx_vm.pop vm with
| Dict d when er_tag d = "cons" ->
(match Hashtbl.find_opt d "tail" with
| Some t -> Sx_vm.push vm t
| None -> raise (Eval_error "erlang.OP_BIF_TL: cons without :tail"))
| _ -> raise (Eval_error "erlang.OP_BIF_TL: not a cons")))
in
let op_bif_tuple_size =
(234, "erlang.OP_BIF_TUPLE_SIZE",
(fun (vm : Sx_vm.vm) _f ->
bump ();
match Sx_vm.pop vm with
| Dict d when er_tag d = "tuple" ->
let n = match Hashtbl.find_opt d "elements" with
| Some (List es) -> List.length es
| Some (ListRef r) -> List.length !r
| _ -> raise (Eval_error
"erlang.OP_BIF_TUPLE_SIZE: tuple without :elements")
in
Sx_vm.push vm (Integer n)
| _ -> raise (Eval_error "erlang.OP_BIF_TUPLE_SIZE: not a tuple")))
in
let op_bif_is_integer =
(236, "erlang.OP_BIF_IS_INTEGER",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (match v with Integer _ -> true | _ -> false))))
in
let op_bif_is_atom =
(237, "erlang.OP_BIF_IS_ATOM",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (is_tag v "atom"))))
in
let op_bif_is_list =
(238, "erlang.OP_BIF_IS_LIST",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (is_tag v "cons" || is_tag v "nil"))))
in
let op_bif_is_tuple =
(239, "erlang.OP_BIF_IS_TUPLE",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (is_tag v "tuple"))))
in
(* element/2 and lists:reverse/1 — pure stack transforms (no
bytecode operands). Calling convention: args pushed left→right,
so element/2 stack is [.. Index Tuple] (Tuple on top). Erlang
element/2 is 1-indexed. *)
let op_bif_element =
(233, "erlang.OP_BIF_ELEMENT",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let tup = Sx_vm.pop vm in
let idx = Sx_vm.pop vm in
match tup, idx with
| Dict d, Integer i when er_tag d = "tuple" ->
let es = match Hashtbl.find_opt d "elements" with
| Some (List es) -> es
| Some (ListRef r) -> !r
| _ -> raise (Eval_error
"erlang.OP_BIF_ELEMENT: tuple without :elements")
in
let n = List.length es in
if i < 1 || i > n then
raise (Eval_error
(Printf.sprintf
"erlang.OP_BIF_ELEMENT: index %d out of range 1..%d" i n))
else
Sx_vm.push vm (List.nth es (i - 1))
| _, Integer _ ->
raise (Eval_error "erlang.OP_BIF_ELEMENT: 2nd arg not a tuple")
| _ ->
raise (Eval_error "erlang.OP_BIF_ELEMENT: 1st arg not an integer")))
in
let op_bif_lists_reverse =
(235, "erlang.OP_BIF_LISTS_REVERSE",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
let mk_nil () =
let h = Hashtbl.create 1 in
Hashtbl.replace h "tag" (String "nil"); Dict h in
let mk_cons hd tl =
let h = Hashtbl.create 3 in
Hashtbl.replace h "tag" (String "cons");
Hashtbl.replace h "head" hd;
Hashtbl.replace h "tail" tl;
Dict h in
let rec rev acc node =
match node with
| Dict d ->
(match er_tag d with
| "nil" -> acc
| "cons" ->
let hd = match Hashtbl.find_opt d "head" with
| Some x -> x
| None -> raise (Eval_error
"erlang.OP_BIF_LISTS_REVERSE: cons without :head") in
let tl = match Hashtbl.find_opt d "tail" with
| Some x -> x
| None -> raise (Eval_error
"erlang.OP_BIF_LISTS_REVERSE: cons without :tail") in
rev (mk_cons hd acc) tl
| _ -> raise (Eval_error
"erlang.OP_BIF_LISTS_REVERSE: not a proper list"))
| _ -> raise (Eval_error
"erlang.OP_BIF_LISTS_REVERSE: not a proper list")
in
Sx_vm.push vm (rev (mk_nil ()) v)))
in
[
op 222 "erlang.OP_PATTERN_TUPLE";
op 223 "erlang.OP_PATTERN_LIST";
op 224 "erlang.OP_PATTERN_BINARY";
op 225 "erlang.OP_PERFORM";
op 226 "erlang.OP_HANDLE";
op 227 "erlang.OP_RECEIVE_SCAN";
op 228 "erlang.OP_SPAWN";
op 229 "erlang.OP_SEND";
op_bif_length;
op_bif_hd;
op_bif_tl;
op_bif_element;
op_bif_tuple_size;
op_bif_lists_reverse;
op_bif_is_integer;
op_bif_is_atom;
op_bif_is_list;
op_bif_is_tuple;
]
end
(** Register [erlang] in [Sx_vm_extensions]. Idempotent only by failing
loudly — calling twice raises [Failure]. sx_server calls this once
at startup. *)
let register () = Sx_vm_extensions.register (module M : Sx_vm_extension.EXTENSION)
(** Read the dispatch counter from the live registry state. [None] if
[register] hasn't run. *)
let dispatch_count () =
match Sx_vm_extensions.state_of_extension "erlang" with
| Some (ErlangExtState s) -> Some s.dispatched
| _ -> None

142
hosts/ocaml/lib/sx_cbor.ml Normal file
View File

@@ -0,0 +1,142 @@
(** dag-cbor encode / decode — pure OCaml, WASM-safe.
RFC 8949 deterministic subset as constrained by IPLD dag-cbor
(RFC 8742): unsigned/negative ints, text strings, arrays, maps
with keys sorted by **length-then-bytewise**, bool, null, and
tag 42 (CID link, decode-side passthrough). Floats are not
supported (no fed-sx shape needs them yet) — encoding a [Number]
or decoding a float head raises. Reference: RFC 8949 §3, §4.2. *)
open Sx_types
exception Cbor_error of string
(* ---- Encoder ---- *)
let write_head buf major v =
let m = major lsl 5 in
if v < 24 then
Buffer.add_char buf (Char.chr (m lor v))
else if v < 0x100 then begin
Buffer.add_char buf (Char.chr (m lor 24));
Buffer.add_char buf (Char.chr v)
end else if v < 0x10000 then begin
Buffer.add_char buf (Char.chr (m lor 25));
Buffer.add_char buf (Char.chr ((v lsr 8) land 0xFF));
Buffer.add_char buf (Char.chr (v land 0xFF))
end else if v < 0x100000000 then begin
Buffer.add_char buf (Char.chr (m lor 26));
for i = 3 downto 0 do
Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
done
end else begin
Buffer.add_char buf (Char.chr (m lor 27));
for i = 7 downto 0 do
Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
done
end
(* dag-cbor map key order: shorter key first, then bytewise. *)
let key_order a b =
let la = String.length a and lb = String.length b in
if la <> lb then compare la lb else compare a b
let rec encode_into buf (v : value) : unit =
match v with
| Integer n ->
if n >= 0 then write_head buf 0 n
else write_head buf 1 (-1 - n)
| String s ->
write_head buf 3 (String.length s);
Buffer.add_string buf s
| Symbol s | Keyword s ->
write_head buf 3 (String.length s);
Buffer.add_string buf s
| Bool false -> Buffer.add_char buf '\xf4'
| Bool true -> Buffer.add_char buf '\xf5'
| Nil -> Buffer.add_char buf '\xf6'
| List items ->
write_head buf 4 (List.length items);
List.iter (encode_into buf) items
| Dict d ->
let keys = Hashtbl.fold (fun k _ acc -> k :: acc) d [] in
let keys = List.sort_uniq key_order keys in
write_head buf 5 (List.length keys);
List.iter (fun k ->
write_head buf 3 (String.length k);
Buffer.add_string buf k;
encode_into buf (Hashtbl.find d k)) keys
| Number _ ->
raise (Cbor_error "cbor-encode: floats unsupported (dag-cbor subset)")
| _ ->
raise (Cbor_error
("cbor-encode: unencodable value " ^ type_of v))
let encode (v : value) : string =
let buf = Buffer.create 64 in
encode_into buf v;
Buffer.contents buf
(* ---- Decoder ---- *)
let decode (s : string) : value =
let pos = ref 0 in
let len = String.length s in
let byte () =
if !pos >= len then raise (Cbor_error "cbor-decode: truncated");
let c = Char.code s.[!pos] in incr pos; c
in
let read_uint ai =
if ai < 24 then ai
else if ai = 24 then byte ()
else if ai = 25 then let a = byte () in let b = byte () in (a lsl 8) lor b
else if ai = 26 then begin
let v = ref 0 in
for _ = 0 to 3 do v := (!v lsl 8) lor byte () done; !v
end else if ai = 27 then begin
let v = ref 0 in
for _ = 0 to 7 do v := (!v lsl 8) lor byte () done; !v
end else raise (Cbor_error "cbor-decode: bad additional info")
in
let read_bytes n =
if !pos + n > len then raise (Cbor_error "cbor-decode: truncated");
let r = String.sub s !pos n in pos := !pos + n; r
in
let rec item () =
let b = byte () in
let major = b lsr 5 and ai = b land 0x1f in
match major with
| 0 -> Integer (read_uint ai)
| 1 -> Integer (-1 - read_uint ai)
| 2 -> String (read_bytes (read_uint ai))
| 3 -> String (read_bytes (read_uint ai))
| 4 ->
let n = read_uint ai in
List (List.init n (fun _ -> item ()))
| 5 ->
let n = read_uint ai in
let d = make_dict () in
for _ = 1 to n do
let k = match item () with
| String k -> k
| _ -> raise (Cbor_error "cbor-decode: non-string map key")
in
Hashtbl.replace d k (item ())
done;
Dict d
| 6 ->
(* Tag: tag-42 CID link → pass the inner item through. *)
ignore (read_uint ai); item ()
| 7 ->
(match ai with
| 20 -> Bool false
| 21 -> Bool true
| 22 -> Nil
| 23 -> Nil
| _ ->
raise (Cbor_error
"cbor-decode: floats/simple unsupported (dag-cbor subset)"))
| _ -> raise (Cbor_error "cbor-decode: bad major type")
in
let v = item () in
v

66
hosts/ocaml/lib/sx_cid.ml Normal file
View File

@@ -0,0 +1,66 @@
(** CIDv1 computation — pure OCaml, WASM-safe.
Multihash + CIDv1 + multibase base32-lower (RFC 4648, no pad,
multibase prefix 'b'). Codecs: dag-cbor 0x71, raw 0x55. Hash
codes: sha2-256 0x12, sha3-256 0x16. Reference: the multiformats
specs (unsigned-varint, multihash, cid, multibase). No deps. *)
open Sx_types
(* Unsigned LEB128 (multiformats unsigned-varint). *)
let varint (n : int) : string =
let buf = Buffer.create 4 in
let n = ref n in
let cont = ref true in
while !cont do
let b = !n land 0x7f in
n := !n lsr 7;
if !n = 0 then (Buffer.add_char buf (Char.chr b); cont := false)
else Buffer.add_char buf (Char.chr (b lor 0x80))
done;
Buffer.contents buf
(* RFC 4648 base32 lowercase, no padding. *)
let b32_alpha = "abcdefghijklmnopqrstuvwxyz234567"
let base32_lower (s : string) : string =
let buf = Buffer.create ((String.length s * 8 + 4) / 5) in
let acc = ref 0 and bits = ref 0 in
String.iter (fun c ->
acc := (!acc lsl 8) lor (Char.code c);
bits := !bits + 8;
while !bits >= 5 do
bits := !bits - 5;
Buffer.add_char buf b32_alpha.[(!acc lsr !bits) land 0x1f]
done) s;
if !bits > 0 then
Buffer.add_char buf b32_alpha.[(!acc lsl (5 - !bits)) land 0x1f];
Buffer.contents buf
(* "abef" -> the 2 raw bytes. *)
let unhex (h : string) : string =
let n = String.length h / 2 in
let b = Bytes.create n in
for i = 0 to n - 1 do
Bytes.set b i
(Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
done;
Bytes.unsafe_to_string b
(* multihash = varint(code) || varint(len) || digest *)
let multihash (code : int) (digest : string) : string =
varint code ^ varint (String.length digest) ^ digest
(* CIDv1 = 0x01 || varint(codec) || multihash ; multibase 'b' base32. *)
let cidv1 (codec : int) (mh : string) : string =
"b" ^ base32_lower ("\x01" ^ varint codec ^ mh)
let codec_dag_cbor = 0x71
let mh_sha2_256 = 0x12
(* Canonicalize an SX value: dag-cbor encode -> sha2-256 ->
multihash -> CIDv1 (dag-cbor codec). *)
let cid_from_sx (v : value) : string =
let cbor = Sx_cbor.encode v in
let digest = unhex (Sx_sha2.sha256_hex cbor) in
cidv1 codec_dag_cbor (multihash mh_sha2_256 digest)

View File

@@ -0,0 +1,289 @@
(** Ed25519 signature verification — pure OCaml, WASM-safe.
RFC 8032 §5.1.7 cofactorless verify over edwards25519. Includes a
minimal arbitrary-precision unsigned bignum (no Zarith / no deps)
and twisted-Edwards extended-coordinate point arithmetic. Verify
is total: malformed inputs return [false], never raise. SHA-512
is reused from {!Sx_sha2}. Reference: RFC 8032, RFC 7748. *)
(* ---- Minimal bignum: int array, little-endian, base 2^26. ---- *)
let bits = 26
let base = 1 lsl bits
let mask = base - 1
type bn = int array (* normalized: no high zero limbs, length >= 1 *)
let norm (a : bn) : bn =
let n = ref (Array.length a) in
while !n > 1 && a.(!n - 1) = 0 do decr n done;
if !n = Array.length a then a else Array.sub a 0 !n
let bzero : bn = [| 0 |]
let of_int n : bn =
if n = 0 then bzero
else begin
let r = ref [] and n = ref n in
while !n > 0 do r := (!n land mask) :: !r; n := !n lsr bits done;
norm (Array.of_list (List.rev !r))
end
let is_zero (a : bn) = Array.length a = 1 && a.(0) = 0
let cmp (a : bn) (b : bn) : int =
let a = norm a and b = norm b in
let la = Array.length a and lb = Array.length b in
if la <> lb then compare la lb
else begin
let r = ref 0 and i = ref (la - 1) in
while !r = 0 && !i >= 0 do
if a.(!i) <> b.(!i) then r := compare a.(!i) b.(!i);
decr i
done; !r
end
let add (a : bn) (b : bn) : bn =
let la = Array.length a and lb = Array.length b in
let n = (max la lb) + 1 in
let r = Array.make n 0 in
let carry = ref 0 in
for i = 0 to n - 1 do
let s = !carry
+ (if i < la then a.(i) else 0)
+ (if i < lb then b.(i) else 0) in
r.(i) <- s land mask; carry := s lsr bits
done;
norm r
(* a - b, requires a >= b *)
let sub (a : bn) (b : bn) : bn =
let la = Array.length a and lb = Array.length b in
let r = Array.make la 0 in
let borrow = ref 0 in
for i = 0 to la - 1 do
let s = a.(i) - !borrow - (if i < lb then b.(i) else 0) in
if s < 0 then (r.(i) <- s + base; borrow := 1)
else (r.(i) <- s; borrow := 0)
done;
norm r
let mul (a : bn) (b : bn) : bn =
let la = Array.length a and lb = Array.length b in
let r = Array.make (la + lb) 0 in
for i = 0 to la - 1 do
let carry = ref 0 in
for j = 0 to lb - 1 do
let s = r.(i + j) + a.(i) * b.(j) + !carry in
r.(i + j) <- s land mask; carry := s lsr bits
done;
r.(i + lb) <- r.(i + lb) + !carry
done;
norm r
let numbits (a : bn) : int =
let a = norm a in
let hi = Array.length a - 1 in
if hi = 0 && a.(0) = 0 then 0
else begin
let b = ref 0 and v = ref a.(hi) in
while !v > 0 do incr b; v := !v lsr 1 done;
hi * bits + !b
end
let bit (a : bn) (i : int) : int =
let limb = i / bits and off = i mod bits in
if limb >= Array.length a then 0 else (a.(limb) lsr off) land 1
(* r = a mod m (m > 0), binary long division. *)
let bn_mod (a : bn) (m : bn) : bn =
if cmp a m < 0 then norm a
else begin
let r = ref bzero in
for i = numbits a - 1 downto 0 do
(* r = r*2 + bit *)
r := add !r !r;
if bit a i = 1 then r := add !r [| 1 |];
if cmp !r m >= 0 then r := sub !r m
done;
!r
end
let div_small (a : bn) (d : int) : bn =
let la = Array.length a in
let q = Array.make la 0 in
let rem = ref 0 in
for i = la - 1 downto 0 do
let cur = (!rem lsl bits) lor a.(i) in
q.(i) <- cur / d; rem := cur mod d
done;
norm q
let powmod (b0 : bn) (e : bn) (m : bn) : bn =
let result = ref [| 1 |] and b = ref (bn_mod b0 m) in
let nb = numbits e in
for i = 0 to nb - 1 do
if bit e i = 1 then result := bn_mod (mul !result !b) m;
b := bn_mod (mul !b !b) m
done;
!result
let of_bytes_le (s : string) : bn =
let acc = ref bzero in
for i = String.length s - 1 downto 0 do
acc := add (mul !acc (of_int 256)) (of_int (Char.code s.[i]))
done;
!acc
let to_bytes_le (a : bn) (n : int) : string =
let b = Bytes.make n '\000' in
let cur = ref (norm a) in
for i = 0 to n - 1 do
let q = div_small !cur 256 in
let r =
let qm = mul q (of_int 256) in
let d = sub !cur qm in
if is_zero d then 0 else d.(0)
in
Bytes.set b i (Char.chr r);
cur := q
done;
Bytes.unsafe_to_string b
(* ---- Field GF(p), p = 2^255 - 19 ---- *)
let p =
let twop255 = Array.make 11 0 in (* 11*26 = 286 > 255 *)
let limb = 255 / bits and off = 255 mod bits in
twop255.(limb) <- 1 lsl off;
sub (norm twop255) (of_int 19)
let fmod a = bn_mod a p
let fadd a b = fmod (add a b)
let fsub a b = fmod (add a (sub p (fmod b)))
let fmul a b = fmod (mul a b)
let fpow a e = powmod a e p
let finv a = fpow a (sub p (of_int 2)) (* Fermat: a^(p-2) *)
(* group order L = 2^252 + 27742317777372353535851937790883648493 *)
let ell =
of_bytes_le
"\xed\xd3\xf5\x5c\x1a\x63\x12\x58\xd6\x9c\xf7\xa2\xde\xf9\xde\x14\
\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10"
(* d = -121665 / 121666 mod p *)
let dconst =
let inv666 = finv (of_int 121666) in
fmod (mul (fsub (of_int 0) (of_int 121665)) inv666)
(* sqrt(-1) = 2^((p-1)/4) mod p *)
let sqrtm1 = fpow (of_int 2) (div_small (sub p (of_int 1)) 4)
(* ---- edwards25519 points in extended coords (X,Y,Z,T) ---- *)
type pt = { x : bn; y : bn; z : bn; t : bn }
let identity = { x = bzero; y = of_int 1; z = of_int 1; t = bzero }
(* add-2008-hwcd-3, complete for a = -1 on ed25519 *)
let padd (p1 : pt) (p2 : pt) : pt =
let a = fmul (fsub p1.y p1.x) (fsub p2.y p2.x) in
let b = fmul (fadd p1.y p1.x) (fadd p2.y p2.x) in
let c = fmul (fmul p1.t (fmul (of_int 2) dconst)) p2.t in
let dd = fmul (fmul p1.z (of_int 2)) p2.z in
let e = fsub b a in
let f = fsub dd c in
let g = fadd dd c in
let h = fadd b a in
{ x = fmul e f; y = fmul g h; t = fmul e h; z = fmul f g }
let scalar_mul (n : bn) (q : pt) : pt =
let r = ref identity in
for i = numbits n - 1 downto 0 do
r := padd !r !r;
if bit n i = 1 then r := padd !r q
done;
!r
let pnegate (q : pt) : pt =
{ q with x = fsub (of_int 0) q.x; t = fsub (of_int 0) q.t }
(* Decompress a 32-byte little-endian point encoding. *)
let decompress (s : string) : pt option =
if String.length s <> 32 then None
else begin
let sign = (Char.code s.[31] lsr 7) land 1 in
let s' = Bytes.of_string s in
Bytes.set s' 31 (Char.chr (Char.code s.[31] land 0x7f));
let y = of_bytes_le (Bytes.unsafe_to_string s') in
if cmp y p >= 0 then None
else begin
let y2 = fmul y y in
let u = fsub y2 (of_int 1) in
let v = fadd (fmul dconst y2) (of_int 1) in
(* x = u v^3 (u v^7)^((p-5)/8) *)
let v3 = fmul (fmul v v) v in
let v7 = fmul (fmul v3 v3) v in
let exp = div_small (sub p (of_int 5)) 8 in
let x0 = fmul (fmul u v3) (fpow (fmul u v7) exp) in
let vx2 = fmul v (fmul x0 x0) in
let x =
if cmp vx2 u = 0 then Some x0
else if cmp vx2 (fsub (of_int 0) u) = 0 then Some (fmul x0 sqrtm1)
else None
in
match x with
| None -> None
| Some x ->
if is_zero x && sign = 1 then None
else begin
let x = if (bit x 0) <> sign then fsub (of_int 0) x else x in
Some { x; y; z = of_int 1; t = fmul x y }
end
end
end
(* Encode a point to 32-byte little-endian (y with x-parity bit). *)
let encode (q : pt) : string =
let zi = finv q.z in
let x = fmul q.x zi and y = fmul q.y zi in
let b = Bytes.of_string (to_bytes_le y 32) in
let last = Char.code (Bytes.get b 31) lor ((bit x 0) lsl 7) in
Bytes.set b 31 (Char.chr last);
Bytes.unsafe_to_string b
(* base point: y = 4/5 mod p, x even (sign 0). *)
let base_point =
let by = fmul (of_int 4) (finv (of_int 5)) in
match decompress (to_bytes_le by 32) with
| Some pt -> pt
| None -> failwith "ed25519: base point decompress failed"
let unhex (h : string) : string =
let n = String.length h / 2 in
let b = Bytes.create n in
for i = 0 to n - 1 do
Bytes.set b i
(Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
done;
Bytes.unsafe_to_string b
let sha512_bytes s = unhex (Sx_sha2.sha512_hex s)
(* RFC 8032 §5.1.7 cofactorless: encode([S]B - [k]A) == R. *)
let verify ~pubkey ~msg ~sig_ : bool =
if String.length pubkey <> 32 || String.length sig_ <> 64 then false
else
let rb = String.sub sig_ 0 32 in
let sb = String.sub sig_ 32 32 in
let s = of_bytes_le sb in
if cmp s ell >= 0 then false
else
match decompress pubkey with
| None -> false
| Some a ->
let h = sha512_bytes (rb ^ pubkey ^ msg) in
let k = bn_mod (of_bytes_le h) ell in
let sb_pt = scalar_mul s base_point in
let ka = scalar_mul k a in
let chk = padd sb_pt (pnegate ka) in
(try encode chk = rb with _ -> false)

View File

@@ -3237,6 +3237,21 @@ let () =
with Sys_error msg -> raise (Eval_error ("file-read: " ^ msg))) with Sys_error msg -> raise (Eval_error ("file-read: " ^ msg)))
| _ -> raise (Eval_error "file-read: (path)")); | _ -> raise (Eval_error "file-read: (path)"));
(* fed-sx Step 3 segment replay. Sorted names, no "."/".." ;
errors prefixed like file-read (msg carries enoent/enotdir). *)
register "file-list-dir" (fun args ->
match args with
| [String path] ->
(try
let names = Sys.readdir path in
let names =
Array.to_list names
|> List.filter (fun n -> n <> "." && n <> "..") in
let names = List.sort compare names in
List (List.map (fun n -> String n) names)
with Sys_error msg -> raise (Eval_error ("file-list-dir: " ^ msg)))
| _ -> raise (Eval_error "file-list-dir: (path)"));
register "file-write" (fun args -> register "file-write" (fun args ->
match args with match args with
| [String path; String content] -> | [String path; String content] ->
@@ -4158,4 +4173,61 @@ let () =
Sx_types.jit_skipped_count := 0; Sx_types.jit_skipped_count := 0;
Sx_types.jit_threshold_skipped_count := 0; Sx_types.jit_threshold_skipped_count := 0;
Sx_types.jit_evicted_count := 0; Sx_types.jit_evicted_count := 0;
Nil) Nil);
(* fed-sx host primitives — pure-OCaml crypto (WASM-safe). *)
register "crypto-sha256" (fun args ->
match args with
| [String s] -> String (Sx_sha2.sha256_hex s)
| _ -> raise (Eval_error "crypto-sha256: (bytes)"));
register "crypto-sha512" (fun args ->
match args with
| [String s] -> String (Sx_sha2.sha512_hex s)
| _ -> raise (Eval_error "crypto-sha512: (bytes)"));
register "crypto-sha3-256" (fun args ->
match args with
| [String s] -> String (Sx_sha3.sha3_256_hex s)
| _ -> raise (Eval_error "crypto-sha3-256: (bytes)"));
register "cbor-encode" (fun args ->
match args with
| [v] ->
(try String (Sx_cbor.encode v)
with Sx_cbor.Cbor_error m -> raise (Eval_error m))
| _ -> raise (Eval_error "cbor-encode: (value)"));
register "cbor-decode" (fun args ->
match args with
| [String s] ->
(try Sx_cbor.decode s
with Sx_cbor.Cbor_error m -> raise (Eval_error m))
| _ -> raise (Eval_error "cbor-decode: (bytes)"));
register "cid-from-bytes" (fun args ->
match args with
| [Integer codec; String mh] ->
String (Sx_cid.cidv1 codec mh)
| _ -> raise (Eval_error "cid-from-bytes: (codec multihash-bytes)"));
register "cid-from-sx" (fun args ->
match args with
| [v] ->
(try String (Sx_cid.cid_from_sx v)
with Sx_cbor.Cbor_error m -> raise (Eval_error m))
| _ -> raise (Eval_error "cid-from-sx: (value)"));
(* Verify is total: any malformed input -> false, never raises. *)
register "ed25519-verify" (fun args ->
match args with
| [String pk; String msg; String sg] ->
Bool (try Sx_ed25519.verify ~pubkey:pk ~msg ~sig_:sg
with _ -> false)
| _ -> Bool false);
register "rsa-sha256-verify" (fun args ->
match args with
| [String spki; String msg; String sg] ->
Bool (try Sx_rsa.verify ~spki ~msg ~sig_:sg with _ -> false)
| _ -> Bool false)

220
hosts/ocaml/lib/sx_rsa.ml Normal file
View File

@@ -0,0 +1,220 @@
(** RSASSA-PKCS1-v1_5 verification with SHA-256 — pure OCaml,
WASM-safe. Self-contained minimal bignum (modexp only), a tiny
DER reader for SubjectPublicKeyInfo, and the fixed SHA-256
DigestInfo prefix. Verify only on public data — constant time
not required. Reference: RFC 8017 §8.2.2, §9.2. No deps. *)
(* ---- Minimal unsigned bignum: int array, little-endian, base 2^26 ---- *)
let bits = 26
let base = 1 lsl bits
let mask = base - 1
type bn = int array
let norm a =
let n = ref (Array.length a) in
while !n > 1 && a.(!n - 1) = 0 do decr n done;
if !n = Array.length a then a else Array.sub a 0 !n
let bzero : bn = [| 0 |]
let is_zero a = Array.length a = 1 && a.(0) = 0
let cmp a b =
let a = norm a and b = norm b in
let la = Array.length a and lb = Array.length b in
if la <> lb then compare la lb
else begin
let r = ref 0 and i = ref (la - 1) in
while !r = 0 && !i >= 0 do
if a.(!i) <> b.(!i) then r := compare a.(!i) b.(!i);
decr i
done; !r
end
let add a b =
let la = Array.length a and lb = Array.length b in
let n = (max la lb) + 1 in
let r = Array.make n 0 and carry = ref 0 in
for i = 0 to n - 1 do
let s = !carry + (if i < la then a.(i) else 0)
+ (if i < lb then b.(i) else 0) in
r.(i) <- s land mask; carry := s lsr bits
done;
norm r
let sub a b = (* requires a >= b *)
let la = Array.length a and lb = Array.length b in
let r = Array.make la 0 and borrow = ref 0 in
for i = 0 to la - 1 do
let s = a.(i) - !borrow - (if i < lb then b.(i) else 0) in
if s < 0 then (r.(i) <- s + base; borrow := 1)
else (r.(i) <- s; borrow := 0)
done;
norm r
let mul a b =
let la = Array.length a and lb = Array.length b in
let r = Array.make (la + lb) 0 in
for i = 0 to la - 1 do
let carry = ref 0 in
for j = 0 to lb - 1 do
let s = r.(i + j) + a.(i) * b.(j) + !carry in
r.(i + j) <- s land mask; carry := s lsr bits
done;
r.(i + lb) <- r.(i + lb) + !carry
done;
norm r
let numbits a =
let a = norm a in
let hi = Array.length a - 1 in
if hi = 0 && a.(0) = 0 then 0
else begin
let b = ref 0 and v = ref a.(hi) in
while !v > 0 do incr b; v := !v lsr 1 done;
hi * bits + !b
end
let bit a i =
let limb = i / bits and off = i mod bits in
if limb >= Array.length a then 0 else (a.(limb) lsr off) land 1
let bn_mod a m = (* binary long division, m > 0 *)
if cmp a m < 0 then norm a
else begin
let r = ref bzero in
for i = numbits a - 1 downto 0 do
r := add !r !r;
if bit a i = 1 then r := add !r [| 1 |];
if cmp !r m >= 0 then r := sub !r m
done;
!r
end
let powmod b0 e m =
let result = ref [| 1 |] and b = ref (bn_mod b0 m) in
for i = 0 to numbits e - 1 do
if bit e i = 1 then result := bn_mod (mul !result !b) m;
b := bn_mod (mul !b !b) m
done;
!result
let of_bytes_be (s : string) : bn =
let acc = ref bzero in
for i = 0 to String.length s - 1 do
acc := add (mul !acc [| 256 |]) [| Char.code s.[i] |]
done;
!acc
let div_small a d =
let la = Array.length a in
let q = Array.make la 0 and rem = ref 0 in
for i = la - 1 downto 0 do
let cur = (!rem lsl bits) lor a.(i) in
q.(i) <- cur / d; rem := cur mod d
done;
norm q
let to_bytes_be (a : bn) (n : int) : string =
let b = Bytes.make n '\000' in
let cur = ref (norm a) in
for i = n - 1 downto 0 do
let q = div_small !cur 256 in
let r =
let d = sub !cur (mul q [| 256 |]) in
if is_zero d then 0 else d.(0)
in
Bytes.set b i (Char.chr r);
cur := q
done;
Bytes.unsafe_to_string b
(* ---- Minimal DER reader (for SubjectPublicKeyInfo) ---- *)
exception Der of string
(* Returns (tag, content_start, content_len, next). *)
let der_tlv s pos =
if pos + 2 > String.length s then raise (Der "short");
let tag = Char.code s.[pos] in
let l0 = Char.code s.[pos + 1] in
let len, hdr =
if l0 < 0x80 then l0, 2
else begin
let nb = l0 land 0x7f in
if pos + 2 + nb > String.length s then raise (Der "short len");
let v = ref 0 in
for i = 0 to nb - 1 do
v := (!v lsl 8) lor Char.code s.[pos + 2 + i]
done;
!v, 2 + nb
end
in
(tag, pos + hdr, len, pos + hdr + len)
(* SPKI DER -> (n, e) as bignums. *)
let parse_spki (der : string) : bn * bn =
let tag, c, _l, _ = der_tlv der 0 in
if tag <> 0x30 then raise (Der "spki: outer not SEQUENCE");
(* AlgorithmIdentifier SEQUENCE — skip. *)
let _, _, _, after_alg = der_tlv der c in
(* BIT STRING. *)
let bt, bc, bl, _ = der_tlv der after_alg in
if bt <> 0x03 then raise (Der "spki: expected BIT STRING");
(* First content byte = unused bits (must be 0). *)
let rpk_start = bc + 1 in
ignore bl;
let st, sc, _, _ = der_tlv der rpk_start in
if st <> 0x30 then raise (Der "spki: RSAPublicKey not SEQUENCE");
let nt, nc, nl, after_n = der_tlv der sc in
if nt <> 0x02 then raise (Der "spki: modulus not INTEGER");
let et, ec, el, _ = der_tlv der after_n in
if et <> 0x02 then raise (Der "spki: exponent not INTEGER");
let n = of_bytes_be (String.sub der nc nl) in
let e = of_bytes_be (String.sub der ec el) in
(n, e)
(* SHA-256 DigestInfo DER prefix (RFC 8017 §9.2 note 1). *)
let sha256_digestinfo_prefix =
"\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20"
let unhex h =
let n = String.length h / 2 in
let b = Bytes.create n in
for i = 0 to n - 1 do
Bytes.set b i (Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
done;
Bytes.unsafe_to_string b
(* RSASSA-PKCS1-v1_5 verify with SHA-256. Total: any malformed
input yields false (caller wraps, but be defensive here too). *)
let verify ~spki ~msg ~sig_ : bool =
try
let n, e = parse_spki spki in
let k = (numbits n + 7) / 8 in
if String.length sig_ <> k then false
else begin
let s = of_bytes_be sig_ in
if cmp s n >= 0 then false
else begin
let m = powmod s e n in
let em = to_bytes_be m k in
(* EM = 0x00 01 FF..FF 00 || DigestInfo || H *)
let h = unhex (Sx_sha2.sha256_hex msg) in
let t = sha256_digestinfo_prefix ^ h in
let tlen = String.length t in
if k < tlen + 11 then false
else begin
let ok = ref (em.[0] = '\x00' && em.[1] = '\x01') in
let ps_end = k - tlen - 1 in
for i = 2 to ps_end - 1 do
if em.[i] <> '\xff' then ok := false
done;
if em.[ps_end] <> '\x00' then ok := false;
if String.sub em (ps_end + 1) tlen <> t then ok := false;
!ok
end
end
end
with _ -> false

212
hosts/ocaml/lib/sx_sha2.ml Normal file
View File

@@ -0,0 +1,212 @@
(** SHA-2 (SHA-256, SHA-512) — pure OCaml, WASM-safe.
No C stubs, no external deps. Used by the fed-sx host primitives
[crypto-sha256] / [crypto-sha512]. Reference: FIPS 180-4. *)
(* ---- SHA-256 (FIPS 180-4 §6.2). 32-bit words held in native int,
masked to 32 bits after every arithmetic op. ---- *)
let mask32 = 0xFFFFFFFF
let k256 = [|
0x428a2f98; 0x71374491; 0xb5c0fbcf; 0xe9b5dba5;
0x3956c25b; 0x59f111f1; 0x923f82a4; 0xab1c5ed5;
0xd807aa98; 0x12835b01; 0x243185be; 0x550c7dc3;
0x72be5d74; 0x80deb1fe; 0x9bdc06a7; 0xc19bf174;
0xe49b69c1; 0xefbe4786; 0x0fc19dc6; 0x240ca1cc;
0x2de92c6f; 0x4a7484aa; 0x5cb0a9dc; 0x76f988da;
0x983e5152; 0xa831c66d; 0xb00327c8; 0xbf597fc7;
0xc6e00bf3; 0xd5a79147; 0x06ca6351; 0x14292967;
0x27b70a85; 0x2e1b2138; 0x4d2c6dfc; 0x53380d13;
0x650a7354; 0x766a0abb; 0x81c2c92e; 0x92722c85;
0xa2bfe8a1; 0xa81a664b; 0xc24b8b70; 0xc76c51a3;
0xd192e819; 0xd6990624; 0xf40e3585; 0x106aa070;
0x19a4c116; 0x1e376c08; 0x2748774c; 0x34b0bcb5;
0x391c0cb3; 0x4ed8aa4a; 0x5b9cca4f; 0x682e6ff3;
0x748f82ee; 0x78a5636f; 0x84c87814; 0x8cc70208;
0x90befffa; 0xa4506ceb; 0xbef9a3f7; 0xc67178f2 |]
let rotr32 x n = ((x lsr n) lor (x lsl (32 - n))) land mask32
let sha256_hex (msg : string) : string =
let h = [| 0x6a09e667; 0xbb67ae85; 0x3c6ef372; 0xa54ff53a;
0x510e527f; 0x9b05688c; 0x1f83d9ab; 0x5be0cd19 |] in
let len = String.length msg in
(* Padded length: multiple of 64 bytes. *)
let bitlen = len * 8 in
let padlen =
let r = (len + 1) mod 64 in
if r <= 56 then 56 - r else 120 - r
in
let total = len + 1 + padlen + 8 in
let buf = Bytes.make total '\000' in
Bytes.blit_string msg 0 buf 0 len;
Bytes.set buf len '\x80';
(* 64-bit big-endian bit length (we cap at OCaml int range). *)
for i = 0 to 7 do
Bytes.set buf (total - 1 - i)
(Char.chr ((bitlen lsr (8 * i)) land 0xFF))
done;
let w = Array.make 64 0 in
let nblocks = total / 64 in
for b = 0 to nblocks - 1 do
let base = b * 64 in
for t = 0 to 15 do
let o = base + t * 4 in
w.(t) <-
(Char.code (Bytes.get buf o) lsl 24)
lor (Char.code (Bytes.get buf (o + 1)) lsl 16)
lor (Char.code (Bytes.get buf (o + 2)) lsl 8)
lor (Char.code (Bytes.get buf (o + 3)))
done;
for t = 16 to 63 do
let s0 =
(rotr32 w.(t - 15) 7) lxor (rotr32 w.(t - 15) 18)
lxor (w.(t - 15) lsr 3) in
let s1 =
(rotr32 w.(t - 2) 17) lxor (rotr32 w.(t - 2) 19)
lxor (w.(t - 2) lsr 10) in
w.(t) <- (w.(t - 16) + s0 + w.(t - 7) + s1) land mask32
done;
let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
and g = ref h.(6) and hh = ref h.(7) in
for t = 0 to 63 do
let s1 =
(rotr32 !e 6) lxor (rotr32 !e 11) lxor (rotr32 !e 25) in
let ch = (!e land !f) lxor ((lnot !e land mask32) land !g) in
let t1 = (!hh + s1 + ch + k256.(t) + w.(t)) land mask32 in
let s0 =
(rotr32 !a 2) lxor (rotr32 !a 13) lxor (rotr32 !a 22) in
let maj = (!a land !bb) lxor (!a land !c) lxor (!bb land !c) in
let t2 = (s0 + maj) land mask32 in
hh := !g; g := !f; f := !e;
e := (!d + t1) land mask32;
d := !c; c := !bb; bb := !a;
a := (t1 + t2) land mask32
done;
h.(0) <- (h.(0) + !a) land mask32;
h.(1) <- (h.(1) + !bb) land mask32;
h.(2) <- (h.(2) + !c) land mask32;
h.(3) <- (h.(3) + !d) land mask32;
h.(4) <- (h.(4) + !e) land mask32;
h.(5) <- (h.(5) + !f) land mask32;
h.(6) <- (h.(6) + !g) land mask32;
h.(7) <- (h.(7) + !hh) land mask32
done;
let out = Buffer.create 64 in
Array.iter (fun x -> Buffer.add_string out (Printf.sprintf "%08x" x)) h;
Buffer.contents out
(* ---- SHA-512 (FIPS 180-4 §6.4). 64-bit words via Int64.
128-bit length append; we only support messages whose bit length
fits in 64 bits (high word is always zero). ---- *)
let k512 = [|
0x428a2f98d728ae22L; 0x7137449123ef65cdL; 0xb5c0fbcfec4d3b2fL;
0xe9b5dba58189dbbcL; 0x3956c25bf348b538L; 0x59f111f1b605d019L;
0x923f82a4af194f9bL; 0xab1c5ed5da6d8118L; 0xd807aa98a3030242L;
0x12835b0145706fbeL; 0x243185be4ee4b28cL; 0x550c7dc3d5ffb4e2L;
0x72be5d74f27b896fL; 0x80deb1fe3b1696b1L; 0x9bdc06a725c71235L;
0xc19bf174cf692694L; 0xe49b69c19ef14ad2L; 0xefbe4786384f25e3L;
0x0fc19dc68b8cd5b5L; 0x240ca1cc77ac9c65L; 0x2de92c6f592b0275L;
0x4a7484aa6ea6e483L; 0x5cb0a9dcbd41fbd4L; 0x76f988da831153b5L;
0x983e5152ee66dfabL; 0xa831c66d2db43210L; 0xb00327c898fb213fL;
0xbf597fc7beef0ee4L; 0xc6e00bf33da88fc2L; 0xd5a79147930aa725L;
0x06ca6351e003826fL; 0x142929670a0e6e70L; 0x27b70a8546d22ffcL;
0x2e1b21385c26c926L; 0x4d2c6dfc5ac42aedL; 0x53380d139d95b3dfL;
0x650a73548baf63deL; 0x766a0abb3c77b2a8L; 0x81c2c92e47edaee6L;
0x92722c851482353bL; 0xa2bfe8a14cf10364L; 0xa81a664bbc423001L;
0xc24b8b70d0f89791L; 0xc76c51a30654be30L; 0xd192e819d6ef5218L;
0xd69906245565a910L; 0xf40e35855771202aL; 0x106aa07032bbd1b8L;
0x19a4c116b8d2d0c8L; 0x1e376c085141ab53L; 0x2748774cdf8eeb99L;
0x34b0bcb5e19b48a8L; 0x391c0cb3c5c95a63L; 0x4ed8aa4ae3418acbL;
0x5b9cca4f7763e373L; 0x682e6ff3d6b2b8a3L; 0x748f82ee5defb2fcL;
0x78a5636f43172f60L; 0x84c87814a1f0ab72L; 0x8cc702081a6439ecL;
0x90befffa23631e28L; 0xa4506cebde82bde9L; 0xbef9a3f7b2c67915L;
0xc67178f2e372532bL; 0xca273eceea26619cL; 0xd186b8c721c0c207L;
0xeada7dd6cde0eb1eL; 0xf57d4f7fee6ed178L; 0x06f067aa72176fbaL;
0x0a637dc5a2c898a6L; 0x113f9804bef90daeL; 0x1b710b35131c471bL;
0x28db77f523047d84L; 0x32caab7b40c72493L; 0x3c9ebe0a15c9bebcL;
0x431d67c49c100d4cL; 0x4cc5d4becb3e42b6L; 0x597f299cfc657e2aL;
0x5fcb6fab3ad6faecL; 0x6c44198c4a475817L |]
let ( &: ) = Int64.logand
let ( |: ) = Int64.logor
let ( ^: ) = Int64.logxor
let ( +: ) = Int64.add
let lnot64 = Int64.lognot
let rotr64 x n =
(Int64.shift_right_logical x n) |: (Int64.shift_left x (64 - n))
let sha512_hex (msg : string) : string =
let h = [| 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL;
0x3c6ef372fe94f82bL; 0xa54ff53a5f1d36f1L;
0x510e527fade682d1L; 0x9b05688c2b3e6c1fL;
0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L |] in
let len = String.length msg in
let bitlen = len * 8 in
(* Pad to a multiple of 128 bytes; 16-byte big-endian length. *)
let padlen =
let r = (len + 1) mod 128 in
if r <= 112 then 112 - r else 240 - r
in
let total = len + 1 + padlen + 16 in
let buf = Bytes.make total '\000' in
Bytes.blit_string msg 0 buf 0 len;
Bytes.set buf len '\x80';
for i = 0 to 7 do
Bytes.set buf (total - 1 - i)
(Char.chr ((bitlen lsr (8 * i)) land 0xFF))
done;
let w = Array.make 80 0L in
let nblocks = total / 128 in
for b = 0 to nblocks - 1 do
let base = b * 128 in
for t = 0 to 15 do
let o = base + t * 8 in
let v = ref 0L in
for j = 0 to 7 do
v := Int64.logor (Int64.shift_left !v 8)
(Int64.of_int (Char.code (Bytes.get buf (o + j))))
done;
w.(t) <- !v
done;
for t = 16 to 79 do
let s0 =
(rotr64 w.(t - 15) 1) ^: (rotr64 w.(t - 15) 8)
^: (Int64.shift_right_logical w.(t - 15) 7) in
let s1 =
(rotr64 w.(t - 2) 19) ^: (rotr64 w.(t - 2) 61)
^: (Int64.shift_right_logical w.(t - 2) 6) in
w.(t) <- w.(t - 16) +: s0 +: w.(t - 7) +: s1
done;
let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
and g = ref h.(6) and hh = ref h.(7) in
for t = 0 to 79 do
let s1 = (rotr64 !e 14) ^: (rotr64 !e 18) ^: (rotr64 !e 41) in
let ch = (!e &: !f) ^: ((lnot64 !e) &: !g) in
let t1 = !hh +: s1 +: ch +: k512.(t) +: w.(t) in
let s0 = (rotr64 !a 28) ^: (rotr64 !a 34) ^: (rotr64 !a 39) in
let maj = (!a &: !bb) ^: (!a &: !c) ^: (!bb &: !c) in
let t2 = s0 +: maj in
hh := !g; g := !f; f := !e;
e := !d +: t1;
d := !c; c := !bb; bb := !a;
a := t1 +: t2
done;
h.(0) <- h.(0) +: !a;
h.(1) <- h.(1) +: !bb;
h.(2) <- h.(2) +: !c;
h.(3) <- h.(3) +: !d;
h.(4) <- h.(4) +: !e;
h.(5) <- h.(5) +: !f;
h.(6) <- h.(6) +: !g;
h.(7) <- h.(7) +: !hh
done;
let out = Buffer.create 128 in
Array.iter
(fun x -> Buffer.add_string out (Printf.sprintf "%016Lx" x)) h;
Buffer.contents out

107
hosts/ocaml/lib/sx_sha3.ml Normal file
View File

@@ -0,0 +1,107 @@
(** SHA-3 (SHA3-256) — pure OCaml, WASM-safe.
Keccak-f[1600] permutation + SHA-3 multi-rate padding (domain byte
0x06, NOT the legacy Keccak 0x01). Reference: FIPS 202. No deps. *)
let ( ^: ) = Int64.logxor
let ( &: ) = Int64.logand
let lnot64 = Int64.lognot
let rotl64 x n =
if n = 0 then x
else
Int64.logor (Int64.shift_left x n) (Int64.shift_right_logical x (64 - n))
(* FIPS 202 Table 2 — ρ rotation offsets, indexed lane = x + 5*y. *)
let rho = [|
0; 1; 62; 28; 27;
36; 44; 6; 55; 20;
3; 10; 43; 25; 39;
41; 45; 15; 21; 8;
18; 2; 61; 56; 14 |]
(* FIPS 202 §3.2.5 — round constants RC[0..23] for ι. *)
let rc = [|
0x0000000000000001L; 0x0000000000008082L; 0x800000000000808aL;
0x8000000080008000L; 0x000000000000808bL; 0x0000000080000001L;
0x8000000080008081L; 0x8000000000008009L; 0x000000000000008aL;
0x0000000000000088L; 0x0000000080008009L; 0x000000008000000aL;
0x000000008000808bL; 0x800000000000008bL; 0x8000000000008089L;
0x8000000000008003L; 0x8000000000008002L; 0x8000000000000080L;
0x000000000000800aL; 0x800000008000000aL; 0x8000000080008081L;
0x8000000000008080L; 0x0000000080000001L; 0x8000000080008008L |]
let keccak_f (a : int64 array) : unit =
let c = Array.make 5 0L and d = Array.make 5 0L in
let b = Array.make 25 0L in
for round = 0 to 23 do
(* θ *)
for x = 0 to 4 do
c.(x) <- a.(x) ^: a.(x + 5) ^: a.(x + 10)
^: a.(x + 15) ^: a.(x + 20)
done;
for x = 0 to 4 do
d.(x) <- c.((x + 4) mod 5) ^: (rotl64 c.((x + 1) mod 5) 1)
done;
for x = 0 to 4 do
for y = 0 to 4 do
a.(x + 5 * y) <- a.(x + 5 * y) ^: d.(x)
done
done;
(* ρ and π: B[y, 2x+3y] = rotl(A[x,y], rho[x,y]) *)
for x = 0 to 4 do
for y = 0 to 4 do
let nx = y and ny = (2 * x + 3 * y) mod 5 in
b.(nx + 5 * ny) <- rotl64 a.(x + 5 * y) rho.(x + 5 * y)
done
done;
(* χ *)
for y = 0 to 4 do
for x = 0 to 4 do
a.(x + 5 * y) <-
b.(x + 5 * y)
^: ((lnot64 b.((x + 1) mod 5 + 5 * y))
&: b.((x + 2) mod 5 + 5 * y))
done
done;
(* ι *)
a.(0) <- a.(0) ^: rc.(round)
done
let sha3_256_hex (msg : string) : string =
let rate = 136 (* bytes: (1600 - 2*256) / 8 *) in
let len = String.length msg in
(* pad10*1 with SHA-3 domain byte 0x06; last byte ORed with 0x80. *)
let q = rate - (len mod rate) in
let padded = Bytes.make (len + q) '\000' in
Bytes.blit_string msg 0 padded 0 len;
if q = 1 then
Bytes.set padded len '\x86'
else begin
Bytes.set padded len '\x06';
Bytes.set padded (len + q - 1) '\x80'
end;
let total = Bytes.length padded in
let a = Array.make 25 0L in
let nblocks = total / rate in
for blk = 0 to nblocks - 1 do
let base = blk * rate in
(* Absorb: XOR rate bytes into the state, little-endian lanes. *)
for j = 0 to rate - 1 do
let lane = j / 8 and sh = (j mod 8) * 8 in
let byte = Int64.of_int (Char.code (Bytes.get padded (base + j))) in
a.(lane) <- a.(lane) ^: (Int64.shift_left byte sh)
done;
keccak_f a
done;
(* Squeeze 32 bytes (fits in the first 4 lanes; rate > 32). *)
let out = Buffer.create 64 in
for j = 0 to 31 do
let lane = j / 8 and sh = (j mod 8) * 8 in
let byte =
Int64.to_int
(Int64.logand (Int64.shift_right_logical a.(lane) sh) 0xFFL)
in
Buffer.add_string out (Printf.sprintf "%02x" byte)
done;
Buffer.contents out

View File

@@ -33,3 +33,54 @@ least: persistent (path-copying) envs, an inline scheduler that
doesn't call/cc on the common path (msg-already-in-mailbox), and a doesn't call/cc on the common path (msg-already-in-mailbox), and a
linked-list mailbox. None of those are in scope for the Phase 3 linked-list mailbox. None of those are in scope for the Phase 3
checkbox — captured here as the floor we're starting from. checkbox — captured here as the floor we're starting from.
## Phase 9 status (2026-05-14)
Specialized opcodes 9b9f landed as **stub dispatchers** in
`lib/erlang/vm/dispatcher.sx`: `OP_PATTERN_TUPLE/LIST/BINARY`,
`OP_PERFORM/HANDLE`, `OP_RECEIVE_SCAN`, `OP_SPAWN/SEND`, and ten
`OP_BIF_*` hot dispatch entries. Each opcode's handler is a thin
wrapper over the existing `er-match-*` / `er-bif-*` / runtime impls,
so **the perf numbers above are unchanged** — same per-hop cost, same
scheduler. The stubs exist to nail down opcode IDs, operand contracts,
and tests against `er-match!` parity *before* 9a (the OCaml
opcode-extension mechanism in `hosts/ocaml/evaluator/`) lands.
When 9a integrates and the bytecode compiler can emit these opcodes
at hot call sites, the real speedup story (~3000× ring throughput,
~1000× spawn) starts. Until then this file documents the
pre-integration ceiling. 72 vm-suite tests guard the stub correctness;
full conformance is **709/709** with the stub infrastructure loaded.
## Phase 9g — post-integration bench (2026-05-15)
9a (vm-ext mechanism), 9h (`erlang_ext.ml` registering `erlang.OP_*`
ids 222-239), and 9i (SX dispatcher consulting `extension-opcode-id`)
are now integrated and built into `hosts/ocaml/_build/default/bin/sx_server.exe`.
Re-ran the ring ladder on that binary:
| N (processes) | Hops | Wall-clock | Throughput |
|---|---|---|---|
| 10 | 10 | 938ms | 11 hops/s |
| 100 | 100 | 2772ms | 36 hops/s |
| 500 | 500 | 14190ms | 35 hops/s |
| 1000 | 1000 | 31814ms | 31 hops/s |
**Numbers are unchanged from the pre-integration baseline** — and that
is the expected, correct result. The opcode handlers (both the SX stub
dispatcher and the OCaml `erlang_ext` module) wrap the existing
`er-match-*` / `er-bif-*` / scheduler implementations 1-to-1, and the
**bytecode compiler does not yet emit `erlang.OP_*` opcodes**, so every
hop still goes through the general CEK path exactly as before. The
unchanged numbers therefore double as a no-regression check: the full
extension wiring (cherry-picked vm-ext A-E + force-link + erlang_ext +
SX bridge) added zero per-hop cost. Conformance **715/715** on this
binary.
The ~3000×/~1000× targets remain gated on a **future phase (Phase 10 —
bytecode emission)**: teach `lib/compiler.sx` (or the Erlang
transpiler) to emit `erlang.OP_PATTERN_TUPLE` etc. at hot call sites,
then give `erlang_ext.ml` real register-machine handlers instead of the
current honest not-wired raise. That is a substantial standalone phase,
tracked in `plans/erlang-on-sx.md`. 9g's deliverable — *honest
measurement + recorded numbers on the integrated binary* — is complete.

View File

@@ -36,6 +36,8 @@ SUITES=(
"bank|er-bank-test-pass|er-bank-test-count" "bank|er-bank-test-pass|er-bank-test-count"
"echo|er-echo-test-pass|er-echo-test-count" "echo|er-echo-test-pass|er-echo-test-count"
"fib|er-fib-test-pass|er-fib-test-count" "fib|er-fib-test-pass|er-fib-test-count"
"ffi|er-ffi-test-pass|er-ffi-test-count"
"vm|er-vm-test-pass|er-vm-test-count"
) )
cat > "$TMPFILE" << 'EPOCHS' cat > "$TMPFILE" << 'EPOCHS'
@@ -56,6 +58,9 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/erlang/tests/programs/bank.sx") (load "lib/erlang/tests/programs/bank.sx")
(load "lib/erlang/tests/programs/echo.sx") (load "lib/erlang/tests/programs/echo.sx")
(load "lib/erlang/tests/programs/fib_server.sx") (load "lib/erlang/tests/programs/fib_server.sx")
(load "lib/erlang/vm/dispatcher.sx")
(load "lib/erlang/tests/ffi.sx")
(load "lib/erlang/tests/vm.sx")
(epoch 100) (epoch 100)
(eval "(list er-test-pass er-test-count)") (eval "(list er-test-pass er-test-count)")
(epoch 101) (epoch 101)
@@ -74,6 +79,10 @@ cat > "$TMPFILE" << 'EPOCHS'
(eval "(list er-echo-test-pass er-echo-test-count)") (eval "(list er-echo-test-pass er-echo-test-count)")
(epoch 108) (epoch 108)
(eval "(list er-fib-test-pass er-fib-test-count)") (eval "(list er-fib-test-pass er-fib-test-count)")
(epoch 109)
(eval "(list er-ffi-test-pass er-ffi-test-count)")
(epoch 110)
(eval "(list er-vm-test-pass er-vm-test-count)")
EPOCHS EPOCHS
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1

View File

@@ -853,6 +853,112 @@
(define er-modules-get (fn () (nth er-modules 0))) (define er-modules-get (fn () (nth er-modules 0)))
(define er-modules-reset! (fn () (set-nth! er-modules 0 {}))) (define er-modules-reset! (fn () (set-nth! er-modules 0 {})))
(define er-mk-module-slot
(fn (mod-env old-env version)
{:current mod-env :old old-env :version version :tag "module"}))
(define er-module-current-env (fn (slot) (get slot :current)))
(define er-module-old-env (fn (slot) (get slot :old)))
(define er-module-version (fn (slot) (get slot :version)))
;; ── FFI BIF registry (Phase 8) ───────────────────────────────────
;; Global dict from "Module/Name/Arity" key to {:module :name :arity :fn :pure?}.
;; Replaces the giant cond chain in transpile.sx#er-apply-remote-bif over time —
;; Phase 8 BIFs (crypto / cid / file / httpc / sqlite) all register here.
(define er-bif-registry (list {}))
(define er-bif-registry-get (fn () (nth er-bif-registry 0)))
(define er-bif-registry-reset! (fn () (set-nth! er-bif-registry 0 {})))
(define er-bif-key
(fn (module name arity)
(str module "/" name "/" arity)))
(define er-register-bif!
(fn (module name arity sx-fn)
(dict-set! (er-bif-registry-get) (er-bif-key module name arity)
{:module module :name name :arity arity :fn sx-fn :pure? false})
(er-mk-atom "ok")))
(define er-register-pure-bif!
(fn (module name arity sx-fn)
(dict-set! (er-bif-registry-get) (er-bif-key module name arity)
{:module module :name name :arity arity :fn sx-fn :pure? true})
(er-mk-atom "ok")))
(define er-lookup-bif
(fn (module name arity)
(let ((reg (er-bif-registry-get)) (k (er-bif-key module name arity)))
(if (dict-has? reg k) (get reg k) nil))))
(define er-list-bifs
(fn () (keys (er-bif-registry-get))))
;; ── term marshalling (Phase 8) ───────────────────────────────────
;; Bridge Erlang term values (tagged dicts) and SX-native values for
;; FFI BIFs to call out into platform primitives. Conversions:
;;
;; Erlang SX-native
;; ───────────────────────── ────────────────
;; atom {:tag "atom" :name S} ↔ symbol (make-symbol S)
;; nil {:tag "nil"} ↔ '()
;; cons {:tag "cons" :head :tail} → list of marshalled elements
;; tuple {:tag "tuple" :elements} → list of marshalled elements
;; binary {:tag "binary" :bytes} ↔ SX string
;; integer / float / boolean ↔ passthrough
;; SX string on the way back → binary
;;
;; Pids, refs, funs pass through unchanged — they have no SX-native
;; equivalent and are opaque to FFI primitives.
(define er-cons-to-sx-list
(fn (v)
(cond
(er-nil? v) (list)
(er-cons? v)
(let ((tail (er-cons-to-sx-list (get v :tail)))
(head (er-to-sx (get v :head))))
(let ((out (list head)))
(for-each
(fn (i) (append! out (nth tail i)))
(range 0 (len tail)))
out))
:else (list v))))
(define er-to-sx
(fn (v)
(cond
(er-atom? v) (make-symbol (get v :name))
(er-nil? v) (list)
(er-cons? v) (er-cons-to-sx-list v)
(er-tuple? v)
(let ((out (list)) (es (get v :elements)))
(for-each
(fn (i) (append! out (er-to-sx (nth es i))))
(range 0 (len es)))
out)
(er-binary? v) (list->string (map integer->char (get v :bytes)))
:else v)))
(define er-of-sx
(fn (v)
(let ((ty (type-of v)))
(cond
(= ty "symbol") (er-mk-atom (str v))
(= ty "string") (er-mk-binary (map char->integer (string->list v)))
(= ty "list")
(let ((out (er-mk-nil)))
(for-each
(fn (i)
(set! out
(er-mk-cons (er-of-sx (nth v (- (- (len v) 1) i))) out)))
(range 0 (len v)))
out)
(= ty "nil") (er-mk-nil)
:else v))))
;; Load an Erlang module declaration. Source must start with ;; Load an Erlang module declaration. Source must start with
;; `-module(Name).` and contain function definitions. Functions ;; `-module(Name).` and contain function definitions. Functions
;; sharing a name (different arities) get their clauses concatenated ;; sharing a name (different arities) get their clauses concatenated
@@ -897,7 +1003,15 @@
((all-clauses (get by-name k))) ((all-clauses (get by-name k)))
(er-env-bind! mod-env k (er-mk-fun all-clauses mod-env)))) (er-env-bind! mod-env k (er-mk-fun all-clauses mod-env))))
(keys by-name)) (keys by-name))
(dict-set! (er-modules-get) mod-name mod-env) (let ((registry (er-modules-get)))
(if (dict-has? registry mod-name)
(let ((existing-slot (get registry mod-name)))
(dict-set! registry mod-name
(er-mk-module-slot mod-env
(er-module-current-env existing-slot)
(+ (er-module-version existing-slot) 1))))
(dict-set! registry mod-name
(er-mk-module-slot mod-env nil 1))))
(er-mk-atom mod-name))))) (er-mk-atom mod-name)))))
(define (define
@@ -905,7 +1019,7 @@
(fn (fn
(mod name vs) (mod name vs)
(let (let
((mod-env (get (er-modules-get) mod))) ((mod-env (er-module-current-env (get (er-modules-get) mod))))
(if (if
(not (dict-has? mod-env name)) (not (dict-has? mod-env name))
(raise (raise
@@ -1189,16 +1303,266 @@
:else (er-mk-atom "undefined"))) :else (er-mk-atom "undefined")))
:else (error "Erlang: ets:info: arity")))) :else (error "Erlang: ets:info: arity"))))
(define
er-apply-ets-bif
(fn ;; ── file module (Phase 8 FFI) ────────────────────────────────────
(name vs) ;; Synchronous file IO. Filenames must be SX strings (or Erlang
(cond ;; binaries/char-code lists coercible to strings via er-source-to-string).
(= name "new") (er-bif-ets-new vs) ;; Returns `{ok, Binary}` / `ok` on success, `{error, Reason}` on failure
(= name "insert") (er-bif-ets-insert vs) ;; where Reason is one of `enoent`, `eacces`, `enotdir`, `posix_error`.
(= name "lookup") (er-bif-ets-lookup vs)
(= name "delete") (er-bif-ets-delete vs) (define er-classify-file-error
(= name "tab2list") (er-bif-ets-tab2list vs) (fn (msg)
(= name "info") (er-bif-ets-info vs) (let ((s (str msg)))
:else (error (cond
(str "Erlang: undefined 'ets:" name "/" (len vs) "'"))))) (string-contains? s "No such") (er-mk-atom "enoent")
(string-contains? s "Permission denied") (er-mk-atom "eacces")
(string-contains? s "Not a directory") (er-mk-atom "enotdir")
(string-contains? s "Is a directory") (er-mk-atom "eisdir")
:else (er-mk-atom "posix_error")))))
(define er-bif-file-read-file
(fn (vs)
(let ((path (er-source-to-string (nth vs 0))))
(cond
(= path nil)
(er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
:else
(let ((res (list nil)) (err (list nil)))
(guard (c (:else (set-nth! err 0 c)))
(set-nth! res 0 (file-read path)))
(cond
(not (= (nth err 0) nil))
(er-mk-tuple (list (er-mk-atom "error")
(er-classify-file-error (nth err 0))))
:else
(er-mk-tuple (list (er-mk-atom "ok")
(er-mk-binary (map char->integer (string->list (nth res 0))))))))))))
(define er-bif-file-write-file
(fn (vs)
(let ((path (er-source-to-string (nth vs 0)))
(data (er-source-to-string (nth vs 1))))
(cond
(or (= path nil) (= data nil))
(er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
:else
(let ((err (list nil)))
(guard (c (:else (set-nth! err 0 c)))
(file-write path data))
(cond
(not (= (nth err 0) nil))
(er-mk-tuple (list (er-mk-atom "error")
(er-classify-file-error (nth err 0))))
:else (er-mk-atom "ok")))))))
(define er-bif-file-delete
(fn (vs)
(let ((path (er-source-to-string (nth vs 0))))
(cond
(= path nil)
(er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
:else
(let ((err (list nil)))
(guard (c (:else (set-nth! err 0 c)))
(file-delete path))
(cond
(not (= (nth err 0) nil))
(er-mk-tuple (list (er-mk-atom "error")
(er-classify-file-error (nth err 0))))
:else (er-mk-atom "ok")))))))
;; ── crypto / cid / file:list_dir (Phase 8 FFI — host primitives) ──
;; Wired against loops/fed-prims host primitives (see plans Blockers
;; "RESOLVED 2026-05-18"). Term marshalling at the boundary:
;; Erlang binary/string/charlist -> SX byte-string via er-source-to-string;
;; results -> Erlang binary via er-mk-binary.
(define er-hexval
(fn (c)
(let ((v (char->integer c)))
(cond
(and (>= v 48) (<= v 57)) (- v 48) ;; 0-9
(and (>= v 97) (<= v 102)) (+ 10 (- v 97)) ;; a-f
(and (>= v 65) (<= v 70)) (+ 10 (- v 65)) ;; A-F
:else 0))))
(define er-hex->bytes
(fn (hex)
(let ((cs (string->list hex)) (out (list)) (n (string-length hex)))
(for-each
(fn (i)
(append! out
(+ (* 16 (er-hexval (nth cs (* i 2))))
(er-hexval (nth cs (+ (* i 2) 1))))))
(range 0 (truncate (/ n 2))))
out)))
;; crypto:hash(Type, Data) -> raw digest binary. Type is an Erlang
;; atom (sha256 | sha512 | sha3_256). Bad type / non-binary -> badarg.
(define er-bif-crypto-hash
(fn (vs)
(let ((ty (nth vs 0)) (data (er-source-to-string (nth vs 1))))
(cond
(or (not (er-atom? ty)) (= data nil))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((name (get ty :name)))
(let ((hex (cond
(= name "sha256") (crypto-sha256 data)
(= name "sha512") (crypto-sha512 data)
(= name "sha3_256") (crypto-sha3-256 data)
:else nil)))
(cond
(= hex nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (er-mk-binary (er-hex->bytes hex)))))))))
;; cid:from_bytes(Bin) -> CIDv1 (raw codec 0x55, sha2-256 multihash)
;; as an Erlang binary string.
(define er-bif-cid-from-bytes
(fn (vs)
(let ((data (er-source-to-string (nth vs 0))))
(cond
(= data nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((digest (er-hex->bytes (crypto-sha256 data))))
(let ((mh (list->string
(map integer->char (append (list 18 32) digest)))))
(er-mk-binary
(map char->integer
(string->list (cid-from-bytes 85 mh))))))))))
;; cid:to_string(Term) -> canonical CIDv1 (dag-cbor) of the term,
;; as an Erlang binary string.
(define er-bif-cid-to-string
(fn (vs)
;; Canonical CID of the term's stable string form. (cbor-encode
;; rejects symbols, so er-to-sx of compound terms is unencodable;
;; er-format-value yields a canonical SX string per term value.)
(er-mk-binary
(map char->integer
(string->list (cid-from-sx (er-format-value (nth vs 0))))))))
;; file:list_dir(Path) -> {ok, [Binary]} | {error, Reason}
(define er-bif-file-list-dir
(fn (vs)
(let ((path (er-source-to-string (nth vs 0))))
(cond
(= path nil)
(er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
:else
(let ((res (list nil)) (err (list nil)))
(guard (c (:else (set-nth! err 0 c)))
(set-nth! res 0 (file-list-dir path)))
(cond
(not (= (nth err 0) nil))
(er-mk-tuple (list (er-mk-atom "error")
(er-classify-file-error (nth err 0))))
:else
(er-mk-tuple (list (er-mk-atom "ok")
(er-of-sx (nth res 0))))))))))
;; ── builtin BIF registrations (Phase 8 migration) ────────────────
;; Populates `er-bif-registry` with every existing built-in BIF. Each
;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register
;; once per arity. Called eagerly at the end of runtime.sx so the
;; registry is ready before any erlang-eval-ast call.
(define er-register-builtin-bifs!
(fn ()
;; erlang module — type predicates (all pure)
(er-register-pure-bif! "erlang" "is_integer" 1 er-bif-is-integer)
(er-register-pure-bif! "erlang" "is_atom" 1 er-bif-is-atom)
(er-register-pure-bif! "erlang" "is_list" 1 er-bif-is-list)
(er-register-pure-bif! "erlang" "is_tuple" 1 er-bif-is-tuple)
(er-register-pure-bif! "erlang" "is_number" 1 er-bif-is-number)
(er-register-pure-bif! "erlang" "is_float" 1 er-bif-is-float)
(er-register-pure-bif! "erlang" "is_boolean" 1 er-bif-is-boolean)
(er-register-pure-bif! "erlang" "is_pid" 1 er-bif-is-pid)
(er-register-pure-bif! "erlang" "is_reference" 1 er-bif-is-reference)
(er-register-pure-bif! "erlang" "is_binary" 1 er-bif-is-binary)
(er-register-pure-bif! "erlang" "is_function" 1 er-bif-is-function)
(er-register-pure-bif! "erlang" "is_function" 2 er-bif-is-function)
;; erlang module — pure data ops
(er-register-pure-bif! "erlang" "length" 1 er-bif-length)
(er-register-pure-bif! "erlang" "hd" 1 er-bif-hd)
(er-register-pure-bif! "erlang" "tl" 1 er-bif-tl)
(er-register-pure-bif! "erlang" "element" 2 er-bif-element)
(er-register-pure-bif! "erlang" "tuple_size" 1 er-bif-tuple-size)
(er-register-pure-bif! "erlang" "byte_size" 1 er-bif-byte-size)
(er-register-pure-bif! "erlang" "atom_to_list" 1 er-bif-atom-to-list)
(er-register-pure-bif! "erlang" "list_to_atom" 1 er-bif-list-to-atom)
(er-register-pure-bif! "erlang" "abs" 1 er-bif-abs)
(er-register-pure-bif! "erlang" "min" 2 er-bif-min)
(er-register-pure-bif! "erlang" "max" 2 er-bif-max)
(er-register-pure-bif! "erlang" "tuple_to_list" 1 er-bif-tuple-to-list)
(er-register-pure-bif! "erlang" "list_to_tuple" 1 er-bif-list-to-tuple)
(er-register-pure-bif! "erlang" "integer_to_list" 1 er-bif-integer-to-list)
(er-register-pure-bif! "erlang" "list_to_integer" 1 er-bif-list-to-integer)
;; erlang module — process / runtime (side-effecting)
(er-register-bif! "erlang" "self" 0 er-bif-self)
(er-register-bif! "erlang" "spawn" 1 er-bif-spawn)
(er-register-bif! "erlang" "spawn" 3 er-bif-spawn)
(er-register-bif! "erlang" "exit" 1 er-bif-exit)
(er-register-bif! "erlang" "exit" 2 er-bif-exit)
(er-register-bif! "erlang" "make_ref" 0 er-bif-make-ref)
(er-register-bif! "erlang" "link" 1 er-bif-link)
(er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
(er-register-bif! "erlang" "monitor" 2 er-bif-monitor)
(er-register-bif! "erlang" "demonitor" 1 er-bif-demonitor)
(er-register-bif! "erlang" "process_flag" 2 er-bif-process-flag)
(er-register-bif! "erlang" "register" 2 er-bif-register)
(er-register-bif! "erlang" "unregister" 1 er-bif-unregister)
(er-register-bif! "erlang" "whereis" 1 er-bif-whereis)
(er-register-bif! "erlang" "registered" 0 er-bif-registered)
;; erlang module — exception raising (modelled as side-effecting)
(er-register-bif! "erlang" "throw" 1
(fn (vs) (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))))
(er-register-bif! "erlang" "error" 1
(fn (vs) (raise (er-mk-error-marker (er-bif-arg1 vs "error")))))
;; lists module — all pure
(er-register-pure-bif! "lists" "reverse" 1 er-bif-lists-reverse)
(er-register-pure-bif! "lists" "map" 2 er-bif-lists-map)
(er-register-pure-bif! "lists" "foldl" 3 er-bif-lists-foldl)
(er-register-pure-bif! "lists" "seq" 2 er-bif-lists-seq)
(er-register-pure-bif! "lists" "seq" 3 er-bif-lists-seq)
(er-register-pure-bif! "lists" "sum" 1 er-bif-lists-sum)
(er-register-pure-bif! "lists" "nth" 2 er-bif-lists-nth)
(er-register-pure-bif! "lists" "last" 1 er-bif-lists-last)
(er-register-pure-bif! "lists" "member" 2 er-bif-lists-member)
(er-register-pure-bif! "lists" "append" 2 er-bif-lists-append)
(er-register-pure-bif! "lists" "filter" 2 er-bif-lists-filter)
(er-register-pure-bif! "lists" "any" 2 er-bif-lists-any)
(er-register-pure-bif! "lists" "all" 2 er-bif-lists-all)
(er-register-pure-bif! "lists" "duplicate" 2 er-bif-lists-duplicate)
;; io module — side-effecting (writes to io buffer)
(er-register-bif! "io" "format" 1 er-bif-io-format)
(er-register-bif! "io" "format" 2 er-bif-io-format)
;; ets module — side-effecting (mutates table state)
(er-register-bif! "ets" "new" 2 er-bif-ets-new)
(er-register-bif! "ets" "insert" 2 er-bif-ets-insert)
(er-register-bif! "ets" "lookup" 2 er-bif-ets-lookup)
(er-register-bif! "ets" "delete" 1 er-bif-ets-delete)
(er-register-bif! "ets" "delete" 2 er-bif-ets-delete)
(er-register-bif! "ets" "tab2list" 1 er-bif-ets-tab2list)
(er-register-bif! "ets" "info" 2 er-bif-ets-info)
;; code module — side-effecting (mutates module registry, kills procs)
(er-register-bif! "code" "load_binary" 3 er-bif-code-load-binary)
(er-register-bif! "code" "purge" 1 er-bif-code-purge)
(er-register-bif! "code" "soft_purge" 1 er-bif-code-soft-purge)
(er-register-bif! "code" "which" 1 er-bif-code-which)
(er-register-bif! "code" "is_loaded" 1 er-bif-code-is-loaded)
(er-register-bif! "code" "all_loaded" 0 er-bif-code-all-loaded)
;; file module
(er-register-bif! "file" "read_file" 1 er-bif-file-read-file)
(er-register-bif! "file" "write_file" 2 er-bif-file-write-file)
(er-register-bif! "file" "delete" 1 er-bif-file-delete)
;; Phase 8 FFI — host-primitive BIFs (loops/fed-prims)
(er-register-pure-bif! "crypto" "hash" 2 er-bif-crypto-hash)
(er-register-pure-bif! "cid" "from_bytes" 1 er-bif-cid-from-bytes)
(er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
(er-register-bif! "file" "list_dir" 1 er-bif-file-list-dir)
(er-mk-atom "ok")))
;; Register everything at load time.
(er-register-builtin-bifs!)

View File

@@ -1,16 +1,18 @@
{ {
"language": "erlang", "language": "erlang",
"total_pass": 530, "total_pass": 729,
"total": 530, "total": 729,
"suites": [ "suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"}, {"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"}, {"name":"parse","pass":52,"total":52,"status":"ok"},
{"name":"eval","pass":346,"total":346,"status":"ok"}, {"name":"eval","pass":385,"total":385,"status":"ok"},
{"name":"runtime","pass":39,"total":39,"status":"ok"}, {"name":"runtime","pass":93,"total":93,"status":"ok"},
{"name":"ring","pass":4,"total":4,"status":"ok"}, {"name":"ring","pass":4,"total":4,"status":"ok"},
{"name":"ping-pong","pass":4,"total":4,"status":"ok"}, {"name":"ping-pong","pass":4,"total":4,"status":"ok"},
{"name":"bank","pass":8,"total":8,"status":"ok"}, {"name":"bank","pass":8,"total":8,"status":"ok"},
{"name":"echo","pass":7,"total":7,"status":"ok"}, {"name":"echo","pass":7,"total":7,"status":"ok"},
{"name":"fib","pass":8,"total":8,"status":"ok"} {"name":"fib","pass":8,"total":8,"status":"ok"},
{"name":"ffi","pass":28,"total":28,"status":"ok"},
{"name":"vm","pass":78,"total":78,"status":"ok"}
] ]
} }

View File

@@ -1,18 +1,20 @@
# Erlang-on-SX Scoreboard # Erlang-on-SX Scoreboard
**Total: 530 / 530 tests passing** **Total: 729 / 729 tests passing**
| | Suite | Pass | Total | | | Suite | Pass | Total |
|---|---|---|---| |---|---|---|---|
| ✅ | tokenize | 62 | 62 | | ✅ | tokenize | 62 | 62 |
| ✅ | parse | 52 | 52 | | ✅ | parse | 52 | 52 |
| ✅ | eval | 346 | 346 | | ✅ | eval | 385 | 385 |
| ✅ | runtime | 39 | 39 | | ✅ | runtime | 93 | 93 |
| ✅ | ring | 4 | 4 | | ✅ | ring | 4 | 4 |
| ✅ | ping-pong | 4 | 4 | | ✅ | ping-pong | 4 | 4 |
| ✅ | bank | 8 | 8 | | ✅ | bank | 8 | 8 |
| ✅ | echo | 7 | 7 | | ✅ | echo | 7 | 7 |
| ✅ | fib | 8 | 8 | | ✅ | fib | 8 | 8 |
| ✅ | ffi | 28 | 28 |
| ✅ | vm | 78 | 78 |
Generated by `lib/erlang/conformance.sh`. Generated by `lib/erlang/conformance.sh`.

View File

@@ -1125,6 +1125,222 @@
(er-eval-test "lists:duplicate val" (er-eval-test "lists:duplicate val"
(nm (ev "hd(lists:duplicate(3, marker))")) "marker") (nm (ev "hd(lists:duplicate(3, marker))")) "marker")
;; ── Phase 7: code:load_binary/3 ───────────────────────────────
(er-modules-reset!)
(er-eval-test "code:load_binary ok tag"
(nm (ev "element(1, code:load_binary(cl1, \"cl1.erl\", \"-module(cl1). foo() -> 1.\"))"))
"module")
(er-eval-test "code:load_binary ok name"
(nm (ev "element(2, code:load_binary(cl1, \"cl1.erl\", \"-module(cl1). foo() -> 1.\"))"))
"cl1")
(er-eval-test "code:load_binary then call"
(ev "cl1:foo()") 1)
(er-eval-test "code:load_binary reload v2"
(ev "code:load_binary(cl1, \"cl1.erl\", \"-module(cl1). foo() -> 99.\"), cl1:foo()")
99)
(er-eval-test "code:load_binary name mismatch tag"
(nm (ev "element(1, code:load_binary(cl2, \"x.erl\", \"-module(other). f() -> 0.\"))"))
"error")
(er-eval-test "code:load_binary name mismatch reason"
(nm (ev "element(2, code:load_binary(cl2, \"x.erl\", \"-module(other). f() -> 0.\"))"))
"module_name_mismatch")
(er-eval-test "code:load_binary badfile on garbage"
(nm (ev "element(2, code:load_binary(cl3, \"x.erl\", \"this is not erlang\"))"))
"badfile")
(er-eval-test "code:load_binary non-atom mod is badarg"
(nm (ev "element(2, code:load_binary(\"cl1\", \"x.erl\", \"-module(cl1). f() -> 0.\"))"))
"badarg")
;; ── Phase 7: code:purge/1 + code:soft_purge/1 ───────────────────
(er-modules-reset!)
;; purge unknown module → false
(er-eval-test "code:purge unknown"
(nm (ev "code:purge(nope)")) "false")
;; load, then purge without old version → false (nothing to purge)
(er-eval-test "code:purge no old"
(nm (ev "code:load_binary(pg1, \"pg1\", \"-module(pg1). v() -> 1.\"), code:purge(pg1)"))
"false")
;; load v1, load v2 (creates :old), purge with no live procs → true
(er-eval-test "code:purge after reload"
(nm (ev "code:load_binary(pg2, \"pg2\", \"-module(pg2). v() -> 1.\"), code:load_binary(pg2, \"pg2\", \"-module(pg2). v() -> 2.\"), code:purge(pg2)"))
"true")
;; idempotent: purging again returns false (already purged)
(er-eval-test "code:purge twice"
(nm (ev "code:load_binary(pg3, \"pg3\", \"-module(pg3). v() -> 1.\"), code:load_binary(pg3, \"pg3\", \"-module(pg3). v() -> 2.\"), code:purge(pg3), code:purge(pg3)"))
"false")
;; purge returns true whenever an :old slot exists, regardless of process tracking
;; (proper "kill lingering" semantics requires spawn/3 which is still stubbed)
(er-eval-test "code:purge with old slot present"
(nm (ev "code:load_binary(pg4, \"pg4\", \"-module(pg4). loop() -> receive stop -> ok end.\"),
Pid = spawn(fun () -> pg4:loop() end),
code:load_binary(pg4, \"pg4\", \"-module(pg4). loop() -> receive stop -> done end.\"),
code:purge(pg4)"))
"true")
;; soft_purge unknown → true (nothing to purge)
(er-eval-test "code:soft_purge unknown"
(nm (ev "code:soft_purge(nope)")) "true")
;; soft_purge with no old version → true
(er-eval-test "code:soft_purge no old"
(nm (ev "code:load_binary(sp1, \"sp1\", \"-module(sp1). v() -> 1.\"), code:soft_purge(sp1)"))
"true")
;; soft_purge with old + no lingering procs → true (clears :old)
(er-eval-test "code:soft_purge clean"
(nm (ev "code:load_binary(sp2, \"sp2\", \"-module(sp2). v() -> 1.\"), code:load_binary(sp2, \"sp2\", \"-module(sp2). v() -> 2.\"), code:soft_purge(sp2)"))
"true")
;; non-atom Mod is badarg (raise)
(er-eval-test "code:purge badarg"
(nm (ev "try code:purge(\"str\") catch error:badarg -> ok end")) "ok")
(er-eval-test "code:soft_purge badarg"
(nm (ev "try code:soft_purge(123) catch error:badarg -> ok end")) "ok")
;; ── Phase 7: code:which/1 + code:is_loaded/1 + code:all_loaded/0 ──
(er-modules-reset!)
(er-eval-test "code:which non_existing"
(nm (ev "code:which(nope)")) "non_existing")
(er-eval-test "code:which after load"
(nm (ev "code:load_binary(wh1, \"wh1\", \"-module(wh1). v() -> 1.\"), code:which(wh1)"))
"loaded")
(er-eval-test "code:is_loaded missing"
(nm (ev "code:is_loaded(nope)")) "false")
(er-eval-test "code:is_loaded tag"
(nm (ev "code:load_binary(il1, \"il1\", \"-module(il1). v() -> 1.\"), element(1, code:is_loaded(il1))"))
"file")
(er-eval-test "code:is_loaded value"
(nm (ev "code:load_binary(il2, \"il2\", \"-module(il2). v() -> 1.\"), element(2, code:is_loaded(il2))"))
"loaded")
(er-modules-reset!)
(er-eval-test "code:all_loaded empty"
(ev "length(code:all_loaded())") 0)
(er-modules-reset!)
(er-eval-test "code:all_loaded count"
(ev "code:load_binary(al1, \"al1\", \"-module(al1). v() -> 1.\"),
code:load_binary(al2, \"al2\", \"-module(al2). v() -> 1.\"),
length(code:all_loaded())")
2)
(er-eval-test "code:all_loaded first entry tag"
(nm (ev "code:load_binary(al3, \"al3\", \"-module(al3). v() -> 1.\"),
element(2, hd(code:all_loaded()))"))
"loaded")
(er-eval-test "code:which badarg"
(nm (ev "try code:which(\"str\") catch error:badarg -> ok end")) "ok")
(er-eval-test "code:is_loaded badarg"
(nm (ev "try code:is_loaded(123) catch error:badarg -> ok end")) "ok")
;; ── Phase 7: hot-reload call dispatch semantics ──────────────────
;; Cross-module M:F() calls always hit the CURRENT version;
;; local F() calls inside a module body resolve through the env
;; the function closed over (i.e. the version it was loaded with).
(er-modules-reset!)
;; M:F always hits current
(er-eval-test "cross-mod after reload v2"
(ev "code:load_binary(hr1, \"hr1\", \"-module(hr1). f() -> 1.\"),
code:load_binary(hr1, \"hr1\", \"-module(hr1). f() -> 2.\"),
hr1:f()")
2)
;; Local call inside reloaded module body resolves via fresh mod-env
;; (a() does a local b(); b() got upgraded too)
(er-eval-test "local call inside reloaded module body"
(ev "code:load_binary(hr2, \"hr2\", \"-module(hr2). a() -> b(). b() -> 1.\"),
code:load_binary(hr2, \"hr2\", \"-module(hr2). a() -> b(). b() -> 99.\"),
hr2:a()")
99)
;; Fun captured BEFORE reload, with local-call body, keeps v1 semantics
(er-eval-test "captured fun keeps closed-over env (local call)"
(ev "code:load_binary(hr3, \"hr3\", \"-module(hr3). get_fn() -> fun () -> b() end. b() -> 1.\"),
Fn = hr3:get_fn(),
code:load_binary(hr3, \"hr3\", \"-module(hr3). get_fn() -> fun () -> b() end. b() -> 99.\"),
Fn()")
1)
;; Fun captured BEFORE reload, with CROSS-mod body, sees v2's current
(er-eval-test "captured fun follows cross-mod to current"
(ev "code:load_binary(hr4, \"hr4\", \"-module(hr4). get_xref() -> fun () -> hr4:b() end. b() -> 1.\"),
Fn = hr4:get_xref(),
code:load_binary(hr4, \"hr4\", \"-module(hr4). get_xref() -> fun () -> hr4:b() end. b() -> 99.\"),
Fn()")
99)
;; Two captured funs from two different vintages
(er-eval-test "two funs from two vintages stay independent"
(ev "code:load_binary(hr5, \"hr5\", \"-module(hr5). gf() -> fun () -> v() end. v() -> 10.\"),
F1 = hr5:gf(),
code:load_binary(hr5, \"hr5\", \"-module(hr5). gf() -> fun () -> v() end. v() -> 20.\"),
F2 = hr5:gf(),
F1() + F2()")
30)
;; Version slot bumps correctly when a captured fun stays alive
(er-eval-test "version bumps despite captured funs"
(ev "code:load_binary(hr6, \"hr6\", \"-module(hr6). gf() -> fun () -> v() end. v() -> 1.\"),
_Pinned = hr6:gf(),
code:load_binary(hr6, \"hr6\", \"-module(hr6). gf() -> fun () -> v() end. v() -> 2.\"),
code:load_binary(hr6, \"hr6\", \"-module(hr6). gf() -> fun () -> v() end. v() -> 3.\"),
hr6:v()")
3)
;; ── Phase 7 capstone: full hot-reload ladder ───────────────────
;; Load v1 → spawn from inside module → load v2 → cross-mod hits v2 →
;; local call inside v1 process still resolves v1 → soft_purge refuses
;; while v1 procs alive → purge kills them.
;;
;; All stages must run in a single erlang-eval-ast call: each call resets
;; the scheduler (er-sched-init!) so cross-call Pid handles would point at
;; reaped processes.
(er-modules-reset!)
(define er-rt-cap-prog "code:load_binary(cap, \"cap.erl\", \"-module(cap). start() -> spawn(fun () -> loop() end). loop() -> receive {ping, From} -> From ! {pong, v1}, loop(); stop -> done end. tag() -> v1.\"), Tag1 = cap:tag(), Pid1 = cap:start(), code:load_binary(cap, \"cap.erl\", \"-module(cap). start() -> spawn(fun () -> loop() end). loop() -> receive {ping, From} -> From ! {pong, v2}, loop(); stop -> done end. tag() -> v2.\"), Tag2 = cap:tag(), _Pid2 = cap:start(), Soft1 = code:soft_purge(cap), Hard = code:purge(cap), Soft2 = code:soft_purge(cap), {Tag1, Tag2, Soft1, Hard, Soft2}")
(define er-rt-cap-result (ev er-rt-cap-prog))
(er-eval-test "capstone v1 tag direct"
(get (nth (get er-rt-cap-result :elements) 0) :name) "v1")
(er-eval-test "capstone v2 tag"
(get (nth (get er-rt-cap-result :elements) 1) :name) "v2")
(er-eval-test "capstone soft_purge while v1 alive = false"
(get (nth (get er-rt-cap-result :elements) 2) :name) "false")
(er-eval-test "capstone hard purge = true"
(get (nth (get er-rt-cap-result :elements) 3) :name) "true")
(er-eval-test "capstone soft_purge clean after hard = true"
(get (nth (get er-rt-cap-result :elements) 4) :name) "true")
(define (define
er-eval-test-summary er-eval-test-summary
(str "eval " er-eval-test-pass "/" er-eval-test-count)) (str "eval " er-eval-test-pass "/" er-eval-test-count))

178
lib/erlang/tests/ffi.sx Normal file
View File

@@ -0,0 +1,178 @@
;; Phase 8 FFI BIF tests — one round-trip per BIF.
;; Each BIF lives in lib/erlang/runtime.sx (registered with
;; er-bif-registry) and wraps an SX-host primitive.
(define er-ffi-test-count 0)
(define er-ffi-test-pass 0)
(define er-ffi-test-fails (list))
(define
er-ffi-test
(fn
(name actual expected)
(set! er-ffi-test-count (+ er-ffi-test-count 1))
(if
(= actual expected)
(set! er-ffi-test-pass (+ er-ffi-test-pass 1))
(append! er-ffi-test-fails {:name name :expected expected :actual actual}))))
(define ffi-ev erlang-eval-ast)
(define ffi-nm (fn (v) (get v :name)))
;; ── file:read_file/1 + file:write_file/2 ────────────────────────
(er-ffi-test
"file:write_file ok"
(ffi-nm (ffi-ev "file:write_file(\"/tmp/er-ffi-1.txt\", \"hello\")"))
"ok")
(er-ffi-test
"file:read_file ok tag"
(ffi-nm (ffi-ev "element(1, file:read_file(\"/tmp/er-ffi-1.txt\"))"))
"ok")
(er-ffi-test
"file:read_file payload is binary"
(ffi-nm
(ffi-ev
"case file:read_file(\"/tmp/er-ffi-1.txt\") of {ok, B} -> is_binary(B) end"))
"true")
(er-ffi-test
"file:read_file content byte_size"
(ffi-ev
"case file:read_file(\"/tmp/er-ffi-1.txt\") of {ok, B} -> byte_size(B) end")
5)
(er-ffi-test
"file:read_file missing enoent"
(ffi-nm (ffi-ev "element(2, file:read_file(\"/tmp/er-ffi-no-such-xyz\"))"))
"enoent")
(er-ffi-test
"file:write_file bad path enoent"
(ffi-nm
(ffi-ev "element(2, file:write_file(\"/tmp/er-ffi-no-dir-xyz/x\", \"y\"))"))
"enoent")
(er-ffi-test
"file:write_file binary payload"
(ffi-ev
"file:write_file(\"/tmp/er-ffi-2.bin\", <<1, 2, 3, 4, 5>>), case file:read_file(\"/tmp/er-ffi-2.bin\") of {ok, B} -> byte_size(B) end")
5)
;; ── file:delete/1 ────────────────────────────────────────────────
(er-ffi-test
"file:delete ok"
(ffi-nm
(ffi-ev
"file:write_file(\"/tmp/er-ffi-del.txt\", \"x\"), file:delete(\"/tmp/er-ffi-del.txt\")"))
"ok")
(er-ffi-test
"file:read_file after delete enoent"
(ffi-nm
(ffi-ev
"file:write_file(\"/tmp/er-ffi-del2.txt\", \"x\"), file:delete(\"/tmp/er-ffi-del2.txt\"), element(2, file:read_file(\"/tmp/er-ffi-del2.txt\"))"))
"enoent")
(er-ffi-test
"crypto:hash sha256 -> 32-byte binary"
(ffi-ev "byte_size(crypto:hash(sha256, <<97,98,99>>))")
32)
(er-ffi-test
"crypto:hash sha512 -> 64-byte binary"
(ffi-ev "byte_size(crypto:hash(sha512, <<97,98,99>>))")
64)
(er-ffi-test
"crypto:hash sha3_256 is_binary"
(ffi-nm (ffi-ev "is_binary(crypto:hash(sha3_256, <<120>>))"))
"true")
(er-ffi-test
"crypto:hash deterministic"
(ffi-nm (ffi-ev "crypto:hash(sha256, <<97>>) =:= crypto:hash(sha256, <<97>>)"))
"true")
(er-ffi-test
"crypto:hash distinct inputs distinct digests"
(ffi-nm (ffi-ev "crypto:hash(sha256, <<97>>) =/= crypto:hash(sha256, <<98>>)"))
"true")
(er-ffi-test
"crypto:hash bad type -> error:badarg"
(ffi-nm (ffi-ev "try crypto:hash(md5, <<120>>) catch error:badarg -> ok end"))
"ok")
(er-ffi-test
"cid:from_bytes is_binary"
(ffi-nm (ffi-ev "is_binary(cid:from_bytes(<<97,98,99>>))"))
"true")
(er-ffi-test
"cid:from_bytes deterministic"
(ffi-nm (ffi-ev "cid:from_bytes(<<97,98,99>>) =:= cid:from_bytes(<<97,98,99>>)"))
"true")
(er-ffi-test
"cid:from_bytes distinct inputs distinct CIDs"
(ffi-nm (ffi-ev "cid:from_bytes(<<97,98,99>>) =/= cid:from_bytes(<<97,98,100>>)"))
"true")
(er-ffi-test
"cid:from_bytes non-binary -> error:badarg"
(ffi-nm (ffi-ev "try cid:from_bytes(42) catch error:badarg -> ok end"))
"ok")
(er-ffi-test
"cid:to_string is_binary"
(ffi-nm (ffi-ev "is_binary(cid:to_string({ok, 42}))"))
"true")
(er-ffi-test
"cid:to_string deterministic"
(ffi-nm (ffi-ev "cid:to_string(foo) =:= cid:to_string(foo)"))
"true")
(er-ffi-test
"cid:to_string distinct terms distinct CIDs"
(ffi-nm (ffi-ev "cid:to_string(foo) =/= cid:to_string(bar)"))
"true")
(er-ffi-test
"file:list_dir ok tag"
(ffi-nm (ffi-ev "element(1, file:list_dir(\"lib/erlang\"))"))
"ok")
(er-ffi-test
"file:list_dir non-empty"
(ffi-nm (ffi-ev "case file:list_dir(\"lib/erlang\") of {ok, L} -> length(L) > 3 end"))
"true")
(er-ffi-test
"file:list_dir entries are binaries"
(ffi-nm (ffi-ev "case file:list_dir(\"lib/erlang\") of {ok, L} -> is_binary(hd(L)) end"))
"true")
(er-ffi-test
"file:list_dir missing enoent"
(ffi-nm (ffi-ev "element(2, file:list_dir(\"/no/such/dir/xyz\"))"))
"enoent")
;; ── Still deferred (no host primitive): httpc (HTTP client, v2),
;; sqlite-* (v2 indexes). Assert NOT registered so a future iteration
;; that wires them without updating this suite fails fast.
(er-ffi-test
"httpc:request unregistered"
(er-lookup-bif "httpc" "request" 4)
nil)
(er-ffi-test
"sqlite:exec unregistered"
(er-lookup-bif "sqlite" "exec" 2)
nil)
(define
er-ffi-test-summary
(str "ffi " er-ffi-test-pass "/" er-ffi-test-count))

View File

@@ -134,6 +134,144 @@
(er-sched-current-pid) (er-sched-current-pid)
nil) nil)
;; ── Phase 7: module-version slots ───────────────────────────────
(er-modules-reset!)
(define er-rt-slot1 (er-mk-module-slot (er-env-new) nil 1))
(er-rt-test "slot tag" (get er-rt-slot1 :tag) "module")
(er-rt-test "slot version" (er-module-version er-rt-slot1) 1)
(er-rt-test "slot old nil" (er-module-old-env er-rt-slot1) nil)
(er-rt-test "slot current not nil" (= (er-module-current-env er-rt-slot1) nil) false)
(erlang-load-module "-module(hr1). a() -> 1.")
(define er-rt-reg (er-modules-get))
(er-rt-test "registry has hr1" (dict-has? er-rt-reg "hr1") true)
(er-rt-test "v1 on first load" (er-module-version (get er-rt-reg "hr1")) 1)
(er-rt-test "v1 old is nil" (er-module-old-env (get er-rt-reg "hr1")) nil)
(er-rt-test "v1 current not nil" (= (er-module-current-env (get er-rt-reg "hr1")) nil) false)
(define er-rt-env-v1 (er-module-current-env (get er-rt-reg "hr1")))
(erlang-load-module "-module(hr1). a() -> 2.")
(er-rt-test "v2 on second load" (er-module-version (get er-rt-reg "hr1")) 2)
(er-rt-test "v2 old is v1 env" (er-module-old-env (get er-rt-reg "hr1")) er-rt-env-v1)
(er-rt-test "v2 current is new" (= (er-module-current-env (get er-rt-reg "hr1")) er-rt-env-v1) false)
(erlang-load-module "-module(hr1). a() -> 3.")
(er-rt-test "v3 on third load" (er-module-version (get er-rt-reg "hr1")) 3)
(er-modules-reset!)
(er-rt-test "registry-reset clears" (dict-has? (er-modules-get) "hr1") false)
;; ── Phase 8: FFI BIF registry ──────────────────────────────────
(er-bif-registry-reset!)
(er-rt-test "empty registry" (len (er-list-bifs)) 0)
(er-rt-test "lookup miss" (er-lookup-bif "crypto" "hash" 2) nil)
(er-register-bif! "fake" "echo" 1 (fn (vs) (nth vs 0)))
(er-rt-test "register grows registry" (len (er-list-bifs)) 1)
(define er-rt-bif-hit (er-lookup-bif "fake" "echo" 1))
(er-rt-test "lookup hit module" (get er-rt-bif-hit :module) "fake")
(er-rt-test "lookup hit name" (get er-rt-bif-hit :name) "echo")
(er-rt-test "lookup hit arity" (get er-rt-bif-hit :arity) 1)
(er-rt-test "lookup hit pure?" (get er-rt-bif-hit :pure?) false)
(er-rt-test "fn invocable" ((get er-rt-bif-hit :fn) (list 42)) 42)
;; Re-register replaces (same key)
(er-register-bif! "fake" "echo" 1 (fn (vs) "replaced"))
(er-rt-test "re-register same key, count unchanged" (len (er-list-bifs)) 1)
(er-rt-test "re-register replaces fn"
((get (er-lookup-bif "fake" "echo" 1) :fn) (list 99)) "replaced")
;; Pure variant
(er-register-pure-bif! "fake" "pure" 2 (fn (vs) (+ (nth vs 0) (nth vs 1))))
(er-rt-test "pure registered separately, count 2" (len (er-list-bifs)) 2)
(er-rt-test "pure flag true"
(get (er-lookup-bif "fake" "pure" 2) :pure?) true)
(er-rt-test "pure fn invocable"
((get (er-lookup-bif "fake" "pure" 2) :fn) (list 7 8)) 15)
;; Arity disambiguation: same module+name, different arity = distinct entries
(er-register-bif! "fake" "echo" 2 (fn (vs) (list (nth vs 0) (nth vs 1))))
(er-rt-test "arity disambiguation count" (len (er-list-bifs)) 3)
(er-rt-test "arity-1 lookup still works"
((get (er-lookup-bif "fake" "echo" 1) :fn) (list 11)) "replaced")
(er-rt-test "arity-2 lookup independent"
(len ((get (er-lookup-bif "fake" "echo" 2) :fn) (list 1 2))) 2)
;; Reset clears the registry
(er-bif-registry-reset!)
(er-rt-test "reset clears" (len (er-list-bifs)) 0)
(er-rt-test "reset lookup nil" (er-lookup-bif "fake" "echo" 1) nil)
;; ── Phase 8: term marshalling (er-to-sx / er-of-sx) ─────────────
;; er-to-sx: Erlang → SX
(er-rt-test "to-sx atom" (er-to-sx (er-mk-atom "foo")) (make-symbol "foo"))
(er-rt-test "to-sx atom is symbol" (type-of (er-to-sx (er-mk-atom "x"))) "symbol")
(er-rt-test "to-sx nil" (er-to-sx (er-mk-nil)) (list))
(er-rt-test "to-sx integer passthrough" (er-to-sx 42) 42)
(er-rt-test "to-sx float passthrough" (er-to-sx 3.14) 3.14)
(er-rt-test "to-sx boolean passthrough" (er-to-sx true) true)
(er-rt-test "to-sx binary → string"
(er-to-sx (er-mk-binary (list 104 105 33))) "hi!")
(er-rt-test "to-sx cons → list"
(er-to-sx (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))) (list 1 2 3))
(er-rt-test "to-sx tuple → list"
(er-to-sx (er-mk-tuple (list 1 2 3))) (list 1 2 3))
(er-rt-test "to-sx nested cons"
(er-to-sx (er-mk-cons (er-mk-atom "a") (er-mk-cons 7 (er-mk-nil))))
(list (make-symbol "a") 7))
;; er-of-sx: SX → Erlang
(er-rt-test "of-sx symbol"
(get (er-of-sx (make-symbol "ok")) :name) "ok")
(er-rt-test "of-sx symbol is atom"
(er-atom? (er-of-sx (make-symbol "x"))) true)
(er-rt-test "of-sx string is binary"
(er-binary? (er-of-sx "hi")) true)
(er-rt-test "of-sx string bytes"
(get (er-of-sx "hi") :bytes) (list 104 105))
(er-rt-test "of-sx integer passthrough"
(er-of-sx 42) 42)
(er-rt-test "of-sx empty list → nil"
(er-nil? (er-of-sx (list))) true)
(er-rt-test "of-sx list → cons chain length"
(er-list-length (er-of-sx (list 1 2 3 4))) 4)
(er-rt-test "of-sx list head/tail"
(get (er-of-sx (list 10 20)) :head) 10)
;; Round-trips
(er-rt-test "rtrip integer" (er-to-sx (er-of-sx 99)) 99)
(er-rt-test "rtrip atom"
(get (er-of-sx (er-to-sx (er-mk-atom "abc"))) :name) "abc")
(er-rt-test "rtrip binary bytes"
(get (er-of-sx (er-to-sx (er-mk-binary (list 1 2 3)))) :bytes) (list 1 2 3))
(er-rt-test "rtrip cons-of-ints length"
(er-list-length (er-of-sx (er-to-sx
(er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))))) 3)
;; Tuples don't round-trip exactly (er-to-sx flattens tuples to lists);
;; documented one-way conversion.
(er-rt-test "to-sx of tuple loses tag"
(er-cons? (er-of-sx (er-to-sx (er-mk-tuple (list 1 2 3))))) true)
;; Re-populate built-in BIFs so subsequent test files (ring, ping-pong, etc.)
;; can call length/spawn/etc. The migration onto the registry means a reset
;; here would otherwise break the rest of the conformance suite.
(er-register-builtin-bifs!)
(define (define
er-rt-test-summary er-rt-test-summary
(str "runtime " er-rt-test-pass "/" er-rt-test-count)) (str "runtime " er-rt-test-pass "/" er-rt-test-count))

403
lib/erlang/tests/vm.sx Normal file
View File

@@ -0,0 +1,403 @@
;; Phase 9 — stub VM opcode dispatcher tests.
;; Verifies the dispatcher shape (mirrors plans/sx-vm-opcode-extension.md
;; for when 9a integrates) and the three pattern-match opcodes (9b)
;; route to the correct er-match-* impl.
(define er-vm-test-count 0)
(define er-vm-test-pass 0)
(define er-vm-test-fails (list))
(define
er-vm-test
(fn
(name actual expected)
(set! er-vm-test-count (+ er-vm-test-count 1))
(if
(= actual expected)
(set! er-vm-test-pass (+ er-vm-test-pass 1))
(append! er-vm-test-fails {:name name :expected expected :actual actual}))))
;; ── dispatcher core ─────────────────────────────────────────────
(er-vm-test
"tuple opcode registered"
(= (er-vm-lookup-opcode-by-id 128) nil)
false)
(er-vm-test
"tuple opcode name"
(get (er-vm-lookup-opcode-by-id 128) :name)
"OP_PATTERN_TUPLE")
(er-vm-test
"list opcode by name"
(get (er-vm-lookup-opcode-by-name "OP_PATTERN_LIST") :id)
129)
(er-vm-test
"binary opcode by name"
(get (er-vm-lookup-opcode-by-name "OP_PATTERN_BINARY") :id)
130)
(er-vm-test "lookup miss by id" (er-vm-lookup-opcode-by-id 999) nil)
(er-vm-test "lookup miss by name" (er-vm-lookup-opcode-by-name "OP_NOPE") nil)
(er-vm-test
"opcode list has 3+"
(>= (len (er-vm-list-opcodes)) 3)
true)
;; ── OP_PATTERN_TUPLE ────────────────────────────────────────────
;; Pattern: {ok, X} matches value {ok, 42} → X bound to 42
(define er-vm-t1-env (er-env-new))
(define er-vm-t1-pat {:type "tuple" :elements (list {:type "atom" :value "ok"} {:name "X" :type "var"})})
(define er-vm-t1-val (er-mk-tuple (list (er-mk-atom "ok") 42)))
(er-vm-test
"OP_PATTERN_TUPLE match"
(er-vm-dispatch 128 (list er-vm-t1-pat er-vm-t1-val er-vm-t1-env))
true)
(er-vm-test "OP_PATTERN_TUPLE binds var" (get er-vm-t1-env "X") 42)
;; Same pattern against {error, ...} → false
(define er-vm-t2-env (er-env-new))
(define er-vm-t2-val (er-mk-tuple (list (er-mk-atom "error") 7)))
(er-vm-test
"OP_PATTERN_TUPLE no-match"
(er-vm-dispatch 128 (list er-vm-t1-pat er-vm-t2-val er-vm-t2-env))
false)
;; Wrong arity tuple — pattern has 2 elements, value has 3
(define er-vm-t3-env (er-env-new))
(define
er-vm-t3-val
(er-mk-tuple (list (er-mk-atom "ok") 1 2)))
(er-vm-test
"OP_PATTERN_TUPLE arity mismatch"
(er-vm-dispatch 128 (list er-vm-t1-pat er-vm-t3-val er-vm-t3-env))
false)
;; ── OP_PATTERN_LIST (cons) ──────────────────────────────────────
;; Pattern: [H | T] matches [1, 2, 3] → H=1, T=[2,3]
(define er-vm-l1-env (er-env-new))
(define er-vm-l1-pat {:type "cons" :tail {:name "T" :type "var"} :head {:name "H" :type "var"}})
(define
er-vm-l1-val
(er-mk-cons
1
(er-mk-cons 2 (er-mk-cons 3 (er-mk-nil)))))
(er-vm-test
"OP_PATTERN_LIST match"
(er-vm-dispatch 129 (list er-vm-l1-pat er-vm-l1-val er-vm-l1-env))
true)
(er-vm-test "OP_PATTERN_LIST binds head" (get er-vm-l1-env "H") 1)
(er-vm-test
"OP_PATTERN_LIST tail is cons"
(er-cons? (get er-vm-l1-env "T"))
true)
;; [H|T] against empty list → false
(define er-vm-l2-env (er-env-new))
(er-vm-test
"OP_PATTERN_LIST no-match on nil"
(er-vm-dispatch 129 (list er-vm-l1-pat (er-mk-nil) er-vm-l2-env))
false)
;; ── OP_PATTERN_BINARY ───────────────────────────────────────────
;; Pattern <<A:8>> against <<42>> → A bound to 42
(define er-vm-b1-env (er-env-new))
(define er-vm-b1-pat {:type "binary" :segments (list {:value {:name "A" :type "var"} :size {:type "integer" :value "8"} :spec "integer"})})
(define er-vm-b1-val (er-mk-binary (list 42)))
(er-vm-test
"OP_PATTERN_BINARY match"
(er-vm-dispatch 130 (list er-vm-b1-pat er-vm-b1-val er-vm-b1-env))
true)
(er-vm-test
"OP_PATTERN_BINARY binds segment"
(get er-vm-b1-env "A")
42)
;; Same pattern against wrong-size binary (2 bytes) → false
(define er-vm-b2-env (er-env-new))
(define er-vm-b2-val (er-mk-binary (list 42 99)))
(er-vm-test
"OP_PATTERN_BINARY size mismatch"
(er-vm-dispatch 130 (list er-vm-b1-pat er-vm-b2-val er-vm-b2-env))
false)
;; ── dispatch error path ────────────────────────────────────────
(define er-vm-err-caught (list nil))
(guard
(c (:else (set-nth! er-vm-err-caught 0 (str c))))
(er-vm-dispatch 999 (list)))
(er-vm-test
"unknown opcode raises"
(string-contains? (str (nth er-vm-err-caught 0)) "unknown opcode")
true)
;; ── Phase 9c — OP_PERFORM / OP_HANDLE ───────────────────────────
(er-vm-test "perform opcode by id"
(get (er-vm-lookup-opcode-by-id 131) :name) "OP_PERFORM")
(er-vm-test "handle opcode by id"
(get (er-vm-lookup-opcode-by-id 132) :name) "OP_HANDLE")
(define er-vm-pf-caught (list nil))
(guard (c (:else (set-nth! er-vm-pf-caught 0 c)))
(er-vm-dispatch 131 (list "yield" (list 42))))
(er-vm-test "perform raises tagged"
(get (nth er-vm-pf-caught 0) :tag) "vm-effect")
(er-vm-test "perform effect name"
(get (nth er-vm-pf-caught 0) :effect) "yield")
(er-vm-test "perform args carried"
(nth (get (nth er-vm-pf-caught 0) :args) 0) 42)
(er-vm-test "handle catches matching effect"
(er-vm-dispatch 132
(list
(fn () (er-vm-dispatch 131 (list "yield" (list 7))))
"yield"
(fn (args) (+ (nth args 0) 100))))
107)
(er-vm-test "handle no-effect returns thunk result"
(er-vm-dispatch 132
(list
(fn () 99)
"yield"
(fn (args) "handler ran")))
99)
(define er-vm-rt-caught (list nil))
(guard (c (:else (set-nth! er-vm-rt-caught 0 c)))
(er-vm-dispatch 132
(list
(fn () (er-vm-dispatch 131 (list "other" (list))))
"yield"
(fn (args) "wrong"))))
(er-vm-test "handle rethrows non-matching"
(get (nth er-vm-rt-caught 0) :effect) "other")
(er-vm-test "nested handles separate effect names"
(er-vm-dispatch 132
(list
(fn ()
(er-vm-dispatch 132
(list
(fn () (er-vm-dispatch 131 (list "b" (list 5))))
"a"
(fn (args) "inner-handled"))))
"b"
(fn (args) (+ (nth args 0) 1000))))
1005)
;; ── Phase 9d — OP_RECEIVE_SCAN ──────────────────────────────────
(er-vm-test "receive-scan opcode by id"
(get (er-vm-lookup-opcode-by-id 133) :name) "OP_RECEIVE_SCAN")
;; Pattern: receive {ok, X} -> X end against mailbox [{error, 1}, {ok, 42}, foo]
(define er-vm-r1-env (er-env-new))
(define er-vm-r1-clauses
(list
{:pattern {:type "tuple"
:elements (list
{:type "atom" :value "ok"}
{:type "var" :name "X"})}
:guards (list)
:body (list {:type "var" :name "X"})}))
(define er-vm-r1-mbox
(list
(er-mk-tuple (list (er-mk-atom "error") 1))
(er-mk-tuple (list (er-mk-atom "ok") 42))
(er-mk-atom "foo")))
(define er-vm-r1-result
(er-vm-dispatch 133 (list er-vm-r1-clauses er-vm-r1-mbox er-vm-r1-env)))
(er-vm-test "scan finds match"
(get er-vm-r1-result :matched) true)
(er-vm-test "scan reports correct index"
(get er-vm-r1-result :index) 1)
(er-vm-test "scan binds var"
(get er-vm-r1-env "X") 42)
(er-vm-test "scan leaves body unevaluated"
(= (get er-vm-r1-result :body) nil) false)
;; No match case
(define er-vm-r2-env (er-env-new))
(define er-vm-r2-mbox (list (er-mk-atom "nope") 99))
(define er-vm-r2-result
(er-vm-dispatch 133 (list er-vm-r1-clauses er-vm-r2-mbox er-vm-r2-env)))
(er-vm-test "scan no-match"
(get er-vm-r2-result :matched) false)
(er-vm-test "scan no-match leaves env clean"
(dict-has? er-vm-r2-env "X") false)
;; Empty mailbox
(define er-vm-r3-result
(er-vm-dispatch 133 (list er-vm-r1-clauses (list) (er-env-new))))
(er-vm-test "scan empty mailbox"
(get er-vm-r3-result :matched) false)
;; First-match wins (arrival order)
(define er-vm-r4-env (er-env-new))
(define er-vm-r4-mbox
(list
(er-mk-tuple (list (er-mk-atom "ok") 1))
(er-mk-tuple (list (er-mk-atom "ok") 2))))
(define er-vm-r4-result
(er-vm-dispatch 133 (list er-vm-r1-clauses er-vm-r4-mbox er-vm-r4-env)))
(er-vm-test "scan first-match wins (index 0)"
(get er-vm-r4-result :index) 0)
(er-vm-test "scan binds first match's var"
(get er-vm-r4-env "X") 1)
;; ── Phase 9e — OP_SPAWN / OP_SEND ───────────────────────────────
(er-vm-procs-reset!)
(er-vm-test "spawn opcode by id"
(get (er-vm-lookup-opcode-by-id 134) :name) "OP_SPAWN")
(er-vm-test "send opcode by id"
(get (er-vm-lookup-opcode-by-id 135) :name) "OP_SEND")
(define er-vm-fn (fn () "body"))
(define er-vm-p1 (er-vm-dispatch 134 (list er-vm-fn (list))))
(define er-vm-p2 (er-vm-dispatch 134 (list er-vm-fn (list "arg"))))
(er-vm-test "spawn returns pid 0 first"
er-vm-p1 0)
(er-vm-test "spawn returns pid 1 second"
er-vm-p2 1)
(er-vm-test "proc count is 2"
(er-vm-proc-count) 2)
(er-vm-test "spawned proc state runnable"
(er-vm-proc-state er-vm-p1) "runnable")
(er-vm-test "spawned proc mailbox empty"
(len (er-vm-proc-mailbox er-vm-p1)) 0)
(er-vm-test "spawned proc has 8 registers"
(len (get (er-vm-proc-get er-vm-p1) :registers)) 8)
;; OP_SEND appends to target's mailbox, preserves arrival order.
(er-vm-test "send returns true on valid pid"
(er-vm-dispatch 135 (list er-vm-p1 "msg1")) true)
(er-vm-dispatch 135 (list er-vm-p1 "msg2")
)
(er-vm-dispatch 135 (list er-vm-p1 "msg3"))
(er-vm-test "mailbox length after 3 sends"
(len (er-vm-proc-mailbox er-vm-p1)) 3)
(er-vm-test "mailbox preserves order — first"
(nth (er-vm-proc-mailbox er-vm-p1) 0) "msg1")
(er-vm-test "mailbox preserves order — last"
(nth (er-vm-proc-mailbox er-vm-p1) 2) "msg3")
;; send to nonexistent pid returns false (doesn't crash)
(er-vm-test "send to unknown pid is false"
(er-vm-dispatch 135 (list 99999 "x")) false)
;; Isolation: msgs to p1 don't appear in p2's mailbox
(er-vm-test "isolation — p2 mailbox empty"
(len (er-vm-proc-mailbox er-vm-p2)) 0)
;; reset clears
(er-vm-procs-reset!)
(er-vm-test "reset clears procs"
(er-vm-proc-count) 0)
(er-vm-test "reset resets pid counter"
(er-vm-dispatch 134 (list er-vm-fn (list))) 0)
;; ── Phase 9f — hot-BIF dispatch table ───────────────────────────
;; Each opcode skips the registry lookup and calls the underlying
;; er-bif-* directly. Verify each returns the same result as going
;; through er-apply-bif.
(er-vm-test "BIF_LENGTH opcode by id"
(get (er-vm-lookup-opcode-by-id 136) :name) "OP_BIF_LENGTH")
(er-vm-test "BIF_LENGTH on 3-cons"
(er-vm-dispatch 136
(list (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))))
3)
(er-vm-test "BIF_HD on cons"
(er-vm-dispatch 137 (list (er-mk-cons 99 (er-mk-nil)))) 99)
(er-vm-test "BIF_TL is cons"
(er-cons? (er-vm-dispatch 138
(list (er-mk-cons 1 (er-mk-cons 2 (er-mk-nil)))))) true)
(er-vm-test "BIF_ELEMENT pulls index"
(er-vm-dispatch 139 (list 2 (er-mk-tuple (list "a" "b" "c")))) "b")
(er-vm-test "BIF_TUPLE_SIZE on 4-tuple"
(er-vm-dispatch 140 (list (er-mk-tuple (list 1 2 3 4)))) 4)
(er-vm-test "BIF_LISTS_REVERSE preserves elements"
(er-list-length (er-vm-dispatch 141
(list (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))))) 3)
(er-vm-test "BIF_LISTS_REVERSE actually reverses"
(get (er-vm-dispatch 141
(list (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil)))))) :head) 3)
(er-vm-test "BIF_IS_INTEGER true on int"
(get (er-vm-dispatch 142 (list 42)) :name) "true")
(er-vm-test "BIF_IS_INTEGER false on float"
(get (er-vm-dispatch 142 (list 3.14)) :name) "false")
(er-vm-test "BIF_IS_ATOM true"
(get (er-vm-dispatch 143 (list (er-mk-atom "ok"))) :name) "true")
(er-vm-test "BIF_IS_ATOM false on int"
(get (er-vm-dispatch 143 (list 7)) :name) "false")
(er-vm-test "BIF_IS_LIST true on cons"
(get (er-vm-dispatch 144
(list (er-mk-cons 1 (er-mk-nil)))) :name) "true")
(er-vm-test "BIF_IS_LIST true on nil"
(get (er-vm-dispatch 144 (list (er-mk-nil))) :name) "true")
(er-vm-test "BIF_IS_LIST false on tuple"
(get (er-vm-dispatch 144 (list (er-mk-tuple (list)))) :name) "false")
(er-vm-test "BIF_IS_TUPLE true"
(get (er-vm-dispatch 145 (list (er-mk-tuple (list 1)))) :name) "true")
(er-vm-test "BIF_IS_TUPLE false on int"
(get (er-vm-dispatch 145 (list 5)) :name) "false")
;; Sanity: total opcode count grew (3 patterns + perform + handle +
;; receive-scan + spawn + send + 10 hot-BIFs = 16+ registered).
(er-vm-test "opcode list has 16+"
(>= (len (er-vm-list-opcodes)) 16) true)
;; ── Phase 9i — host opcode-id resolution ────────────────────────
;; Requires a binary with the erlang_ext extension registered (9h).
;; The loop runs conformance against exactly that binary.
(er-vm-test "host id: OP_PATTERN_TUPLE = 222"
(er-vm-host-opcode-id "erlang.OP_PATTERN_TUPLE") 222)
(er-vm-test "host id: OP_BIF_IS_TUPLE = 239"
(er-vm-host-opcode-id "erlang.OP_BIF_IS_TUPLE") 239)
(er-vm-test "host id: unknown name -> nil"
(er-vm-host-opcode-id "erlang.OP_NOPE") nil)
(er-vm-test "effective id prefers host when present"
(er-vm-effective-opcode-id "erlang.OP_BIF_LENGTH" 136) 230)
(er-vm-test "effective id falls back to stub on nil"
(er-vm-effective-opcode-id "erlang.OP_NOPE" 999) 999)
;; The full erlang.OP_* namespace resolves to the contiguous 222-239 block.
(er-vm-test "host ids contiguous 222..239"
(let ((names (list "erlang.OP_PATTERN_TUPLE" "erlang.OP_PATTERN_LIST"
"erlang.OP_PATTERN_BINARY" "erlang.OP_PERFORM"
"erlang.OP_HANDLE" "erlang.OP_RECEIVE_SCAN"
"erlang.OP_SPAWN" "erlang.OP_SEND"
"erlang.OP_BIF_LENGTH" "erlang.OP_BIF_HD"
"erlang.OP_BIF_TL" "erlang.OP_BIF_ELEMENT"
"erlang.OP_BIF_TUPLE_SIZE" "erlang.OP_BIF_LISTS_REVERSE"
"erlang.OP_BIF_IS_INTEGER" "erlang.OP_BIF_IS_ATOM"
"erlang.OP_BIF_IS_LIST" "erlang.OP_BIF_IS_TUPLE"))
(ok (list true)))
(for-each
(fn (i)
(when (not (= (er-vm-host-opcode-id (nth names i)) (+ 222 i)))
(set-nth! ok 0 false)))
(range 0 (len names)))
(nth ok 0))
true)
(define er-vm-test-summary (str "vm " er-vm-test-pass "/" er-vm-test-count))

View File

@@ -669,96 +669,23 @@
(define (define
er-apply-bif er-apply-bif
(fn (fn (name vs)
(name vs) (let ((entry (er-lookup-bif "erlang" name (len vs))))
(cond (if (not (= entry nil))
(= name "is_integer") (er-bif-is-integer vs) ((get entry :fn) vs)
(= name "is_atom") (er-bif-is-atom vs) (error (str "Erlang: undefined function '" name "/" (len vs) "'"))))))
(= name "is_list") (er-bif-is-list vs)
(= name "is_tuple") (er-bif-is-tuple vs)
(= name "is_number") (er-bif-is-number vs)
(= name "is_float") (er-bif-is-float vs)
(= name "is_boolean") (er-bif-is-boolean vs)
(= name "length") (er-bif-length vs)
(= name "hd") (er-bif-hd vs)
(= name "tl") (er-bif-tl vs)
(= name "element") (er-bif-element vs)
(= name "tuple_size") (er-bif-tuple-size vs)
(= name "atom_to_list") (er-bif-atom-to-list vs)
(= name "list_to_atom") (er-bif-list-to-atom vs)
(= name "is_pid") (er-bif-is-pid vs)
(= name "is_reference") (er-bif-is-reference vs)
(= name "is_binary") (er-bif-is-binary vs)
(= name "byte_size") (er-bif-byte-size vs)
(= name "abs") (er-bif-abs vs)
(= name "min") (er-bif-min vs)
(= name "max") (er-bif-max vs)
(= name "tuple_to_list") (er-bif-tuple-to-list vs)
(= name "list_to_tuple") (er-bif-list-to-tuple vs)
(= name "integer_to_list") (er-bif-integer-to-list vs)
(= name "list_to_integer") (er-bif-list-to-integer vs)
(= name "is_function") (er-bif-is-function vs)
(= name "self") (er-bif-self vs)
(= name "spawn") (er-bif-spawn vs)
(= name "exit") (er-bif-exit vs)
(= name "make_ref") (er-bif-make-ref vs)
(= name "link") (er-bif-link vs)
(= name "unlink") (er-bif-unlink vs)
(= 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
(str "Erlang: undefined function '" name "/" (len vs) "'")))))
(define (define
er-apply-remote-bif er-apply-remote-bif
(fn (fn (mod name vs)
(mod name vs)
(cond (cond
(dict-has? (er-modules-get) mod) (dict-has? (er-modules-get) mod)
(er-apply-user-module mod name vs) (er-apply-user-module mod name vs)
(= mod "lists") (er-apply-lists-bif name vs) :else
(= mod "io") (er-apply-io-bif name vs) (let ((entry (er-lookup-bif mod name (len vs))))
(= mod "erlang") (er-apply-bif name vs) (if (not (= entry nil))
(= mod "ets") (er-apply-ets-bif name vs) ((get entry :fn) vs)
:else (error (error (str "Erlang: undefined remote function '" mod ":" name "/" (len vs) "'")))))))
(str "Erlang: undefined module '" mod "'")))))
(define
er-apply-lists-bif
(fn
(name vs)
(cond
(= name "reverse") (er-bif-lists-reverse vs)
(= name "map") (er-bif-lists-map vs)
(= name "foldl") (er-bif-lists-foldl vs)
(= name "seq") (er-bif-lists-seq vs)
(= name "sum") (er-bif-lists-sum vs)
(= name "nth") (er-bif-lists-nth vs)
(= name "last") (er-bif-lists-last vs)
(= name "member") (er-bif-lists-member vs)
(= name "append") (er-bif-lists-append vs)
(= name "filter") (er-bif-lists-filter vs)
(= name "any") (er-bif-lists-any vs)
(= name "all") (er-bif-lists-all vs)
(= name "duplicate") (er-bif-lists-duplicate vs)
:else (error
(str "Erlang: undefined 'lists:" name "/" (len vs) "'")))))
(define
er-apply-io-bif
(fn
(name vs)
(cond
(= name "format") (er-bif-io-format vs)
:else (error
(str "Erlang: undefined 'io:" name "/" (len vs) "'")))))
(define (define
er-bif-arg1 er-bif-arg1
@@ -1911,3 +1838,180 @@
(fn (_) (set! out (er-mk-cons v out))) (fn (_) (set! out (er-mk-cons v out)))
(range 0 n)) (range 0 n))
out)))) out))))
;; ── code module (Phase 7 hot-reload) ─────────────────────────────
(define er-source-walk-bytes!
(fn (n bytes-box)
(cond
(er-nil? n) true
(er-cons? n)
(let ((h (get n :head)))
(cond
(= (type-of h) "number")
(do (append! (nth bytes-box 0) h)
(er-source-walk-bytes! (get n :tail) bytes-box))
:else (do (set-nth! bytes-box 0 nil) false)))
:else (do (set-nth! bytes-box 0 nil) false))))
(define er-source-to-string
(fn (v)
(cond
(= (type-of v) "string") v
(er-binary? v) (list->string (map integer->char (get v :bytes)))
(or (er-nil? v) (er-cons? v))
(let ((box (list (list))))
(er-source-walk-bytes! v box)
(cond
(= (nth box 0) nil) nil
:else (list->string (map integer->char (nth box 0)))))
:else nil)))
(define er-bif-code-load-binary
(fn (vs)
(let ((mod-arg (nth vs 0)) (src-arg (nth vs 2)))
(cond
(not (er-atom? mod-arg))
(er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
:else
(let ((src-str (er-source-to-string src-arg)))
(cond
(= src-str nil)
(er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
:else
(let ((result-box (list nil)) (failed-box (list false)))
(guard
(c (:else (set-nth! failed-box 0 true)))
(set-nth! result-box 0 (erlang-load-module src-str)))
(cond
(nth failed-box 0)
(er-mk-tuple
(list (er-mk-atom "error") (er-mk-atom "badfile")))
(not (= (get (nth result-box 0) :name) (get mod-arg :name)))
(er-mk-tuple
(list (er-mk-atom "error") (er-mk-atom "module_name_mismatch")))
:else
(er-mk-tuple (list (er-mk-atom "module") mod-arg))))))))))
(define er-env-derived-from?
(fn (env target-env)
;; Object-identity check, NOT value `=`. On evaluators where dict `=`
;; is structural/deep, comparing closure envs (which are large and
;; cyclic — a module fun's env references the fun) does not terminate.
;; `identical?` is pointer identity on every host and is the actual
;; intended semantics: "is this the same env object".
(cond
(identical? env target-env) true
:else
(let ((ks (keys env)) (found-ref (list false)))
(for-each
(fn (i)
(when (not (nth found-ref 0))
(let ((v (get env (nth ks i))))
(when (and (er-fun? v) (identical? (get v :env) target-env))
(set-nth! found-ref 0 true)))))
(range 0 (len ks)))
(nth found-ref 0)))))
(define er-procs-on-env
(fn (target-env)
(let ((all-keys (keys (er-sched-processes)))
(matches (list)))
(for-each
(fn (i)
(let ((proc (get (er-sched-processes) (nth all-keys i))))
(let ((init-fun (get proc :initial-fun)))
(when (and (not (= init-fun nil))
(er-fun? init-fun)
(er-env-derived-from? (get init-fun :env) target-env)
(not (= (get proc :state) "dead")))
(append! matches (get proc :pid))))))
(range 0 (len all-keys)))
matches)))
(define er-bif-code-purge
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
(cond
(not (dict-has? registry mod-name)) (er-mk-atom "false")
:else
(let ((slot (get registry mod-name)))
(cond
(= (er-module-old-env slot) nil) (er-mk-atom "false")
:else
(let ((procs (er-procs-on-env (er-module-old-env slot))))
(for-each
(fn (i) (er-cascade-exit! (nth procs i) (er-mk-atom "killed")))
(range 0 (len procs)))
(dict-set! registry mod-name
(er-mk-module-slot (er-module-current-env slot) nil
(er-module-version slot)))
(er-mk-atom "true"))))))))))
(define er-bif-code-soft-purge
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
(cond
(not (dict-has? registry mod-name)) (er-mk-atom "true")
:else
(let ((slot (get registry mod-name)))
(cond
(= (er-module-old-env slot) nil) (er-mk-atom "true")
:else
(let ((procs (er-procs-on-env (er-module-old-env slot))))
(cond
(> (len procs) 0) (er-mk-atom "false")
:else
(do
(dict-set! registry mod-name
(er-mk-module-slot (er-module-current-env slot) nil
(er-module-version slot)))
(er-mk-atom "true"))))))))))))
(define er-bif-code-which
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
(dict-has? (er-modules-get) (get mod-arg :name))
(er-mk-atom "loaded")
:else (er-mk-atom "non_existing")))))
(define er-bif-code-is-loaded
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
(dict-has? (er-modules-get) (get mod-arg :name))
(er-mk-tuple (list (er-mk-atom "file") (er-mk-atom "loaded")))
:else (er-mk-atom "false")))))
(define er-bif-code-all-loaded
(fn (vs)
(let ((registry (er-modules-get))
(ks (keys (er-modules-get)))
(out (er-mk-nil)))
(for-each
(fn (i)
(let ((k (nth ks (- (- (len ks) 1) i))))
(set! out
(er-mk-cons
(er-mk-tuple
(list (er-mk-atom k) (er-mk-atom "loaded")))
out))))
(range 0 (len ks)))
out)))

313
lib/erlang/vm/dispatcher.sx Normal file
View File

@@ -0,0 +1,313 @@
;; Erlang VM — stub opcode dispatcher (Phase 9).
;;
;; Mimics the OCaml-side EXTENSION shape from
;; plans/sx-vm-opcode-extension.md so opcodes 9b-9g can be designed
;; and tested in SX before 9a (`hosts/ocaml/`) lands the real
;; registration plumbing. When 9a is available, these stubs become
;; the cross-host SX-side mirror of the C/OCaml handlers and the
;; bytecode compiler emits them directly.
;;
;; Opcode IDs follow the plan's tier partition:
;; 0-127 reserved for SX core
;; 128-199 guest extensions (e.g. erlang, lua)
;; 200-247 port-/platform-specific
;;
;; Erlang owns 128-159 for now.
(define er-vm-opcodes (list {}))
(define er-vm-opcodes-get (fn () (nth er-vm-opcodes 0)))
(define
er-vm-opcodes-reset!
(fn () (set-nth! er-vm-opcodes 0 {})))
(define
er-vm-register-opcode!
(fn
(id name handler)
(dict-set! (er-vm-opcodes-get) (str id) {:name name :id id :handler handler})
(er-mk-atom "ok")))
(define
er-vm-lookup-opcode-by-id
(fn
(id)
(let
((reg (er-vm-opcodes-get)) (k (str id)))
(if (dict-has? reg k) (get reg k) nil))))
(define
er-vm-lookup-opcode-by-name
(fn
(name)
(let
((reg (er-vm-opcodes-get))
(ks (keys (er-vm-opcodes-get)))
(found (list nil)))
(for-each
(fn
(i)
(let
((entry (get reg (nth ks i))))
(when
(= (get entry :name) name)
(set-nth! found 0 entry))))
(range 0 (len ks)))
(nth found 0))))
(define er-vm-list-opcodes (fn () (keys (er-vm-opcodes-get))))
;; ── Phase 9i — host opcode-id resolution ────────────────────────
;; When the OCaml `erlang_ext` extension is registered (Phase 9h), the
;; runtime exposes `extension-opcode-id` which maps an "erlang.OP_*"
;; name to the host-assigned id (222-239). We consult it so the SX
;; side and the OCaml side agree on ids; when it returns nil (name not
;; registered) we fall back to the stub-local id.
;;
;; NOTE: this requires a binary with the VM extension mechanism (the
;; vm-ext phase-A..E cherry-pick + Sx_vm_extensions force-link). The
;; loop builds and runs against exactly that binary
;; (hosts/ocaml/_build/default/bin/sx_server.exe). `extension-opcode-id`
;; resolves lazily at call time, so merely loading this file is safe;
;; only invoking the resolver on a binary that lacks the primitive
;; would raise.
(define er-vm-host-opcode-id
(fn (ext-name)
(extension-opcode-id ext-name)))
(define er-vm-effective-opcode-id
(fn (ext-name stub-id)
(let ((host (extension-opcode-id ext-name)))
(cond
(= host nil) stub-id
:else host))))
(define
er-vm-dispatch
(fn
(id operands)
(let
((entry (er-vm-lookup-opcode-by-id id)))
(if
(= entry nil)
(error (str "Erlang VM: unknown opcode id " id))
((get entry :handler) operands)))))
(define
er-vm-dispatch-by-name
(fn
(name operands)
(let
((entry (er-vm-lookup-opcode-by-name name)))
(if
(= entry nil)
(error (str "Erlang VM: unknown opcode name '" name "'"))
((get entry :handler) operands)))))
;; ── Phase 9c — effect opcodes (perform / handle) ────────────────
;; Stub algebraic-effects-style operators. OP_PERFORM raises a tagged
;; exception; OP_HANDLE wraps a thunk in `guard` and catches matching
;; effects, passing the args to the handler. The real specialization
;; (constant-time effect dispatch, single-shot vs multi-shot continuations)
;; lands when 9a integrates.
(define er-vm-effect-marker?
(fn (c effect-name)
(and (= (type-of c) "dict")
(= (get c :tag) "vm-effect")
(= (get c :effect) effect-name))))
(define er-vm-op-perform
(fn (operands)
(raise {:tag "vm-effect" :effect (nth operands 0) :args (nth operands 1)})))
(define er-vm-op-handle
(fn (operands)
(let ((thunk (nth operands 0))
(effect-name (nth operands 1))
(handler (nth operands 2))
(result (list nil))
(caught (list false))
(rethrow (list nil)))
(guard
(c
(:else
(cond
(er-vm-effect-marker? c effect-name)
(do (set-nth! caught 0 true)
(set-nth! result 0 (handler (get c :args))))
:else (set-nth! rethrow 0 c))))
(set-nth! result 0 (thunk)))
(cond
(not (= (nth rethrow 0) nil)) (raise (nth rethrow 0))
:else (nth result 0)))))
;; ── Phase 9d — receive scan opcode ────────────────────────────
;; Selective receive primitive. Scans a mailbox value-list in arrival
;; order; for each value, tries each clause's pattern (binding into
;; env on success); on match returns `{:matched true :index N :body B}`
;; — the caller decides what to do with the index (queue-delete) and
;; the body (eval in the now-mutated env). On miss returns
;; `{:matched false}`, the caller arranges suspension (via OP_PERFORM).
;;
;; Operands: (clauses mbox-list env)
;; clauses — list of {:pattern :guards :body} dicts
;; mbox-list — SX list of message values
;; env — env dict (mutated on match)
(define er-vm-receive-try-clauses
(fn (clauses msg env i)
(cond
(>= i (len clauses)) {:matched false}
:else
(let ((c (nth clauses i)) (snap (er-env-copy env)))
(cond
(and
(er-match! (get c :pattern) msg env)
(er-eval-guards (get c :guards) env))
{:matched true :body (get c :body)}
:else
(do (er-env-restore! env snap)
(er-vm-receive-try-clauses clauses msg env (+ i 1))))))))
(define er-vm-receive-scan-loop
(fn (clauses mbox env i)
(cond
(>= i (len mbox)) {:matched false}
:else
(let ((msg (nth mbox i))
(cr (er-vm-receive-try-clauses clauses msg env 0)))
(cond
(get cr :matched) {:matched true :index i :body (get cr :body)}
:else (er-vm-receive-scan-loop clauses mbox env (+ i 1)))))))
(define er-vm-op-receive-scan
(fn (operands)
(er-vm-receive-scan-loop (nth operands 0) (nth operands 1) (nth operands 2) 0)))
;; ── Phase 9e — spawn / send + lightweight scheduler ─────────────
;; Stub register-machine process layout for the eventual fast scheduler.
;; A VM-process is `{:id :registers :mailbox :state :initial-fn :initial-args}`.
;; Registers is a vector (SX list, mutated via set-nth!) — fixed slot count
;; per process so cells don't grow during execution. Mailbox is an SX list.
;; State is one of "runnable" / "waiting" / "dead". This sits PARALLEL to
;; the existing `er-scheduler` (which is the language-level scheduler) —
;; the VM scheduler will eventually take over once 9a integrates and
;; bytecode-compiled Erlang runs against it.
(define er-vm-procs (list {}))
(define er-vm-procs-get (fn () (nth er-vm-procs 0)))
(define er-vm-procs-reset!
(fn () (do (set-nth! er-vm-procs 0 {}) (set-nth! er-vm-next-pid 0 0))))
(define er-vm-next-pid (list 0))
(define er-vm-proc-new!
(fn (initial-fn initial-args)
(let ((pid (nth er-vm-next-pid 0)))
(set-nth! er-vm-next-pid 0 (+ pid 1))
(let ((proc
{:id pid
:registers (list nil nil nil nil nil nil nil nil)
:mailbox (list)
:state "runnable"
:initial-fn initial-fn
:initial-args initial-args}))
(dict-set! (er-vm-procs-get) (str pid) proc)
pid))))
(define er-vm-proc-get (fn (pid) (get (er-vm-procs-get) (str pid))))
(define er-vm-proc-send!
(fn (pid msg)
(let ((proc (er-vm-proc-get pid)))
(cond
(= proc nil) false
:else
(do
(dict-set! proc :mailbox (append (get proc :mailbox) (list msg)))
(when (= (get proc :state) "waiting")
(dict-set! proc :state "runnable"))
true)))))
(define er-vm-proc-mailbox (fn (pid) (get (er-vm-proc-get pid) :mailbox)))
(define er-vm-proc-state (fn (pid) (get (er-vm-proc-get pid) :state)))
(define er-vm-proc-count (fn () (len (keys (er-vm-procs-get)))))
(define er-vm-op-spawn
(fn (operands)
(er-vm-proc-new! (nth operands 0) (nth operands 1))))
(define er-vm-op-send
(fn (operands)
(er-vm-proc-send! (nth operands 0) (nth operands 1))))
;; ── Phase 9f — hot-BIF dispatch table ──────────────────────────
;; Specialized opcodes for the BIFs that the bytecode compiler emits
;; on hot call sites. The handler is the underlying `er-bif-*` impl
;; directly — same `(vs)` signature as the dispatcher uses for
;; operands, so the cost is the opcode-id → handler hop with no
;; registry-key string lookup. Cold BIFs continue going through the
;; general path (`er-apply-bif` / `er-lookup-bif`).
;;
;; Opcodes 136-159 reserved for hot BIFs.
;; ── Phase 9b — pattern-match opcodes ────────────────────────────
;; Each handler takes a list (pattern-ast value env) and returns
;; true/false, mutating env on success (same contract as the
;; existing er-match-tuple / er-match-cons / er-match-binary).
;; Wire these as wrappers for now; the real opcodes will eventually
;; have register-machine semantics and skip the AST-walk overhead.
(define
er-vm-register-erlang-opcodes!
(fn
()
(er-vm-register-opcode!
128
"OP_PATTERN_TUPLE"
(fn
(operands)
(er-match-tuple
(nth operands 0)
(nth operands 1)
(nth operands 2))))
(er-vm-register-opcode!
129
"OP_PATTERN_LIST"
(fn
(operands)
(er-match-cons
(nth operands 0)
(nth operands 1)
(nth operands 2))))
(er-vm-register-opcode!
130
"OP_PATTERN_BINARY"
(fn
(operands)
(er-match-binary
(nth operands 0)
(nth operands 1)
(nth operands 2))))
(er-vm-register-opcode! 131 "OP_PERFORM" er-vm-op-perform)
(er-vm-register-opcode! 132 "OP_HANDLE" er-vm-op-handle)
(er-vm-register-opcode! 133 "OP_RECEIVE_SCAN" er-vm-op-receive-scan)
(er-vm-register-opcode! 134 "OP_SPAWN" er-vm-op-spawn)
(er-vm-register-opcode! 135 "OP_SEND" er-vm-op-send)
;; Phase 9f — hot BIFs
(er-vm-register-opcode! 136 "OP_BIF_LENGTH" er-bif-length)
(er-vm-register-opcode! 137 "OP_BIF_HD" er-bif-hd)
(er-vm-register-opcode! 138 "OP_BIF_TL" er-bif-tl)
(er-vm-register-opcode! 139 "OP_BIF_ELEMENT" er-bif-element)
(er-vm-register-opcode! 140 "OP_BIF_TUPLE_SIZE" er-bif-tuple-size)
(er-vm-register-opcode! 141 "OP_BIF_LISTS_REVERSE" er-bif-lists-reverse)
(er-vm-register-opcode! 142 "OP_BIF_IS_INTEGER" er-bif-is-integer)
(er-vm-register-opcode! 143 "OP_BIF_IS_ATOM" er-bif-is-atom)
(er-vm-register-opcode! 144 "OP_BIF_IS_LIST" er-bif-is-list)
(er-vm-register-opcode! 145 "OP_BIF_IS_TUPLE" er-bif-is-tuple)
(er-mk-atom "ok")))
(er-vm-register-erlang-opcodes!)

View File

@@ -11,7 +11,7 @@ isolation: worktree
## Prompt ## Prompt
You are the sole background agent working `/root/rose-ash/plans/erlang-on-sx.md`. Isolated worktree, forever, one commit per feature. Never push. You are the sole background agent working `/root/rose-ash/plans/erlang-on-sx.md`. Isolated worktree, forever, one commit per feature. Push to `origin/loops/erlang` after every commit.
## Restart baseline — check before iterating ## Restart baseline — check before iterating
@@ -42,7 +42,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log
- **Shared-file issues** → plan's Blockers with minimal repro. - **Shared-file issues** → plan's Blockers with minimal repro.
- **Delimited continuations** are in `lib/callcc.sx` + `spec/evaluator.sx` Step 5. `sx_summarise` spec/evaluator.sx first — 2300+ lines. - **Delimited continuations** are in `lib/callcc.sx` + `spec/evaluator.sx` Step 5. `sx_summarise` spec/evaluator.sx first — 2300+ lines.
- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits. - **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
- **Worktree:** commit locally. Never push. Never touch `main`. - **Worktree:** commit, then push to `origin/loops/erlang`. Never touch `main`.
- **Commit granularity:** one feature per commit. - **Commit granularity:** one feature per commit.
- **Plan file:** update Progress log + tick boxes every commit. - **Plan file:** update Progress log + tick boxes every commit.

View File

@@ -10,7 +10,9 @@ End-state goal: spawn a million processes, run the classic **ring benchmark**, p
- **Conformance:** not BEAM-compat. "Looks like Erlang, runs like Erlang, not byte-compatible." We care about semantics, not BEAM bug-for-bug. - **Conformance:** not BEAM-compat. "Looks like Erlang, runs like Erlang, not byte-compatible." We care about semantics, not BEAM bug-for-bug.
- **Test corpus:** custom — ring, ping-pong, fibonacci-server, bank-account-server, echo-server, plus ~100 hand-written tests for patterns/guards/BIFs. No ISO Common Test. - **Test corpus:** custom — ring, ping-pong, fibonacci-server, bank-account-server, echo-server, plus ~100 hand-written tests for patterns/guards/BIFs. No ISO Common Test.
- **Binaries:** basic bytes-lists only; full binary pattern matching deferred. - **Binaries:** basic bytes-lists only; full binary pattern matching deferred.
- **Hot code reload, distribution, NIFs:** out of scope entirely. - **Distribution, NIFs:** out of scope entirely.
- **Hot code reload (Phase 7):** in scope — driven by [fed-sx](../plans/fed-sx-design.md) (section 17.5) which needs federated modules to be re-loaded without restarting the scheduler.
- **FFI BIFs (Phase 8):** in scope — Erlang code needs `crypto:hash`, `cid:from_bytes`, `file:read_file`, `httpc:request`, `sqlite:exec` to participate in fed-sx. A general FFI BIF registry replaces today's hard-coded BIF dispatch.
## Ground rules ## Ground rules
@@ -95,10 +97,128 @@ Core mapping:
- [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 - [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
- [x] More BIFs — target 200+ test corpus green — **40 new eval tests**; 530/530 total. New: `abs/1`, `min/2`, `max/2`, `tuple_to_list/1`, `list_to_tuple/1`, `integer_to_list/1`, `list_to_integer/1`, `is_function/1-2`, `lists:seq/2-3`, `lists:sum/1`, `lists:nth/2`, `lists:last/1`, `lists:member/2`, `lists:append/2`, `lists:filter/2`, `lists:any/2`, `lists:all/2`, `lists:duplicate/2` - [x] More BIFs — target 200+ test corpus green — **40 new eval tests**; 530/530 total. New: `abs/1`, `min/2`, `max/2`, `tuple_to_list/1`, `list_to_tuple/1`, `integer_to_list/1`, `list_to_integer/1`, `is_function/1-2`, `lists:seq/2-3`, `lists:sum/1`, `lists:nth/2`, `lists:last/1`, `lists:member/2`, `lists:append/2`, `lists:filter/2`, `lists:any/2`, `lists:all/2`, `lists:duplicate/2`
### Phase 7 — hot code reload
Driven by **fed-sx** (see `plans/fed-sx-design.md` §17.5): federated modules must be replaceable at runtime without bouncing the scheduler. Classic OTP behaviour: two versions per module ("current" and "old"), local calls stick to the version the process started with, cross-module (`M:F(...)`) calls always resolve to the current version, and `purge` kills any process still running old code.
- [x] Module version slot: `er-modules` entry becomes `{:current MOD-ENV :old MOD-ENV-or-nil :version INT}`; bump version on each load — **13 new runtime tests** (543/543 total)
- [x] `code:load_binary/3` (the canonical reload BIF) — re-parses module source, swaps `:current``:old`, installs new env as `:current`; returns `{module, Name}` or `{error, Reason}` (badarg / badfile / module_name_mismatch). **+8 eval tests** (551/551 total). `code:load_file/1` is a thin filesystem wrapper around this and lands once `file:read_file/1` is in (Phase 8).
- [x] `code:purge/1` + `code:soft_purge/1` — purge clears `:old` slot and kills any process whose `:initial-fun` env identity matches the old env (returns `true` if there was old code, `false` if there wasn't). soft_purge: refuses (returns `false`, leaves `:old` intact) if any process is still pinned to the old env; otherwise clears and returns `true`. **+10 eval tests** (561/561 total). Caveat: a true "lingering on old code" test needs `spawn/3` (still stubbed) or `fun M:F/A` syntax (not parsed) — anonymous `fun () -> M:F() end` closures capture the caller's env, not the module's, and cross-module calls always resolve to `:current`. Current tests therefore exercise the return-value matrix but not the kill path.
- [x] `code:which/1`, `code:is_loaded/1`, `code:all_loaded/0` — introspection. **+10 eval tests** (571/571 total). Return-value contract: `which``loaded` / `non_existing` (since we have no filesystem path); `is_loaded``{file, loaded}` / `false`; `all_loaded` → list of `{Module, loaded}` tuples. Non-atom Mod raises `error:badarg`.
- [x] Cross-module call `M:F(...)` dispatches to `:current`; local calls inside a module body keep using the env they closed over so a running process finishes its current function with the version it started with — **+6 eval tests** verifying the property end-to-end (577/577 total). No implementation change: `er-apply-user-module` already routes through `er-module-current-env`, and `er-mk-fun` captures its env by reference so closures created under v1 retain v1's `mod-env` even after the slot bumps to v2.
- [x] Tests: load v1 → spawn → load v2 → cross-module call hits v2 → local call inside v1 process keeps v1 semantics until function returns → purge kills v1 procs → soft_purge refuses while v1 procs alive — **+5 capstone eval tests** (582/582 total). Required extending `er-procs-on-env` from raw identity match to `er-env-derived-from?` (an env "comes from" mod-env if it IS mod-env or contains a value that's a fun closed over mod-env), because `er-apply-fun-clauses` does `er-env-copy closure-env` before binding params — so the spawned-from-inside-module fun's `:env` is a fresh dict, not mod-env. Test ladder runs as one single `erlang-eval-ast` program (every call to `ev` resets the scheduler via `er-sched-init!`, so Pid handles must live within one program).
### Phase 8 — FFI BIF mechanism + standard libs
Replace today's hardcoded BIF dispatch (`er-apply-bif`/`er-apply-remote-bif` in `transpile.sx`) with a runtime-extensible **BIF registry**. Each registry entry is `{:module :name :arity :fn :pure?}`. Standard libs are then registered at boot, and fed-sx can register new BIFs from `.sx` files. Includes the marshalling layer (Erlang term ↔ SX value) so wrappers stay one-liners.
- [x] BIF registry: `er-bif-registry` global dict keyed by `"Module/Name/Arity"`, with `er-register-bif!`/`er-register-pure-bif!`/`er-lookup-bif`/`er-list-bifs`/`er-bif-registry-reset!` helpers — **+18 runtime tests** (600/600 total). Entries are `{:module :name :arity :fn :pure?}`. Arity is part of the key so `m:f/1` and `m:f/2` are independent. Re-registering the same key replaces the previous entry; reset clears.
- [x] Migrate existing local + remote BIFs (length/hd/tl/lists:*/io:format/ets:*/etc.) onto the registry; delete the giant `cond` dispatch in `er-apply-bif`/`er-apply-remote-bif`. Conformance held at **600/600** after migration (baseline was 600, not the plan-text's 530 — the text was authored before Phase 7 work added rows). 67 builtin registrations across `erlang`/`lists`/`io`/`ets`/`code` modules; multi-arity BIFs (`is_function`, `spawn`, `exit`, `io:format`, `lists:seq`, `ets:delete`) register once per arity, all pointing at the same impl which dispatches on `(len vs)` internally. The four per-module cond dispatchers (`er-apply-lists-bif`, `er-apply-io-bif`, `er-apply-ets-bif`, `er-apply-code-bif`) are deleted. `er-apply-bif` and `er-apply-remote-bif` are now ~5-line registry lookups; user modules still win precedence over the registry.
- [x] Term-marshalling helpers: `er-of-sx` (SX → Erlang) and `er-to-sx` (Erlang → SX). atom ↔ symbol, nil ↔ `()`, cons → list, tuple → list (one-way; tuples flatten), binary ↔ SX string, integer / float / boolean passthrough. **+23 runtime tests** (623/623 total). Erlang maps (`dict ↔ map`) deferred — Erlang map term not implemented in this port; will land when `#{}` syntax does. Pids, refs, funs pass through unchanged. SX strings on the way back become Erlang binaries (most useful FFI return shape).
- [x] `crypto:hash/2`**WIRED 2026-05-18** against `crypto-sha256`/`crypto-sha512`/`crypto-sha3-256` (loops/fed-prims). `crypto:hash(Type, Data)`: `Type``sha256|sha512|sha3_256` atom; `Data` an Erlang binary/string/charlist (→ SX byte-string via `er-source-to-string`). Returns the **raw digest as an Erlang binary** (host hex → bytes via `er-hex->bytes`). Bad type / non-binary → `error:badarg`. 6 ffi tests (digest sizes 32/64, sha3 is_binary, deterministic, distinct, badarg).
- [x] `cid:from_bytes/1`, `cid:to_string/1`**WIRED 2026-05-18**. `cid:from_bytes(Bin)` → CIDv1 raw-codec (0x55), sha2-256 multihash built in SX (`[0x12,0x20]++digest`) fed to `cid-from-bytes`; returned as an Erlang binary string. `cid:to_string(Term)` → canonical CIDv1 of the term's stable `er-format-value` string via `cid-from-sx` (cbor-encode rejects marshalled symbols, so `er-to-sx` is unencodable for compound terms — string form is total + deterministic). 7 ffi tests (is_binary, deterministic, distinct-inputs, non-binary badarg, to_string is_binary/deterministic/distinct).
- [x] `file:read_file/1`, `file:write_file/2`, `file:delete/1`**+10 eval tests** (633/633 total). Returns `{ok, Binary}` / `ok` / `{error, Reason}` where Reason is `enoent`/`eacces`/`enotdir`/`eisdir`/`posix_error` (classified from the SX `file-read`/`-write`/`-delete` exception string). Path accepts SX string, Erlang binary, or Erlang char-code list. **`file:list_dir/1` WIRED 2026-05-18** against `file-list-dir``{ok, [Binary]}` (entries marshalled via `er-of-sx`) / `{error, Reason}` (same `er-classify-file-error` mapping; missing dir → `enoent`). 4 ffi tests (ok-tag, non-empty, entries-are-binaries, missing-enoent).
- [ ] `httpc:request/4`**BLOCKED** (no HTTP client primitive). See Blockers.
- [ ] `sqlite:open/1`, `sqlite:close/1`, `sqlite:exec/2`, `sqlite:query/2`**BLOCKED** (no SQLite primitive). See Blockers.
- [x] Tests: 1 round-trip per BIF; suite name `ffi`; conformance scoreboard auto-picks it up — **+14 ffi tests** at 637/637 total. Suite covers the 3 implemented file BIFs (9 tests: write-ok, read-ok-tag, payload-is-binary, byte_size content, missing-enoent, bad-path-enoent, binary-payload round-trip, delete-ok, read-after-delete-enoent) plus 5 negative asserts (one per blocked BIF — `crypto:hash`/`cid:from_bytes`/`file:list_dir`/`httpc:request`/`sqlite:exec`) so this suite fails fast if a future iteration adds a wrapper without registering proper tests. Target "+40 ffi tests" was relative to the original 5-BIF-family plan; with 5 of those families blocked on host primitives, the achievable count is 14 — the suite scaffolding is what matters and is ready to accept the remaining tests when the primitives land.
### Phase 9 — specialized opcodes (the BEAM analog)
**Driver:** Erlang-on-SX going through the general-purpose CEK machine has architectural perf ceilings (call/cc per receive, env-copy per call, mailbox rebuild on delete). The fix is specialized bytecode opcodes that bypass the general machinery for hot Erlang operations. Targets: 100k+ message hops/sec, 1M-process spawn in under 30sec. Layered perf strategy: Layer 1 (this) = specialized opcodes; Layer 2 (Phase 10, deferred) = multi-core scheduler.
**Architectural note:** opcodes get developed in `lib/erlang/vm/` (in scope). The **opcode extension mechanism in `hosts/ocaml/`** (Phase 9a) is **out of scope** for this loop — log as Blocker until a session that owns `hosts/` lands it. Sub-phases 9b-9g design and test opcodes against a stub dispatcher in the meantime; integrate when 9a is available.
**Shared-opcode discipline:** opcodes that another language port could plausibly use (pattern match, perform/handle, record access) get prepared for **chiselling out to `lib/guest/vm/`** when a second use materialises. Same lib/guest pattern, applied at the bytecode layer. Don't pre-extract; do annotate candidates in commit messages.
- [x] **9a — Opcode extension mechanism****INTEGRATED** (scope widened by user 2026-05-15: hosts/ in scope, merging back). Cherry-picked the 5 vm-ext commits (phases A-E: dispatch fallthrough for opcodes ≥200, `Sx_vm_extension` interface, `Sx_vm_extensions` registry, `extension-opcode-id` SX primitive, JIT skip path) onto loops/erlang. Force-linked `Sx_vm_extensions` into `bin/sx_server.ml` so its module-init runs (was dead-code-eliminated — only `run_tests` referenced it). `extension-opcode-id` is now live in the runtime: returns the registered opcode id, or nil for unknown names. Built clean; conformance held at **709/709** on the freshly built binary. Design: `plans/sx-vm-opcode-extension.md`.
- [x] **9b — `OP_PATTERN_TUPLE` / `OP_PATTERN_LIST` / `OP_PATTERN_BINARY`****+19 vm tests** (656/656 total). Stub dispatcher in `lib/erlang/vm/dispatcher.sx` mirrors the OCaml extension shape from `plans/sx-vm-opcode-extension.md`: `er-vm-register-opcode!`/`er-vm-lookup-opcode-by-id`/`er-vm-lookup-opcode-by-name`/`er-vm-dispatch`. Opcode IDs 128 (TUPLE), 129 (LIST), 130 (BINARY) per the guest-tier partition (128-199). Handlers are thin wrappers over the existing `er-match-tuple`/`er-match-cons`/`er-match-binary` for now; the real specialization (skip AST walk, register-machine operands) lands when 9a integrates. Conformance must remain unchanged — **656/656** preserved. Candidate for chiselling to `lib/guest/vm/match.sx` once a second port (Prolog? miniKanren?) wants the same opcodes.
- [x] **9c — `OP_PERFORM` / `OP_HANDLE`****+9 vm tests** (665/665 total). Stubs in `lib/erlang/vm/dispatcher.sx`: `OP_PERFORM` (id 131) raises `{:tag "vm-effect" :effect <name> :args <args>}`; `OP_HANDLE` (id 132) wraps a thunk in `guard`, catches matching effects (by `:effect` name), passes args to the handler, returns the handler's result. Non-matching effects rethrow to outer handlers (verified by a nested-handle test). Pure Erlang `receive` interface unchanged; this is the substrate for the eventual call/cc-free implementation when 9a integrates. Candidate for chiselling (Scheme call/cc, OCaml 5 effects, miniKanren all want the same shape).
- [x] **9d — `OP_RECEIVE_SCAN`****+10 vm tests** (675/675 total). Stub at id 133 in `lib/erlang/vm/dispatcher.sx`. Operand contract: `(clauses mbox-list env)` where each clause is `{:pattern :guards :body}`, mbox-list is a plain SX list (not a queue — caller does queue→list before invoking and queue-delete after). Walks mbox in arrival order; tries each clause per message; first match returns `{:matched true :index N :body B}` (env mutated with bindings, body NOT evaluated — caller chooses when); no match returns `{:matched false}`. Pure pattern scan; suspension is the caller's job (compose with OP_PERFORM "receive-suspend" once 9a integrates). The real opcode will skip the AST walk by JIT-compiling each clause's match expr; this stub re-uses `er-match!` for correctness.
- [x] **9e — `OP_SPAWN` / `OP_SEND` + lightweight scheduler****+16 vm tests** (691/691 total). Stubs at ids 134 (SPAWN) and 135 (SEND) in `lib/erlang/vm/dispatcher.sx`, plus the VM-process registry: `er-vm-procs` (dict pid → proc record), `er-vm-next-pid`, `er-vm-procs-reset!`, `er-vm-proc-new!`/`get`/`send!`/`mailbox`/`state`/`count`. Process record shape is the register-machine layout the real scheduler will use: `{:id :registers (list of 8 nil slots) :mailbox (SX list) :state ("runnable"/"waiting"/"dead") :initial-fn :initial-args}`. OP_SPAWN returns a numeric pid and allocates a fresh record; OP_SEND appends to the target's mailbox, flipping `:state` from "waiting" → "runnable" if needed (returns true on success, false on unknown pid — no crash). Sits parallel to `er-scheduler` (the language-level scheduler from Phase 3); the real VM scheduler will take over once 9a integrates and Erlang programs compile to bytecode. Perf targets in the bullet (spawn <50µs, send <5µs) defer to the integration step.
- [x] **9f — BIF dispatch table****+18 vm tests** (709/709 total). 10 hot BIFs get their own opcode IDs (136-145) in `lib/erlang/vm/dispatcher.sx`: `OP_BIF_LENGTH`, `OP_BIF_HD`, `OP_BIF_TL`, `OP_BIF_ELEMENT`, `OP_BIF_TUPLE_SIZE`, `OP_BIF_LISTS_REVERSE`, `OP_BIF_IS_INTEGER`, `OP_BIF_IS_ATOM`, `OP_BIF_IS_LIST`, `OP_BIF_IS_TUPLE`. Each opcode's handler IS the underlying `er-bif-*` impl directly (no registry-string-lookup), so cost is opcode-id → handler one-hop. Cold BIFs continue through `er-apply-bif` / `er-lookup-bif` as before. IDs 136-159 reserved for future hot-BIF additions.
- [x] **9h — `erlang_ext.ml`** — OCaml extension at `hosts/ocaml/lib/extensions/erlang_ext.ml` registering the 18-opcode Erlang namespace (ids **222-239**, names `erlang.OP_*` mirroring the SX stub dispatcher). Registered at sx_server startup via `Erlang_ext.register ()` (guarded against double-register Failure). `extension-opcode-id "erlang.OP_PATTERN_TUPLE"` → 222 … `OP_BIF_IS_TUPLE` → 239, unknown → nil. Handlers raise a descriptive not-wired `Eval_error` (bytecode emission is a later phase; SX stub dispatcher remains the working specialization path) — keeps the extension honest rather than silently corrupting the VM stack. id range 222+ dodges test_reg (210/211) + test_ext (220/221) so all three coexist in run_tests. **+5 OCaml ext tests** (run_tests `Suite: extensions/erlang_ext`); Erlang conformance held **709/709**.
- [x] **9i — wire SX dispatcher to real ids**`lib/erlang/vm/dispatcher.sx` gains `er-vm-host-opcode-id` (thin `extension-opcode-id` wrapper) and `er-vm-effective-opcode-id name stub-id` (host id when non-nil, else stub-id). `extension-opcode-id` resolves lazily at call time so loading the file is safe even on a binary lacking the primitive; only invoking the resolver there would raise (documented prereq — the loop builds + runs against the binary that has it). **+6 vm tests** (715/715): OP_PATTERN_TUPLE→222, OP_BIF_IS_TUPLE→239, unknown→nil, effective prefers host (OP_BIF_LENGTH→230), effective falls back to stub on nil (999), and a sweep asserting the whole 18-name namespace maps contiguously to 222..239. Stub-local ids (128-145) registration untouched so the prior 72 vm tests stay green.
- [x] **9g — Conformance + perf bench** — Ran `lib/erlang/bench_ring.sh 10 100 500 1000` on the integrated binary (9a+9h+9i built in): 11/36/35/31 hops/s — **unchanged from the pre-integration baseline**, which is the correct expected result and doubles as a no-regression proof (the full extension wiring added zero per-hop cost). Conformance **715/715** on the same binary. Numbers recorded in `lib/erlang/bench_ring_results.md` with the rationale. The ~3000×/~1000× targets are gated on Phase 10 (bytecode emission) — the compiler doesn't emit `erlang.OP_*` yet, so every hop still takes the general CEK path. 9g's deliverable (honest measurement on the integrated binary) is complete.
### Phase 10 — bytecode emission (unlock the speedup)
The Phase 9 opcodes are registered, tested, and bridged SX↔OCaml, but inert: nothing emits them. Phase 10 makes the speedup real.
- [ ] **10a — compiler emits `erlang.OP_*` at hot sites****BLOCKED on `lib/compiler.sx` ownership (out of this loop's scope).** Architecture fully mapped (2026-05-15, see Blockers + design below). The correct implementation site is `lib/compiler.sx`'s `compile-call` — it must recognize calls to the Erlang runtime-helper functions that have a registered `erlang.OP_*` opcode and emit that opcode (via the already-live `extension-opcode-id` primitive) instead of a generic CALL. This is **generic shared compiler infrastructure** (any guest port — Prolog, Lua — would use the same intrinsic mechanism), explicitly excluded by the ground rules ("Don't edit lib/ root"; not in the widened hosts/-only scope). Concrete sub-steps for the owning session:
- **10a.1** Add an *intrinsic registry* to `lib/compiler.sx`: a dict `callee-name → extension-opcode-name`, populated by guests at load (e.g. Erlang registers `er-bif-length → "erlang.OP_BIF_LENGTH"`, `er-match-tuple → "erlang.OP_PATTERN_TUPLE"`, …).
- **10a.2** In `compile-call`: if the resolved callee is in the intrinsic registry AND `(extension-opcode-id name)` is non-nil, compile the args normally (push left→right) then emit the single opcode byte instead of `CALL`. Fall back to generic CALL when the opcode is absent (graceful on binaries without the extension).
- **10a.3** Define the operand/stack contract per opcode class and make `erlang_ext.ml`'s control handlers (222-229) match it (pattern opcodes need the pattern AST as a constant-pool operand + the scrutinee on the stack; perform/handle/receive/spawn/send need OCaml↔SX runtime-state access — see 10b-control note).
- **10a.4** Conformance must stay green; add bytecode-emission tests (compile an Erlang fn, disassemble, assert the opcode appears at the hot site).
Until a session owning `lib/compiler.sx` lands 10a.1-10a.2, the speedup cannot be realized from this loop. The BIF half of 10b (operand-less stack ops) is fully done and *would* light up immediately once emission exists.
- [~] **10b — real `erlang_ext.ml` handlers****10 of 18 real** (ALL BIF opcodes done: 230-239). Latest: `OP_BIF_ELEMENT` (233, pops Tuple-then-Index, 1-indexed, range-checked) and `OP_BIF_LISTS_REVERSE` (235, builds a fresh reversed cons chain in OCaml). Re-scoping correction: ELEMENT/REVERSE were earlier mislabelled "gated on 10a" — they're pure stack transforms (no bytecode operands; element/2 just pops 2), so they landed now. **21 e2e run_tests** total. Remaining 8 stubs are the genuine control/structural opcodes that DO need compiler-defined operands + runtime state: `OP_PATTERN_TUPLE/LIST/BINARY` (222-224), `OP_PERFORM/HANDLE` (225-226), `OP_RECEIVE_SCAN` (227), `OP_SPAWN/SEND` (228-229). not-wired guard repointed to 222. 715/715 unaffected. — earlier note: 8 of 18 real (all hot-BIFs done). Real register-machine handlers: `OP_BIF_LENGTH` (230, cons-walk), `OP_BIF_HD` (231), `OP_BIF_TL` (232), `OP_BIF_TUPLE_SIZE` (234, handles List + ListRef `:elements`), `OP_BIF_IS_INTEGER` (236, `Integer _`), `OP_BIF_IS_ATOM` (237), `OP_BIF_IS_LIST` (238, cons|nil), `OP_BIF_IS_TUPLE` (239) — all operate on the tagged-Dict value repr, push Erlang bool atoms via a `mk_atom` helper, raise on type errors. **15 end-to-end run_tests tests** (build real bytecode `[CONST i; op; RETURN]` with list/tuple/atom constants, assert via `Sx_vm.execute_module`). Still `not_wired`: the 8 control opcodes — `OP_PATTERN_TUPLE/LIST/BINARY` (222-224), `OP_PERFORM/HANDLE` (225-226), `OP_RECEIVE_SCAN` (227), `OP_SPAWN/SEND` (228-229) — plus `OP_BIF_ELEMENT` (233, needs 2 operands) and `OP_BIF_LISTS_REVERSE` (235). not-wired guard repointed to 233. 715/715 conformance unaffected (VM-bytecode path only; interpreter untouched). Remaining 10b: the 10 control/structural handlers.
- [ ] **10c — perf validation**: re-run `bench_ring.sh`; target 100k+ hops/sec at N=1000, 1M-process spawn < 30s; record in `bench_ring_results.md`. Conformance must stay green.
**Acceptance:** ring benchmark hits the 100k hops/sec target. All prior phase tests pass. Two opcodes chiselled to `lib/guest/vm/` (or annotated as candidates with a written rationale).
## Progress log ## Progress log
_Newest first._ _Newest first._
- **2026-05-18 Phase 8 host-primitive BIFs wired (crypto / cid / file:list_dir)** — `loops/fed-prims` (merged at architecture `380bc69f`) delivered the platform primitives; wired the 3 previously-BLOCKED Phase 8 BIF groups in `lib/erlang/runtime.sx` as `er-register-pure-bif!`/`er-register-bif!` entries with term marshalling at the boundary. **`crypto:hash/2`** → `crypto-sha256`/`crypto-sha512`/`crypto-sha3-256`; atom `Type` dispatch, `er-source-to-string` for `Data`, host hex result → raw bytes via new `er-hexval`/`er-hex->bytes`, returns Erlang binary; bad type/arg → `error:badarg`. **`cid:from_bytes/1`** → `cid-from-bytes` with raw codec `0x55` + sha2-256 multihash assembled in SX (`[0x12,0x20]++digest`); **`cid:to_string/1`** → `cid-from-sx` of `er-format-value` (cbor-encode rejects `er-to-sx`-marshalled symbols; the canonical string form is total + deterministic). **`file:list_dir/1`** → `file-list-dir`, `{ok,[Binary]}` via `er-of-sx` / `{error,Reason}` reusing `er-classify-file-error`. Test gotcha caught + fixed: this Erlang port's binary parser only supports integer/var segments — `<<"abc">>` string-binary literals silently produce **empty** binaries, so the first-cut distinct-input tests compared two empty inputs and failed; rewrote ffi inputs to integer-segment binaries (`<<97,98,99>>`). ffi suite 14→**28** (3 BLOCKED negative-asserts flipped to positive+negative functional tests; `httpc`/`sqlite` kept as deferred unregistered-asserts per fed-prims handoff). Built `sx_server.exe` (dune, opam 5.2.0) at `380bc69f`; full conformance **729/729** (eval 385/385, vm 78/78, **ffi 28/28**, all process suites green). loops/erlang only — not merged, not pushed to architecture.
- **2026-05-18 FIXED merge-blocking regression: cyclic-env hang in `er-env-derived-from?`** — A trial merge of loops/erlang → architecture regressed Erlang **715/715 → 0/0** on the architecture binary. Bisected: not loader semantics, not a uniform slowdown — pinpointed to the *single* Phase 7 capstone test (eval.sx lines 1314-1346; prefix-1313 was byte-identical speed on both binaries, 27s, prefix-1346 was 28s on loops vs >5min/hung on architecture). Isolated further: spawn+reload alone 0.6s, reload+purge alone 0.3s, but spawn+reload+**purge over forever-blocked procs** hung. Root cause: `er-env-derived-from?` (transpile.sx, used by `code:purge`/`soft_purge` via `er-procs-on-env`) compared closure envs with `(= env target-env)`. loops/erlang's evaluator implements dict `=` as **object identity**; architecture's 131-commit-newer evaluator changed it to **structural deep equality**. Erlang closure envs are large and **cyclic** (a module fun's `:env` transitively references the fun), so structural `=` over them never terminates. Fix: use `identical?` (pointer-identity predicate, present + consistent `(true false)` on *both* binaries) — the actually-intended semantics and host-independent. Verified: full eval.sx on the architecture binary >200s/hung → **59s**; full 10-suite conformance on the architecture binary now **715/715** (eval 385/385, vm 78/78, ffi 14/14, all process suites green). loops/erlang behaviour unchanged (`identical?` ≡ its old `=`-identity). One-file change (`lib/erlang/transpile.sx`, +7/-2). The merge can now be re-attempted; this was the sole blocker.
- **2026-05-15 Phase 10a — architecture traced, scoped, blocked on `lib/compiler.sx`** — Investigation-only iteration (correctly: faking compiler emission within scope is impossible and would be dishonest). Traced the full JIT path: `sx_vm.ml`'s `jit_compile_lambda` (the ref set at line 1206) invokes the SX-level `compile` from `lib/compiler.sx` via the CEK machine — that is the only SX→bytecode producer. Erlang's hot helpers are ordinary SX functions in `transpile.sx` that get JIT-compiled through exactly this path, so emitting `erlang.OP_*` means teaching `compiler.sx`'s `compile-call` to recognize them as intrinsics and emit the extension opcode (the file's own docstring already anticipates this — "Compilers call `extension-opcode-id` to emit extension opcodes" — designed but unimplemented; grep confirms zero `extension-opcode-id` uses in `compiler.sx`). `lib/compiler.sx` is lib-root: excluded by ground rules and the widened scope (editing it changes every guest's JIT — must be a shared-compiler session, not this loop). Recorded a precise Blockers entry + decomposed 10a into four numbered sub-steps (10a.1 intrinsic registry, 10a.2 `compile-call` emission with graceful CALL fallback, 10a.3 operand/stack contract for control opcodes, 10a.4 bytecode-emission tests) so the owning session can execute directly. Key payoff documented: all 10 BIF handlers (230-239) are already real, so they light up the instant 10a.1-10a.2 land — zero further Erlang-side work for the BIF speedup. No code changed; conformance unverified-but-untouched at **715/715** (no source touched). Phase 10's loop-reachable work (10b BIF half) is complete; the rest is correctly blocked and fully actionable elsewhere.
- **2026-05-15 Phase 10b — ELEMENT + LISTS_REVERSE real; all 10 BIF opcodes done** — Re-examined the earlier "gated on 10a" claim for ELEMENT/REVERSE and found it wrong: both are pure stack transforms with no need for bytecode operands (`element/2` just pops Tuple then Index off the VM stack; `lists:reverse/1` pops one list). Implemented both as real handlers in `erlang_ext.ml`. `OP_BIF_ELEMENT` (233): pops Tuple (TOS) then Index, handles List/ListRef `:elements`, 1-indexed, raises on out-of-range or wrong arg types. `OP_BIF_LISTS_REVERSE` (235): walks the cons chain building a fresh reversed one via local `mk_cons`/`mk_nil`, raises on improper list. Defined the calling convention for arity-2 ELEMENT: args pushed left→right so stack is `[Index Tuple]`, Tuple on top. 6 new e2e run_tests: element(2/1,{1,2,3}), element out-of-range raises, reverse-then-HD=9, reverse-then-TL-HD=8, reverse-then-LENGTH=3 (composes 3 real opcodes in one bytecode sequence). erlang_ext suite 15→21 PASS, dispatch_count 22. not-wired guard repointed 233→222 (OP_PATTERN_TUPLE — a genuine control opcode still stubbed). **All 10 BIF opcodes (230-239) now real**; the 8 remaining stubs are the true control/structural opcodes (pattern match, perform/handle, receive-scan, spawn/send) which genuinely need 10a's compiler-defined operand encoding + runtime-state access. Erlang conformance **715/715** (interpreter path untouched). 10b is now BIF-complete; the control-opcode half is the real remaining Phase 10 work and is correctly gated on 10a.
- **2026-05-15 Phase 10b — all 8 hot-BIF handlers real** — Built on the vertical slice: added 7 more real register-machine handlers in `erlang_ext.ml` (HD 231, TL 232, TUPLE_SIZE 234, IS_INTEGER 236, IS_ATOM 237, IS_LIST 238, IS_TUPLE 239), joining LENGTH 230. Shared helpers added: `mk_atom` (builds the Erlang bool atom `{tag→atom, name→true|false}`), `er_bool`, `is_tag` (Dict tag predicate). TUPLE_SIZE handles both `List` and `ListRef` `:elements` (Erlang tuples may be built mutably). IS_INTEGER keys off `Sx_types.Integer`. All raise descriptive `Eval_error` on type mismatch. The `op N "name"` stub helper now only covers the 10 remaining control/structural opcodes. 9 new end-to-end run_tests assertions added (HD, TL∘HD, TUPLE_SIZE, IS_INTEGER pos+neg, IS_ATOM, IS_LIST nil-true + tuple-false, IS_TUPLE) — each builds real bytecode with a list/tuple/atom constant and executes via `Sx_vm.execute_module`. erlang_ext suite 6→15 PASS; dispatch_count 12. not-wired guard repointed 231→233 (OP_BIF_ELEMENT, still stubbed — it needs two operands so it's a later sub-step). Erlang conformance **715/715** (the interpreter path is untouched; only the VM-bytecode dispatch gained real handlers). Remaining 10b: pattern tuple/list/binary, perform/handle, receive-scan, spawn/send, element, lists:reverse (10 opcodes).
- **2026-05-15 Phase 10b vertical slice — first real opcode handler, end-to-end VM proof** — Investigation first: confirmed Erlang runs as a pure tree-walking interpreter (`er-eval-expr` over CEK) — there is **no** Erlang→bytecode compiler, so full 10a (compiler emits opcodes) is a multi-week standalone effort, not one iteration. Rather than fake it, de-risked the whole Phase 9/10 architecture with a vertical slice: replaced the `not_wired` raise for `erlang.OP_BIF_LENGTH` (id 230) with a genuine register-machine handler in `erlang_ext.ml` — pops a value, walks the Erlang cons-list representation (`Dict` with `"tag"``"cons"`/`"nil"`, `"head"`, `"tail"`), pushes `Integer` length, raises on improper lists. Added an end-to-end run_tests test that builds real bytecode `[| 1; 0; 0; 230; 50 |]` (CONST idx 0 → OP_BIF_LENGTH → RETURN) with an Erlang `[1,2,3]` in `vc_constants`, executes via `Sx_vm.execute_module`, asserts `Integer 3`. This proves the complete path works: `extension-opcode-id` → bytecode → `Sx_vm` ≥200 dispatch fallthrough → `erlang_ext` handler → correct VM stack result — the load-bearing proof that Phase 9's wiring isn't just stubs. The other 17 opcodes still honestly raise `not_wired`; the prior not-wired guard test was repointed from 230 to 231 (OP_BIF_HD) so it still verifies the honest-failure path. erlang_ext suite 5→6 tests, dispatch_count now 2. Erlang conformance **715/715** unaffected (the new path is VM-bytecode-only; the interpreter path is untouched). 10b marked in-progress `[~]`; remaining: real handlers for the other 17 opcodes + 10a compiler emission. Builds clean via `dune build bin/run_tests.exe bin/sx_server.exe`.
- **2026-05-15 Phase 9g — perf bench recorded on integrated binary; Phase 10 scoped** — Built the fresh `sx_server.exe` (9a+9h+9i wired in), ran `lib/erlang/bench_ring.sh 10 100 500 1000`: 11/36/35/31 hops/s — statistically identical to the pre-9a baseline (11/24/26/29/34). This is the *expected* outcome and the iteration's actual deliverable: it proves the entire extension stack (vm-ext A-E cherry-pick + `Sx_vm_extensions` force-link + `erlang_ext.ml` + SX dispatcher bridge) added **zero per-hop overhead** — a clean no-regression result — while honestly showing the speedup hasn't arrived because the bytecode compiler still doesn't emit `erlang.OP_*` (every hop takes the general CEK path). Updated `bench_ring_results.md` with a "Phase 9g" section: the table + the rationale that unchanged numbers = correct + no-regression. Conformance **715/715** on the integrated binary. Added **Phase 10 — bytecode emission** to the roadmap (10a compiler emits opcodes at hot sites, 10b real register-machine `erlang_ext.ml` handlers replacing the not-wired raises, 10c perf validation against the 100k-hops/1M-spawn targets). Phase 9 is now fully ticked (9a-9i); the actual speedup is honestly deferred to Phase 10 rather than faked. No code change this iteration — measurement + documentation + roadmap.
- **2026-05-15 Phase 9i — SX dispatcher consults host opcode ids** — `lib/erlang/vm/dispatcher.sx` now bridges SX↔OCaml opcode ids. Two new functions: `er-vm-host-opcode-id` (wraps `extension-opcode-id`) and `er-vm-effective-opcode-id name stub-id` (host id if the OCaml `erlang_ext` registered it, else the stub-local id). Key SX-runtime fact established this iteration: symbol resolution is **lazy/call-time**`(define f (fn () (extension-opcode-id "x")))` does NOT raise at load even when the primitive is absent; only calling `f` does. Combined with the earlier findings (guard can't catch undefined-symbol; no symbol-existence reflection), this means graceful in-SX degradation is impossible — so the design instead documents the binary prerequisite and relies on the loop building+running the freshly-built `hosts/ocaml/_build/default/bin/sx_server.exe` (conformance.sh's default, which has the vm-ext mechanism + erlang_ext). Stub-local registration (128-145) deliberately left intact so the 72 pre-existing vm tests don't move. 6 new vm tests: 222/239 lookups, unknown→nil, effective-prefers-host (230), effective-fallback (999), and a contiguity sweep over all 18 `erlang.OP_*` names asserting they map to 222..239 in order. vm suite 72→78. Total **715/715** on the fresh binary. Next: 9g — re-run ring bench, record numbers (note: stubs still wrap existing impls 1-to-1 so numbers won't move until the compiler emits these opcodes — a later phase).
- **2026-05-15 Phase 9h — erlang_ext.ml registered, opcode namespace live** — New `hosts/ocaml/lib/extensions/erlang_ext.ml` modelled on `test_ext.ml`: an `EXTENSION` module `name="erlang"`, per-instance `ErlangExtState` (dispatch counter), 18 opcodes ids 222-239 named `erlang.OP_*` exactly mirroring the SX stub dispatcher. Registered at sx_server startup with a second guarded line in `bin/sx_server.ml` (`try Erlang_ext.register () with Failure _ -> ()` — survives a re-entered server). `include_subdirs unqualified` in `lib/dune` already pulls `lib/extensions/*.ml` into the `sx` lib, so no dune edit needed. Handlers deliberately raise a descriptive `Eval_error` ("bytecode emission not yet wired (Phase 9j) — Erlang runs via CEK; specialization path is the SX stub dispatcher") rather than fake stack ops — the compiler doesn't emit these yet, so an honest loud failure beats silent corruption. Hit and fixed an opcode-id collision: the original 200-217 range clashed with run_tests' inline test_reg (210/211); relocated to 222-239 (clears test_reg + test_ext 220/221, all coexist; production sx_server only registers erlang). 5 new OCaml tests in run_tests `Suite: extensions/erlang_ext`: opcode-id 222 + 239 resolve, unknown→nil, dispatch raises not-wired (substring check, no Str dep since run_tests doesn't link str), dispatch_count state ≥1. Built via `eval $(opam env --switch=5.2.0); dune build bin/run_tests.exe bin/sx_server.exe`. Erlang conformance **709/709** on the rebuilt binary (the broad run_tests 1110 failures are loops/erlang's pre-existing months-old divergence from architecture — run_tests was never built on this branch before; my changes are isolated additive). Next: 9i — wire the SX stub dispatcher to consult `extension-opcode-id`.
- **2026-05-15 Phase 9a integrated — scope widened to hosts/** — User lifted the hosts/ scope restriction ("we are going to merge this back anyhow"). Cherry-picked the 5 `vm-ext` commits (phases A-E) from `loops/sx-vm-extensions` onto `loops/erlang` — only conflict was `plans/sx-vm-opcode-extension.md` (already had architecture's final copy from an earlier iteration; resolved `-X ours`, OCaml files auto-merged clean since loops/erlang never touched hosts/). Discovered `extension-opcode-id` was still "Undefined symbol" even on a fresh build: `Sx_vm_extensions`'s module-init (`install_dispatch` + primitive registration) only runs if the module is linked, and `sx_server.ml` never referenced it (only `run_tests.ml` did), so OCaml dead-code-eliminated it. Fix: added `let () = ignore (Sx_vm_extensions.id_of_name "")` force-link reference near the top of `bin/sx_server.ml`. Rebuilt with `dune build` (opam switch 5.2.0; `dune` not on PATH by default — `eval $(opam env --switch=5.2.0)` first). `extension-opcode-id` now live: returns nil for unregistered names, will return real ids once an extension registers. Conformance **709/709** on the freshly built binary (cherry-picked sx_vm.ml dispatch changes + force-link, zero regressions). 9a checkbox flipped from BLOCKED to INTEGRATED; Blockers entry resolved; added 9h (erlang_ext.ml) + 9i (wire SX dispatcher to real ids) as ordinary in-scope checkboxes, reordered 9g after them. Next: write `hosts/ocaml/lib/extensions/erlang_ext.ml`.
- **2026-05-14 Phase 9g logged as partially BLOCKED — perf bench waits on 9a** — Conformance half satisfied: 709/709 with all Phase 9 stub infrastructure loaded (10 opcode IDs registered, 72 vm-suite tests passing, zero regressions in tokenize/parse/eval/runtime/ring/ping-pong/bank/echo/fib/ffi suites). Perf-bench half can't move forward in this worktree because the stub handlers wrap the existing `er-bif-*` / `er-match-*` / scheduler impls 1-to-1; a ring benchmark with the new opcodes "active" would measure the same 34 hops/s already documented in `bench_ring_results.md`. Updated `bench_ring_results.md` with a Phase 9 status section explaining the pre-integration state (stubs ready, real measurement gated on 9a's bytecode compiler emitting these IDs at hot sites). Blockers entry added pairing 9g with the existing 9a Blocker. No code change; total **709/709** unchanged. Phase 9 stub work (9b-9f) is complete from this loop's vantage point — 9a and 9g remain BLOCKED on a `hosts/ocaml/` iteration.
- **2026-05-14 Phase 9f — hot-BIF opcode table green** — Ten hot BIFs get direct opcode IDs in `lib/erlang/vm/dispatcher.sx` so the bytecode compiler can emit them at hot call sites without paying the registry string-key hash: `OP_BIF_LENGTH (136)`, `OP_BIF_HD (137)`, `OP_BIF_TL (138)`, `OP_BIF_ELEMENT (139)`, `OP_BIF_TUPLE_SIZE (140)`, `OP_BIF_LISTS_REVERSE (141)`, `OP_BIF_IS_INTEGER (142)`, `OP_BIF_IS_ATOM (143)`, `OP_BIF_IS_LIST (144)`, `OP_BIF_IS_TUPLE (145)`. Implementation is one line per opcode: the handler IS the existing `er-bif-*` function directly — same `(vs)` signature as the dispatcher's `(operands)`, so the registration is `(er-vm-register-opcode! ID "NAME" er-bif-FOO)`. IDs 136-159 reserved for future hot-BIF additions; cold BIFs continue through `er-apply-bif`/`er-lookup-bif`. 18 new tests in `tests/vm.sx`: opcode-by-id verification (LENGTH), one positive test per BIF (length on 3-cons, hd, tl-is-cons, element index 2, tuple_size 4, lists:reverse preserves length AND actually reverses [head check], is_integer pos+neg, is_atom pos+neg, is_list pos+nil pos+tuple neg, is_tuple pos+neg), opcode-list-grew-to-16+. vm suite 54 → 72. Total **709/709** (+18 vm). Real perf benefit lands when 9a integrates and the compiler emits these IDs at hot sites.
- **2026-05-14 Phase 9e — OP_SPAWN / OP_SEND + VM-process registry green** — `lib/erlang/vm/dispatcher.sx` gains a parallel mini-runtime distinct from the language-level `er-scheduler`: `er-vm-procs` (dict pid → proc record), `er-vm-next-pid` (counter cell), `er-vm-procs-reset!`, plus six accessors (`er-vm-proc-new!`/`get`/`send!`/`mailbox`/`state`/`count`). Process record shape is the register-machine layout the real bytecode scheduler will use: `{:id :registers (8 nil slots) :mailbox :state :initial-fn :initial-args}` — fixed register width so cells don't grow during execution. Opcode 134 `OP_SPAWN` calls `er-vm-proc-new!` and returns the new pid; 135 `OP_SEND` appends to the target's mailbox and flips a waiting proc back to runnable, returns false for unknown pid (graceful, doesn't crash). 16 new tests in `tests/vm.sx`: opcode-by-id for both, spawn returns 0 / 1 / count=2 / state=runnable / mailbox empty / 8 registers, send returns true, 3-sends preserve arrival order (first + last verified), send to unknown pid returns false, isolation (p1's msgs don't leak into p2), reset clears procs + resets pid counter. vm suite 38 → 54. One gotcha during impl: SX `fn` bodies evaluate ONLY the last expression — `er-vm-procs-reset!` had two `set-nth!` calls back-to-back which silently dropped the first; wrapped in `(do ...)` to fix. Total **691/691** (+16 vm). Real scheduler with per-process scheduling latency and runnable queue is post-9a.
- **2026-05-14 Phase 9d — OP_RECEIVE_SCAN stub green** — Selective-receive primitive at opcode id 133 in `lib/erlang/vm/dispatcher.sx`. Operand contract: `(clauses mbox-list env)` — clauses are AST dicts (`{:pattern :guards :body}`), mbox-list is a plain SX list (queue → list is the caller's job), env is the binding target. Internal helpers `er-vm-receive-try-clauses` (per-message clause walker with env snapshot/restore on failure) and `er-vm-receive-scan-loop` (mailbox walker, arrival order). Match returns `{:matched true :index N :body B}` so the caller can queue-delete at N and then evaluate B in the now-mutated env; miss returns `{:matched false}` so the caller can suspend via OP_PERFORM "receive-suspend". Mirrors the existing `er-try-receive-loop` in `transpile.sx` but doesn't reach into the scheduler — purely VM-level. 10 new tests in `tests/vm.sx`: opcode registered, scan finds match at correct index, scan binds var, body left unevaluated, no-match leaves env untouched, empty mailbox, first-match wins (arrival order — verified by two `{ok, _}` msgs and binding the FIRST value). vm suite 28 → 38. Total **675/675** (+10 vm). When 9a integrates and the real OP_RECEIVE_SCAN compiles clauses into a register-machine match, the existing `er-eval-receive-loop` becomes a one-line dispatch wrapper.
- **2026-05-14 Phase 9c — OP_PERFORM / OP_HANDLE stubs green** — Two new opcodes in `lib/erlang/vm/dispatcher.sx`: id 131 `OP_PERFORM` raises `{:tag "vm-effect" :effect <name> :args <args>}`; id 132 `OP_HANDLE` wraps a thunk in SX `guard`, catches matching effects by `:effect` name, passes the `:args` list to the handler fn, returns the handler's result. New helper `er-vm-effect-marker?` predicates on the dict shape. Non-matching effects rethrow via a small box+rethrow dance (caught with `:else` first, decision deferred to a post-guard cond — re-raise outside the guard's scope so it propagates to outer handlers cleanly). 9 new tests in `tests/vm.sx`: opcode registered for each id; OP_PERFORM raises with correct tag/effect/args; OP_HANDLE catches matching effect; OP_HANDLE returns thunk result when no effect performed; OP_HANDLE rethrows non-matching effect to outer; nested OP_HANDLE blocks separate by effect name (inner handles "a", outer handles "b", performing "b" bypasses inner). vm suite grew 19 → 28 tests. Total **665/665** (+9 vm). Underlying call/cc + raise/guard machinery used by Erlang `receive` is unchanged; this is the shape for the eventual specialization when 9a integrates. Candidate for chiselling to `lib/guest/vm/effects.sx` — Scheme call/cc, OCaml 5 effects, miniKanren all want the same shape.
- **2026-05-14 Phase 9b — stub VM dispatcher + 3 pattern opcodes green** — New `lib/erlang/vm/dispatcher.sx` defines the stub opcode registry mirroring the OCaml `EXTENSION` shape from `plans/sx-vm-opcode-extension.md`: opcodes registered as `{:id :name :handler}` keyed by string-id, looked up by id OR by name, dispatched via `er-vm-dispatch`. Opcode IDs follow the guest-tier partition (128-199 reserved for guest extensions like erlang/lua). Three opcodes registered at load time via `er-vm-register-erlang-opcodes!`: 128 `OP_PATTERN_TUPLE``er-match-tuple`, 129 `OP_PATTERN_LIST``er-match-cons`, 130 `OP_PATTERN_BINARY``er-match-binary`. Operand contract: `(pattern-ast value env)` returning `true`/`false` and mutating env on success — same as the underlying match functions. New `lib/erlang/tests/vm.sx` suite with 19 tests: 7 dispatcher core (registered, lookup by id+name for all three, two miss cases, list-has-3+); 4 OP_PATTERN_TUPLE (match success + var bind, no-match, arity mismatch); 4 OP_PATTERN_LIST (match, head bind, tail-is-cons, no-match on nil); 3 OP_PATTERN_BINARY (match, segment bind, size mismatch); 1 dispatch error (unknown opcode raises). `conformance.sh` updated: added `vm` to SUITES, added `(load "lib/erlang/vm/dispatcher.sx")` before tests and `(load "lib/erlang/tests/vm.sx")` after ffi, added epoch 110 evaluator. AST shape gotcha: er-match! reads `:type` not `:tag`; binary segment `:size` must be an AST node `{:type "integer" :value "8"}` because `er-eval-expr` runs on it. Total **656/656** (+19 vm). 9b complete; 9c (OP_PERFORM/OP_HANDLE) is next.
- **2026-05-14 Phase 9a logged as Blocker — sub-phase 9b is next** — 9a (the opcode extension mechanism in `hosts/ocaml/evaluator/`) is explicitly out-of-scope for this loop per the plan itself (briefing scope rule + 9a's own text). Logged a Blockers entry citing `plans/sx-vm-opcode-extension.md` as the design doc and pointing at the fix path (a `hosts/` session lands the registration shape, then a follow-up here wires the stub dispatcher to the real one). Ticked 9a as DONE because its contract was "Log as Blocker" — that's complete. Sub-phases 9b9g (PATTERN/PERFORM/RECEIVE/SPAWN_SEND/BIF/conformance) now in queue against a stub dispatcher in `lib/erlang/vm/`. No code change this iteration. Total **637/637** unchanged.
- **2026-05-14 Phase 9 scoped + supporting plan files synced** — Copied three plan files from `/root/rose-ash/plans/` (architecture branch) that this worktree was missing: `fed-sx-design.md` (124KB, the substrate design referenced from Phase 7/8 drivers), `fed-sx-milestone-1.md` (33KB, first concrete implementation milestone), `sx-vm-opcode-extension.md` (19KB, the prerequisite for Phase 9a — designs how `lib/<lang>/vm/` registers opcodes against the OCaml SX VM core). Then appended **Phase 9 — specialized opcodes (the BEAM analog)** to `plans/erlang-on-sx.md` covering sub-phases 9a-9g: 9a (opcode extension mechanism in `hosts/ocaml/`) is out-of-scope for this loop (will be logged as a Blocker when the next iteration tries to start it); 9b-9g (PATTERN_TUPLE/LIST/BINARY, PERFORM/HANDLE, RECEIVE_SCAN, SPAWN/SEND + lightweight scheduler, BIF dispatch table, conformance + perf bench) can be designed and tested against a stub dispatcher in the meantime. Targets: ring benchmark 100k+ hops/sec at N=1000 (~3000× speedup), 1M-process spawn under 30sec (~1000× speedup). Plan framing intact for Phase 7/8 — those reflect the actual implementation done in this loop; the architecture-branch framing diverges in language but the work is equivalent. No code touched this iteration. Total **637/637** unchanged.
- **2026-05-14 ffi test suite extracted, conformance scoreboard auto-picks it up** — New `lib/erlang/tests/ffi.sx` with its own counter trio (`er-ffi-test-count`/`-pass`/`-fails`) and `er-ffi-test` helper following the same pattern as runtime/eval/ring tests. The 10 file BIF eval tests from the previous iteration moved out of `eval.sx` (eval dropped from 395 to 385 tests) and into the new suite where they're now 9 tests (consolidated the two write+read tests). `conformance.sh` updated: added `ffi` to `SUITES` array with `er-ffi-test-pass`/`-count` symbols, added `(load "lib/erlang/tests/ffi.sx")` after `fib_server.sx`, added `(epoch 109) (eval "(list er-ffi-test-pass er-ffi-test-count)")`. Scoreboard markdown auto-updated to include the row. Suite also asserts that the 5 blocked BIFs (`crypto:hash`, `cid:from_bytes`, `file:list_dir`, `httpc:request`, `sqlite:exec`) are NOT yet registered — turns a future "added the wrapper but forgot to extend ffi tests" into a hard failure. One eval-comparison gotcha en route: SX's `=` does identity equality on dicts so comparing two separately-constructed `(er-mk-atom "true")` values is false; the existing eval suite has an `eev-deep=` helper that handles this, but the simpler fix in ffi was to extract `:name` via `ffi-nm` and compare strings. Total **637/637** (+14 ffi). Phase 8 fully ticked aside from the BLOCKED bullets — those remain unchecked with explicit Blockers references.
- **2026-05-14 file BIFs landed; crypto/cid/list_dir/http/sqlite blocked on missing host primitives** — Three new FFI BIFs registered in `runtime.sx`: `file:read_file/1`, `file:write_file/2`, `file:delete/1`. Each wraps the SX-host primitive (`file-read`, `file-write`, `file-delete`) inside a `guard` that converts thrown exception strings into Erlang `{error, Reason}` tuples. New helper `er-classify-file-error` does loose pattern-matching on the error message using `string-contains?` to map to standard POSIX-style reasons: `"No such"``enoent`, `"Permission denied"``eacces`, `"Not a directory"``enotdir`, `"Is a directory"``eisdir`, fallback `posix_error`. Filenames coerce through `er-source-to-string` so SX strings, Erlang binaries, and Erlang char-code lists all work. Read returns `{ok, Binary}` (bytes via `(map char->integer (string->list ...))` then `er-mk-binary`); write returns bare `ok`; delete returns bare `ok`. Bootstrap registrations added at the bottom of `er-register-builtin-bifs!` under `"file"`. 10 new eval tests: write-then-read round-trip, ok-tag, payload is binary, byte_size content, missing-file `enoent`, delete-ok, read-after-delete `enoent`, write to non-existent dir `enoent`, binary payload (5 raw bytes) round-trip preserving byte count. Blockers entry added covering five Phase 8 BIFs whose host primitives don't exist in this SX runtime: `crypto:hash/2`, `cid:from_bytes/1`/`to_string/1`, `file:list_dir/1`, `httpc:request/4`, `sqlite:open/exec/query/close`. Fix path documented inline (architecture-branch iteration to register OCaml-side primitives). Total **633/633** (+10 eval).
- **2026-05-14 term-marshalling helpers landed** — `er-to-sx` (Erlang term → SX-native) and `er-of-sx` (SX-native → Erlang term) plus internal helper `er-cons-to-sx-list` (recursive cons-chain walker). All three live in `runtime.sx` next to the BIF registry. Conversion table: atom ↔ symbol via `make-symbol`/`er-mk-atom`; nil ↔ `()`; cons-chain → SX list (recursive marshal of each head); tuple → SX list (one-way — tuples flatten and can't be reconstructed without a tag); binary ↔ SX string (bytes ↔ char codes via `char->integer`/`integer->char`); integer / float / boolean passthrough; opaque types (pid, ref, fun) passthrough. SX strings on the way back become Erlang binaries — the natural FFI return shape. Empty SX list (`type-of` `"nil"`) marshals back to `er-mk-nil`. Edit gotchas during implementation: SX has no `while`, `string-ref`, or `string-length` primitive — used `(map char->integer (string->list s))` for byte extraction and a recursive helper for cons-walking. 23 new runtime tests in `tests/runtime.sx`: 10 covering `er-to-sx` (atom/atom-is-symbol, nil, int / float / bool passthrough, binary→string, cons→list, tuple→list, nested), 8 covering `er-of-sx` (symbol→atom, atom-tag, string→binary, byte content, int passthrough, empty-list→nil, list→cons length, head field), 4 round-trips (int, atom, binary bytes, list length), 1 negative documenting that tuple round-trip flattens to cons. Total **623/623** (+23 runtime).
- **2026-05-14 BIF registry migration complete — cond chains gone** — `er-register-builtin-bifs!` at the end of `runtime.sx` populates the registry with all 67 built-in BIFs in five module namespaces. Pure ops (`length`, `hd`, `tl`, `element`, predicates, arithmetic, list/atom/integer conversions, all of `lists`) registered via `er-register-pure-bif!`; side-effecting ops (`spawn`, `self`, `exit`, `link`/`monitor`/`register`, `process_flag`, `make_ref`, `throw`/`error`, `io:format`, all of `ets`, all of `code`) via `er-register-bif!`. Multi-arity entries: `is_function/1`/`/2`, `spawn/1`/`/3`, `exit/1`/`/2`, `io:format/1`/`/2`, `lists:seq/2`/`/3`, `ets:delete/1`/`/2` — six pairs, twelve registrations, all pointing at the existing arity-dispatching impl. `throw` and `error` are registered with a tiny inline `(fn (vs) (raise ...))` lambda because the original code chained directly through `raise` inside the cond instead of an `er-bif-*` helper. `er-apply-bif` shrinks from a 44-line cond chain to a 5-line registry lookup. `er-apply-remote-bif` becomes a 7-line dispatcher (user-modules-first → registry → error). All four per-module dispatchers (`er-apply-lists-bif`, `er-apply-io-bif`, `er-apply-ets-bif`, `er-apply-code-bif`) deleted — net reduction ~110 lines of cond machinery. One subtle wrinkle: `tests/runtime.sx` calls `er-bif-registry-reset!` near the end of its BIF-registry tests, which would have left subsequent test files (ring, ping-pong, etc.) unable to call `length`/`spawn`/etc. Fix: re-call `er-register-builtin-bifs!` at the bottom of `tests/runtime.sx` to repopulate. Total **600/600** unchanged.
- **2026-05-14 Phase 8 BIF registry foundation** — `lib/erlang/runtime.sx` gains `er-bif-registry` (a `(list {})` mutable cell, same shape as `er-modules`) and five helpers: `er-bif-registry-get`/`er-bif-registry-reset!` (access + reset), `er-bif-key` (format `"Module/Name/Arity"`), `er-register-bif!` and `er-register-pure-bif!` (both upsert; differ only in the `:pure?` flag — pure ones are safe to inline, side-effecting ones go through normal IO), `er-lookup-bif` (returns the entry dict or nil), `er-list-bifs` (registered keys). Entries are `{:module :name :arity :fn :pure?}`. Lookup miss → nil; arity is part of the key so `m:f/1` and `m:f/2` are distinct; re-registering the same key replaces in-place (count stays the same); reset clears. Registry sits alongside `er-modules` in runtime.sx so any other piece of the system can register BIFs without touching the dispatcher — the migration onto this registry (the next checkbox) will rip out the giant cond chains in `er-apply-bif`/`er-apply-remote-bif`. 18 new runtime tests in `tests/runtime.sx`: empty-state, lookup-miss, register-grows-count, lookup-hit-fields (module/name/arity/pure?), fn-invocable, re-register-replaces, pure-flag-true, arity-disambiguation (3 entries for `fake:echo/1`, `fake:echo/2`, `fake:pure/2`), reset-clears, reset-lookup-nil. Total **600/600** (+18 runtime).
- **2026-05-14 Phase 7 capstone green — full hot-reload ladder works end-to-end** — Wires everything from the previous five iterations into one test program: load cap v1 with `start/0` (spawn-from-inside-module) + `loop/0` + `tag/0` → spawn Pid1 (running v1) → load cap v2 → assert `cap:tag()` returns v2 (cross-module dispatch hits `:current`) → spawn Pid2 (running v2) → `code:soft_purge(cap)` returns `false` (refuses while Pid1 is alive on v1's env) → `code:purge(cap)` returns `true` (kills Pid1, clears `:old`) → `code:soft_purge(cap)` returns `true` (clean — no `:old` left). To make this work, `er-procs-on-env` was extended with a new helper `er-env-derived-from?`: a process counts as "running on" mod-env if its `:initial-fun`'s `:env` IS mod-env directly OR contains at least one binding whose value is a fun closed over mod-env. Reason: `er-apply-fun-clauses` always `er-env-copy`s the closure-env before binding params, so a fun created inside a module body has a `:env` that's a *copy* of mod-env, not mod-env itself — the copy still contains the module's other functions as values, each pointing back to the canonical mod-env. The whole ladder runs as a single `erlang-eval-ast` invocation because each call to `ev` resets the scheduler via `er-sched-init!`, wiping any cross-call Pids. 5 capstone tests: v1 tag, v2 tag (cross-mod after reload), soft_purge-refuses, hard purge, soft_purge-clean-after-hard. Total **582/582** (+5 eval). Phase 7 fully ticked.
- **2026-05-14 hot-reload call-dispatch semantics verified** — Tests-only iteration: no implementation change, just six new eval tests that nail down the Erlang semantics already implicit in the current code. (1) `M:F()` after reload returns v2's value (cross-module call hits `:current`). (2) Inside a freshly-loaded body, a bare local call resolves through the new mod-env so a chain `a() -> b()` reflects v2's `b/0`. (3) Calling a fun captured BEFORE reload, whose body uses a local call, returns the v1 value (closure pinned to old mod-env via `er-mk-fun`'s `:env` reference). (4) Calling a fun captured BEFORE reload, whose body uses a cross-module call `M:b()`, returns v2's value (cross-module always wins over closed-over env). (5) Two captured funs from two distinct vintages stay independent — F1() + F2() = 10 + 20 = 30. (6) The slot version counter still bumps even while old captured funs are alive, demonstrating the closure-pinning doesn't block reloads. The "running process finishes its current function with the version it started with" property falls out of fun-as-closure semantics for free — there's no special bookkeeping. Total **577/577** (+6 eval).
- **2026-05-14 code introspection BIFs green** — `code:which/1`, `code:is_loaded/1`, `code:all_loaded/0` added to `er-apply-code-bif` dispatch with three small implementations in `transpile.sx`. `which` and `is_loaded` are dict-lookups on the module registry returning the loaded-marker (atom `loaded`) or the missing-marker (atom `non_existing` for which, atom `false` for is_loaded). Since we don't have a filesystem path representation, the standard `{file, Path}` shape for `is_loaded` becomes `{file, loaded}` — same tuple arity so destructuring code stays portable. `all_loaded` iterates `(keys (er-modules-get))` in reverse (so the result list preserves insertion order after the cons-prepend loop), wrapping each name in a `{Module, loaded}` tuple. **10 new eval tests**: non_existing for absent / loaded after load for which; missing / file-tag / loaded-value for is_loaded; empty / count-after-2-loads / first-entry-tag for all_loaded; badarg for both single-arg BIFs. Two of the all_loaded tests needed an explicit `(er-modules-reset!)` before the measurement because prior tests in the suite leave modules registered (the registry is process-global across the whole epoch session). Total **571/571** (+10 eval).
- **2026-05-14 code:purge/1 + code:soft_purge/1 green** — Two new BIFs in `transpile.sx`: `er-bif-code-purge` and `er-bif-code-soft-purge`, both dispatched through the existing `er-apply-code-bif` cond chain. Shared helper `er-procs-on-env` walks `(er-sched-processes)` and collects pids whose `:initial-fun` is a fun whose `:env` is identical (dict-identity, not structural) to a given env, filtering out already-dead procs. `er-bif-code-purge` looks up the module slot, returns `false` if either the module isn't registered or `:old` is nil; otherwise calls `er-cascade-exit!` on every matching pid with reason `killed`, replaces the slot with a fresh `er-mk-module-slot` that has `:old nil` (current + version preserved), returns `true`. `er-bif-code-soft-purge` returns `true` (treating "no module" / "no old version" as already-purged), else checks for lingering procs and returns `false` (leaving the slot untouched) if any, else clears `:old` and returns `true`. Non-atom Mod raises `error:badarg` from both. **10 new eval tests**: unknown / no-old / after-reload / idempotent for purge; unknown / no-old / clean for soft_purge; badarg for both; one "purge after spawn" test verifying return value (does NOT exercise the kill path — see caveat in plan). Total **561/561** (+10 eval). Implementation cost: 1 dispatch entry, 3 small BIFs, no scheduler changes.
- **2026-05-14 code:load_binary/3 green** — Canonical hot-reload entry point. Adds a `"code"` module branch to `er-apply-remote-bif`'s dispatch; new helpers `er-source-walk-bytes!` and `er-source-to-string` coerce any of {SX string, Erlang binary `<<...>>`, Erlang char-code cons list} to an SX source string before parsing. `er-bif-code-load-binary` is the BIF itself: validates `Mod` is an atom (`{error, badarg}` else), coerces source (`{error, badarg}` on unrecognised shape), wraps `erlang-load-module` in `guard` to convert parse failures into `{error, badfile}`, checks the parsed `-module(Name).` matches the BIF's first arg (`{error, module_name_mismatch}` else), returns `{module, Mod}`. Reload reuses the Phase-7 slot logic from the previous iteration so calling `code:load_binary(m, _, v2_source)` after `code:load_binary(m, _, v1_source)` bumps the slot to version 2 with v1 sitting in `:old`. 8 new eval tests: ok-tag/ok-name on first load, immediate cross-module call hits new env, reload-and-call returns v2 result, name-mismatch errors with both tag and reason, garbage source yields badfile, non-atom Mod is badarg. Total **551/551** (+8 eval). `code:load_file/1` deferred until `file:read_file/1` lands in Phase 8 (it's just a wrapper that reads bytes from disk then calls `load_binary`).
- **2026-05-14 Phase 7 module-version slot landed** — `er-modules` entries are now `{:current MOD-ENV :old MOD-ENV-or-nil :version INT :tag "module"}` instead of bare mod-env dicts. New helpers in `runtime.sx`: `er-mk-module-slot`, `er-module-current-env`, `er-module-old-env`, `er-module-version`. `erlang-load-module` updated: first load creates a slot with `:version 1` and `:old nil`; subsequent loads of the same module name copy `:current` into `:old` and increment `:version` (bump-and-shift, single-old-version retention as per OTP semantics). `er-apply-user-module` now reads via `er-module-current-env` so cross-module calls always hit the latest version. 13 new runtime tests (mostly in `tests/runtime.sx`): slot constructor + accessors, registry-after-first-load (v1, old nil), registry-after-second-load (v2, old = previous current env identity, current = new env), v3 on triple-load, registry-reset clears. Total **543/543** (was 530/530). Note: sx-tree path-based MCP tools (`sx_replace_node`, `sx_read_subtree`) are broken in this worktree's `mcp_tree.exe` (every path returns/replaces form 0); edits applied via a Python script then `sx_validate`d. Pattern-based tools (`sx_find_all`, `sx_rename_symbol`) still work fine.
- **2026-05-14 Phase 7 + Phase 8 scoped** — Plan extended with two new phases driven by fed-sx (see `plans/fed-sx-design.md` §17.5). Phase 7 brings hot code reload back in scope (was previously listed as out-of-scope): module versioning slot, `code:load_file/1`/`purge/1`/`soft_purge/1`/`which/1`/`is_loaded/1`, cross-module calls hitting current, local calls keeping start-time semantics until function returns. Phase 8 introduces a runtime-extensible **FFI BIF registry** that replaces today's hardcoded `er-apply-bif`/`er-apply-remote-bif` cond chains, plus a term-marshalling layer and concrete BIFs for `crypto:hash`, `cid:from_bytes`/`to_string`, `file:read_file`/`write_file`/`list_dir`/`delete`, `httpc:request`, `sqlite:open`/`exec`/`query`. Scope decisions header updated accordingly. Baseline 530/530 unchanged; no code touched this iteration.
- **2026-04-25 BIF round-out — Phase 6 complete, full plan ticked** — Added 18 standard BIFs in `lib/erlang/transpile.sx`. **erlang module:** `abs/1` (negates negative numbers), `min/2`/`max/2` (use `er-lt?` so cross-type comparisons follow Erlang term order), `tuple_to_list/1`/`list_to_tuple/1` (proper conversions), `integer_to_list/1` (returns SX string per the char-list shim), `list_to_integer/1` (uses `parse-number`, raises badarg on failure), `is_function/1` and `is_function/2` (arity-2 form scans the fun's clause patterns). **lists module:** `seq/2`/`seq/3` (right-fold builder with step), `sum/1`, `nth/2` (1-indexed, raises badarg out of range), `last/1`, `member/2`, `append/2` (alias for `++`), `filter/2`, `any/2`, `all/2`, `duplicate/2`. 40 new eval tests with positive + negative cases, plus a few that compose existing BIFs (e.g. `lists:sum(lists:seq(1, 100)) = 5050`). Total suite **530/530** — every checkbox in `plans/erlang-on-sx.md` is now ticked. - **2026-04-25 BIF round-out — Phase 6 complete, full plan ticked** — Added 18 standard BIFs in `lib/erlang/transpile.sx`. **erlang module:** `abs/1` (negates negative numbers), `min/2`/`max/2` (use `er-lt?` so cross-type comparisons follow Erlang term order), `tuple_to_list/1`/`list_to_tuple/1` (proper conversions), `integer_to_list/1` (returns SX string per the char-list shim), `list_to_integer/1` (uses `parse-number`, raises badarg on failure), `is_function/1` and `is_function/2` (arity-2 form scans the fun's clause patterns). **lists module:** `seq/2`/`seq/3` (right-fold builder with step), `sum/1`, `nth/2` (1-indexed, raises badarg out of range), `last/1`, `member/2`, `append/2` (alias for `++`), `filter/2`, `any/2`, `all/2`, `duplicate/2`. 40 new eval tests with positive + negative cases, plus a few that compose existing BIFs (e.g. `lists:sum(lists:seq(1, 100)) = 5050`). Total suite **530/530** — every checkbox in `plans/erlang-on-sx.md` is now ticked.
- **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 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 `<<b1,b2,...>>`. 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 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 `<<b1,b2,...>>`. 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.
@@ -131,4 +251,24 @@ _Newest first._
## Blockers ## Blockers
- _(none yet)_ - **Phase 10a — opcode emission requires `lib/compiler.sx` (out of scope)** (2026-05-15). Architecture fully traced this iteration: the OCaml JIT (`sx_vm.ml` `jit_compile_lambda`, ref-set at line 1206) invokes the SX-level `compile` from **`lib/compiler.sx`** via the CEK machine; that is the sole SX→bytecode producer. Erlang's hot helpers (`er-match-tuple`, `er-bif-*`, …) are SX functions in `transpile.sx` that get JIT-compiled through this path. To emit `erlang.OP_*` they must be recognized as intrinsics inside `compiler.sx`'s `compile-call` (the file's own docstring already anticipates this: "Compilers call `extension-opcode-id` to emit extension opcodes" — designed, not yet implemented). `lib/compiler.sx` is **lib-root**, excluded by the ground rules ("Don't edit lib/ root") and absent from the widened `lib/erlang/** + hosts/ocaml/** (extension only)` scope — editing it changes every guest language's JIT, so it must be owned by a shared-compiler session, not this loop. **Fix path:** that session implements 10a.1 (intrinsic registry in `compiler.sx`) + 10a.2 (`compile-call` emits the opcode when registered & `extension-opcode-id` non-nil, else generic CALL). Erlang's BIF handlers (10b, ids 230-239, all real) light up the instant emission exists — zero further work here. The control opcodes (222-229) additionally need 10a.3 (operand contract) + OCaml↔SX runtime-state bridging (Erlang scheduler/mailbox live in `lib/erlang/runtime.sx`, not OCaml).
- **Phase 9g — Perf bench gated on 9a** (2026-05-14). The conformance half of 9g (709/709 with stub VM loaded) is satisfied; the perf-bench half requires 9a's bytecode compiler to actually emit the new opcodes at hot call sites. Until then a benchmark would measure today's `er-bif-*` / `er-match-*` numbers unchanged (since the stub handlers wrap them 1-to-1). Re-fire 9g after 9a lands.
- **Phase 9a — Opcode extension mechanism** — **RESOLVED 2026-05-15.** User widened scope to include hosts/ (merging back anyhow). Cherry-picked vm-ext phases A-E + force-linked `Sx_vm_extensions` into sx_server.exe. `extension-opcode-id` live; conformance 709/709. Remaining integration work (erlang_ext.ml + wiring the SX stub dispatcher to consult real ids) tracked as ordinary in-scope checkboxes now, not blockers.
- **RESOLVED (2026-05-18) — SX runtime now exposes the platform
primitives Phase 8 BIFs need.** Delivered by `loops/fed-prims`
(see `plans/fed-sx-host-primitives.md` Handoff). Pure-OCaml,
WASM-safe except `http-listen` (native only). Wire Phase 8 BIFs:
- `crypto:hash/2``crypto-sha256` / `crypto-sha512` /
`crypto-sha3-256` (each `(bytes) -> hex-string`).
- `cid:from_bytes/1``cid-from-bytes` `(codec mh-bytes)`;
`cid:to_string/1` / canonical CID → `cid-from-sx` `(value)`;
dag-cbor via `cbor-encode` / `cbor-decode`.
- signature verify → `ed25519-verify` `(pk msg sig)` and
`rsa-sha256-verify` `(spki msg sig)` — both total (→ false).
- `file:list_dir/1``file-list-dir` `(path) -> (list string)`.
- fed-sx transport → `http-listen` `(port handler)` (native only).
Still deferred (leave blocked): `httpc` (HTTP client, v2) and
`sqlite-*` (v2 indexes) — not provided by fed-prims.

2638
plans/fed-sx-design.md Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -68,7 +68,7 @@ Errors: `raise (Eval_error "name: shape")`. Byte strings are OCaml `string`
Dependency order. Each phase: implement → `dune build` (ocaml) → **WASM build Dependency order. Each phase: implement → `dune build` (ocaml) → **WASM build
check** → tests → commit → tick box → Progress-log line → push. check** → tests → commit → tick box → Progress-log line → push.
### Phase A — SHA-2 (sha256 + sha512), pure OCaml ### Phase A — SHA-2 (sha256 + sha512), pure OCaml ✅ DONE
- New `lib/sx_sha2.ml` (or inline in primitives if small): SHA-256 + SHA-512. - New `lib/sx_sha2.ml` (or inline in primitives if small): SHA-256 + SHA-512.
- Primitives `crypto-sha256`, `crypto-sha512` → lowercase hex string. - Primitives `crypto-sha256`, `crypto-sha512` → lowercase hex string.
- Tests (`bin/run_tests.ml` or a dedicated `bin/test_crypto.ml`): NIST vectors — - Tests (`bin/run_tests.ml` or a dedicated `bin/test_crypto.ml`): NIST vectors —
@@ -77,12 +77,12 @@ check** → tests → commit → tick box → Progress-log line → push.
- sha512("abc") = `ddaf35a1…2a9ac94f…` - sha512("abc") = `ddaf35a1…2a9ac94f…`
- **Acceptance:** vectors pass; WASM build links; OCaml conformance unchanged. - **Acceptance:** vectors pass; WASM build links; OCaml conformance unchanged.
### Phase B — SHA-3 / Keccak-256, pure OCaml ### Phase B — SHA-3 / Keccak-256, pure OCaml ✅ DONE
- Keccak-f[1600] + SHA3-256 padding. Primitive `crypto-sha3-256`. - Keccak-f[1600] + SHA3-256 padding. Primitive `crypto-sha3-256`.
- Tests: sha3-256("") = `a7ffc6f8…0f8434a`; sha3-256("abc") = `3a985da7…11431532`. - Tests: sha3-256("") = `a7ffc6f8…0f8434a`; sha3-256("abc") = `3a985da7…11431532`.
- **Acceptance:** NIST SHA-3 vectors pass; WASM links. - **Acceptance:** NIST SHA-3 vectors pass; WASM links.
### Phase C — dag-cbor encoder + decoder, pure OCaml ### Phase C — dag-cbor encoder + decoder, pure OCaml ✅ DONE
- RFC 8949 deterministic subset (RFC 8742 dag-cbor): unsigned/negative ints, - RFC 8949 deterministic subset (RFC 8742 dag-cbor): unsigned/negative ints,
byte strings, text strings, arrays, maps with **keys sorted by byte strings, text strings, arrays, maps with **keys sorted by
length-then-bytewise**, bool, null, tag 42 (CID link). No floats unless a length-then-bytewise**, bool, null, tag 42 (CID link). No floats unless a
@@ -93,7 +93,7 @@ check** → tests → commit → tick box → Progress-log line → push.
appendix-A vectors + a "reordered dict keys → identical bytes" determinism test. appendix-A vectors + a "reordered dict keys → identical bytes" determinism test.
- **Acceptance:** vectors + round-trip + determinism pass; WASM links. - **Acceptance:** vectors + round-trip + determinism pass; WASM links.
### Phase D — CID computation, pure OCaml ### Phase D — CID computation, pure OCaml ✅ DONE
- Multihash (sha2-256 = 0x12, sha3-256 = 0x16; varint code + varint len + digest). - Multihash (sha2-256 = 0x12, sha3-256 = 0x16; varint code + varint len + digest).
- CIDv1 = `0x01 || codec-varint || multihash`. Codecs: dag-cbor 0x71, raw 0x55. - CIDv1 = `0x01 || codec-varint || multihash`. Codecs: dag-cbor 0x71, raw 0x55.
- Multibase base32 lower (`b` prefix, RFC 4648 no-pad). - Multibase base32 lower (`b` prefix, RFC 4648 no-pad).
@@ -105,7 +105,7 @@ check** → tests → commit → tick box → Progress-log line → push.
- **Acceptance:** matches reference CIDs; determinism holds; WASM links. Satisfies - **Acceptance:** matches reference CIDs; determinism holds; WASM links. Satisfies
fed-sx Milestone 1 Step 1. fed-sx Milestone 1 Step 1.
### Phase E — Ed25519 verify, pure OCaml ### Phase E — Ed25519 verify, pure OCaml ✅ DONE
- Curve25519/edwards25519 field arith (mod 2^255-19), point decompress, - Curve25519/edwards25519 field arith (mod 2^255-19), point decompress,
SHA-512-based verify per RFC 8032 §5.1.7. (Reuse Phase A sha512.) SHA-512-based verify per RFC 8032 §5.1.7. (Reuse Phase A sha512.)
- Primitive `ed25519-verify (pubkey msg sig) -> bool`. Bad-length args → false, - Primitive `ed25519-verify (pubkey msg sig) -> bool`. Bad-length args → false,
@@ -115,7 +115,7 @@ check** → tests → commit → tick box → Progress-log line → push.
- **Acceptance:** all RFC 8032 vectors pass; WASM links. Satisfies fed-sx Step 2 - **Acceptance:** all RFC 8032 vectors pass; WASM links. Satisfies fed-sx Step 2
(Ed25519 sig-suite). (Ed25519 sig-suite).
### Phase F — RSA-SHA256 verify (PKCS#1 v1.5), pure OCaml ### Phase F — RSA-SHA256 verify (PKCS#1 v1.5), pure OCaml ✅ DONE
- Minimal pure-OCaml bignum (only need modexp + DER parse). Parse SPKI DER → - Minimal pure-OCaml bignum (only need modexp + DER parse). Parse SPKI DER →
(n, e). RSASSA-PKCS1-v1_5 verify with SHA-256 (Phase A). (n, e). RSASSA-PKCS1-v1_5 verify with SHA-256 (Phase A).
- Primitive `rsa-sha256-verify (der-spki msg sig) -> bool`. - Primitive `rsa-sha256-verify (der-spki msg sig) -> bool`.
@@ -125,14 +125,14 @@ check** → tests → commit → tick box → Progress-log line → push.
Step 2 (rsa-sha256-2018 sig-suite). **Lower priority** than E — Ed25519 is the Step 2 (rsa-sha256-2018 sig-suite). **Lower priority** than E — Ed25519 is the
modern default; RSA can land after the HTTP phase if time-boxed. modern default; RSA can land after the HTTP phase if time-boxed.
### Phase G — `file-list-dir`, native-safe ### Phase G — `file-list-dir`, native-safe ✅ DONE
- `Sys.readdir` → sorted SX list of names (no `.`/`..`). Errors → `enoent`/ - `Sys.readdir` → sorted SX list of names (no `.`/`..`). Errors → `enoent`/
`enotdir` classified like the existing `file-read` error mapping. `enotdir` classified like the existing `file-read` error mapping.
- Tests: list a known dir, missing dir → error, file-not-dir → error. - Tests: list a known dir, missing dir → error, file-not-dir → error.
- **Acceptance:** passes; WASM build still links (Sys.readdir is stubbed there). - **Acceptance:** passes; WASM build still links (Sys.readdir is stubbed there).
Satisfies fed-sx Step 3 segment replay. Satisfies fed-sx Step 3 segment replay.
### Phase H — HTTP/1.1 server, **native-only** (`bin/sx_server.ml`) ### Phase H — HTTP/1.1 server, **native-only** (`bin/sx_server.ml`) ✅ DONE
- Minimal threaded HTTP/1.1: accept loop (`Unix` + `Thread`), parse request - Minimal threaded HTTP/1.1: accept loop (`Unix` + `Thread`), parse request
line + headers + body (Content-Length), build an SX request dict line + headers + body (Content-Length), build an SX request dict
`{:method :path :query :headers :body}`, call the SX handler callable, take an `{:method :path :query :headers :body}`, call the SX handler callable, take an
@@ -145,7 +145,7 @@ check** → tests → commit → tick box → Progress-log line → push.
- **Acceptance:** curl test script green; WASM build untouched (prim not in lib). - **Acceptance:** curl test script green; WASM build untouched (prim not in lib).
Satisfies fed-sx Step 8 transport. Satisfies fed-sx Step 8 transport.
### Phase I — handoff ### Phase I — handoff ✅ DONE
- Flip the `plans/erlang-on-sx.md` Blockers entry "SX runtime lacks platform - Flip the `plans/erlang-on-sx.md` Blockers entry "SX runtime lacks platform
primitives …" to **RESOLVED**, listing the exact SX primitive names so the primitives …" to **RESOLVED**, listing the exact SX primitive names so the
Erlang loop can one-line-wire its blocked Phase 8 BIFs (`crypto:hash/2`, Erlang loop can one-line-wire its blocked Phase 8 BIFs (`crypto:hash/2`,
@@ -201,11 +201,89 @@ printf '(epoch 1)\n(crypto-sha256 "abc")\n' | \
| `file-list-dir` | `file:list_dir/1` | | `file-list-dir` | `file:list_dir/1` |
| `http-listen` | fed-sx kernel `http:listen/2` (Milestone 1 Step 8) | | `http-listen` | fed-sx kernel `http:listen/2` (Milestone 1 Step 8) |
**Status: DELIVERED (Phases AH, 2026-05-18).** All primitives are
registered and reachable from SX (`(eval "(crypto-sha256 \"abc\")")`
via the epoch protocol). Signatures the Erlang loop can one-line-wire:
- `(crypto-sha256 bytes) -> hex-string` — also `crypto-sha512`,
`crypto-sha3-256`. lib (`Sx_sha2`/`Sx_sha3`), WASM-safe.
- `(cbor-encode value) -> bytes` / `(cbor-decode bytes) -> value` —
deterministic dag-cbor, lib (`Sx_cbor`), WASM-safe.
- `(cid-from-bytes codec mh-bytes) -> cid-string` /
`(cid-from-sx value) -> cid-string` — lib (`Sx_cid`), WASM-safe.
- `(ed25519-verify pk msg sig) -> bool` /
`(rsa-sha256-verify spki msg sig) -> bool` — total (bad input →
false), lib (`Sx_ed25519`/`Sx_rsa`), WASM-safe.
- `(file-list-dir path) -> (list string)` — sorted, lib, WASM-stubbed.
- `(http-listen port handler) -> never` — **NATIVE ONLY**
(`bin/sx_server.ml`); absent from the WASM kernel by design.
Still **deferred** (not Milestone 1, not provided here): `httpc-request`
(HTTP client / federation v2), `sqlite-*` (v2 indexes). The Erlang loop
should leave `httpc`/`sqlite` BIFs blocked with that note.
## Progress log ## Progress log
_Newest first._ _Newest first._
- (none yet — Phase A is first) - 2026-05-18 — Phase I: handoff. `erlang-on-sx.md` Blockers gained one
RESOLVED entry (no "SX runtime lacks…" entry pre-existed; it read
"_(none yet)_") mapping every delivered primitive → its Phase 8 BIF,
with httpc/sqlite explicitly left deferred. Handoff section here
filled with signatures + native/WASM notes. Doc-only (no lib/erlang/
edits); Erlang 530/530 unchanged. **fed-sx Milestone 1 Steps 1-3 + 8
prerequisites all green — plan complete (Phases AI done).**
- 2026-05-18 — Phase H: `http-listen` primitive in `bin/sx_server.ml`
(NATIVE ONLY — Unix sockets + Thread per connection, Mutex around
the shared-runtime handler call; HTTP/1.1, Connection: close;
req {:method :path :query :headers :body} → resp {:status :headers
:body}). Test `bin/test_http.sh`: curl GET+query / POST+body / 404
/ custom header — 6/6. NOT in lib, so WASM kernel untouched (boot
green); run_tests 4897 unchanged; Erlang 530/530. Satisfies fed-sx
Milestone 1 Step 8 transport.
- 2026-05-18 — Phase G: `file-list-dir` primitive in
`lib/sx_primitives.ml` (Sys.readdir → sorted names, no "."/"..";
Sys_error prefixed like file-read, msg carries enoent/enotdir).
4 tests: sorted listing, missing dir, not-a-dir, arity. WASM boot
green (Sys.readdir stubbed there); Erlang 530/530; run_tests +4.
Satisfies fed-sx Step 3 segment replay.
- 2026-05-18 — Phase F: pure-OCaml `lib/sx_rsa.ml` (self-contained
bignum modexp, minimal DER SPKI reader, RFC 8017 §8.2.2 PKCS#1
v1.5 verify with SHA-256 DigestInfo prefix). Primitive
`rsa-sha256-verify` total. 5 tests on a fixed RSA-2048 vector
(one-off python-cryptography keygen, hardcoded): valid, tampered
msg/sig, garbage SPKI, non-string. WASM boot green with new lib
module; Erlang 530/530; run_tests +5. Satisfies fed-sx Step 2
(rsa-sha256-2018 sig-suite).
- 2026-05-18 — Phase E: pure-OCaml `lib/sx_ed25519.ml` (minimal
base-2^26 bignum, edwards25519 extended-coord points, RFC 8032
§5.1.7 cofactorless verify reusing Phase-A sha512). Primitive
`ed25519-verify` is total (bad/short/non-string args → false).
8 tests: RFC 8032 §7.1 TEST 1-3 (re-derived independently via
python-cryptography), tampered msg/sig, wrong-length, non-string.
WASM boot green with new lib module; Erlang 530/530; run_tests +8.
Satisfies fed-sx Milestone 1 Step 2 (Ed25519 sig-suite).
- 2026-05-18 — Phase D: pure-OCaml `lib/sx_cid.ml` (unsigned-varint,
multihash, CIDv1, multibase base32-lower), primitives `cid-from-bytes`
/ `cid-from-sx` (cbor→sha2-256→mh→cidv1, dag-cbor codec 0x71). 5 tests:
raw "abc"=bafkreif2pall7d…, raw ""=bafkreihdwdcefg…, dag-cbor {}=
bafyreigbtj4x7i… (all match canonical IPFS CIDs; no `ipfs` CLI so
vectors independently derived in Python), key-order determinism. WASM
boot green with new lib module; Erlang 530/530; run_tests +5.
- 2026-05-18 — Phase C: pure-OCaml `lib/sx_cbor.ml` (dag-cbor encode/
decode), primitives `cbor-encode`/`cbor-decode`. RFC 8949 Appendix-A
vectors, length-then-bytewise key sort + order-invariance determinism,
decode∘encode round-trip (30 tests). Floats unsupported (raise, no
fed-sx shape needs them); tag-42 decode = inner-item passthrough.
WASM boot green with new lib module; Erlang 530/530; run_tests +30.
- 2026-05-18 — Phase B: pure-OCaml `lib/sx_sha3.ml` (Keccak-f[1600] +
SHA-3 pad, domain 0x06), primitive `crypto-sha3-256`. 4 NIST FIPS 202
vectors pass (empty/abc/896-bit + 1600-bit 0xa3 multi-block). WASM boot
green with new lib module; Erlang conformance 530/530; run_tests +4.
- 2026-05-18 — Phase A: pure-OCaml `lib/sx_sha2.ml` (SHA-256 + SHA-512),
primitives `crypto-sha256`/`crypto-sha512`. 7 NIST FIPS 180-4 vectors pass
(empty/abc/896-bit/1M-'a' for sha256; empty/abc/896-bit for sha512). WASM
boot green with new lib module; Erlang conformance 530/530 unchanged.
## Blockers ## Blockers

922
plans/fed-sx-milestone-1.md Normal file
View File

@@ -0,0 +1,922 @@
# fed-sx Milestone 1 — Kernel + Registries + Pin Smoke Test
Concrete implementation plan for the smallest fed-sx that proves the architecture
works end-to-end. Reference: `plans/fed-sx-design.md`. Prerequisite: Erlang-on-SX
Phases 7 (hot reload) + 8 (FFI BIFs).
## Goal
Ship a single-instance, single-actor fed-sx server that:
1. Boots from a verified genesis bundle.
2. Accepts and durably appends signed activities via `POST /activity`.
3. Folds them into projections in real time.
4. Serves AP-standard endpoints (actor, outbox, artifacts, capabilities).
5. Demonstrates **two extensibility proof-points** end-to-end with zero kernel
code changes between definition and use:
- **Verb extensibility** (§5 meta-level): publish `DefineActivity{Pin}` +
`DefineProjection{pin-state}`, then publish a `Pin` activity, observe it
validated and projected.
- **Reactive application extensibility** (§§18-19): publish
`DefineSubscription{Topic}` + `Subscribe{topic: smoketest}` +
`DefineTrigger{when: that subscription, then: publish TestEcho}`, then
publish a tagged Note, observe the subscription match, the trigger fire,
and the derived activity appear in the outbox.
Federation, multi-actor, advanced verbs, IPFS, browser UI, operator dashboard
are **explicitly v2**.
## Non-goals (what milestone 1 deliberately does NOT do)
- **Federation.** No `POST /inbox` from peers, no `Follow`, no delivery queue, no
webfinger discovery flow. Single instance only.
- **Multi-actor.** Single domain actor (`acct:next@next.rose-ash.com`).
- **IPFS / S3 storage backends.** Files on disk only.
- **Advanced verbs.** No `Endorse`, `Supersede`, `Test`, `Build`, `Compose`,
`Note`, `Announce`. Only the four bootstrap verbs (`Create`, `Update`, `Delete`)
plus a defined-from-the-log `Pin` for the smoke test. (`Announce` deferred —
no use case until federation exists.)
- **Browser UI.** Curl-shaped API only.
- **Operator dashboard, quarantine UX.** Logs only.
- **Performance work.** Functional correctness first; perf when measured.
- **Cross-host conformance test corpus.** Only the OCaml/Erlang-on-SX host runs
fed-sx in v1; conformance suite for other hosts is v2.
## Architecture summary
```
POST /activity
┌──────────────────────────┐
│ HTTP server (Erlang-on-SX)│
└─────────────┬─────────────┘
┌─────────────▼──────────────┐
│ Validation pipeline driver │
│ (envelope→sig→schema→...) │
└─────────────┬──────────────┘
┌─────────────▼──────────────┐
│ Log append (JSONL segment) │ ← canonical
└─────────────┬──────────────┘
┌─────────────▼──────────────┐
│ Projection workers │ ← gen_server per
│ (fold scheduler) │ projection
└─────────────────────────────┘
Projection state
(queryable via HTTP)
Native primitives (Erlang-on-SX BIFs from Phase 8):
crypto:* cid:* fs:* http:* sqlite:*
Genesis bundle (binary-embedded SX):
activity-types object-types projections
validators codecs sig-suites
```
## Build order
Eight steps in dependency order. Each step has concrete deliverables, testable
in isolation, and a clear acceptance check.
| Step | Title | Depends on |
|------|-------|------------|
| **1** | Repo skeleton + canonical CID computation | Phase 8 (cid BIFs) |
| **2** | Activity envelope + signature verify | Phase 8 (crypto BIFs) |
| **3** | JSONL log + sequence numbers | Phase 8 (fs BIFs) |
| **4** | Genesis bundle (SX sources + bundling + CID verification) | Step 1 |
| **5** | Registry mechanism + bootstrap-projection dispatch | Steps 2, 4 |
| **6** | Validation pipeline driver + `POST /activity` | Steps 2, 3, 5 |
| **7** | Projection scheduler (gen_server per projection) | Steps 5, 6 |
| **8** | HTTP server, AP endpoints, projection queries | Steps 6, 7 |
| **9** | Smoke tests (Pin verb + reactive application) | Steps 1-8 |
---
## Step 1 — Repo skeleton + canonical CID
**Deliverables:**
```
next/
├── README.md # what this is
├── kernel/ # Erlang-on-SX
│ └── (empty for now)
├── genesis/ # core SX bootstrap definitions
│ └── (empty for now)
├── tests/ # smoke test scripts
│ └── (empty for now)
└── data/ # gitignored runtime state
├── log/
├── objects/
├── snapshots/
├── indexes/
└── keys/
```
Plus one Erlang-on-SX module:
```erlang
% next/kernel/cid.erl
-module(cid).
-export([from_sx/1, to_string/1, from_string/1, equals/2]).
from_sx(SxValue) ->
Cbor = cid:cbor_encode(canonicalize_sx(SxValue)),
Hash = crypto:sha2_256(Cbor),
cid:from_bytes(<<"raw">>, Hash). % defaults to dag-cbor codec
canonicalize_sx(V) -> ... % sorts dict keys, normalizes strings
```
**Tests:**
- Same SX value → same CID across multiple invocations.
- Different SX values → different CIDs.
- Whitespace/comment differences in source → identical CIDs (parsed AST identical).
- Reordered dict keys → identical CIDs (sorted-key canonicalization).
- Cross-host parity (just OCaml host for v1, but write the test so adding hosts is mechanical).
**Acceptance:** `bash next/tests/cid.sh` passes 10+ cases.
---
## Step 2 — Activity envelope + signature verify
**Deliverables:**
```erlang
% next/kernel/envelope.erl
-module(envelope).
-export([validate_shape/1, canonical_bytes/1, verify_signature/2]).
% Envelope shape per design §3.1:
% #{id, type, actor, published, to, cc, audience_extras,
% object | target | origin | result,
% capabilities_required, proofs, signature}
validate_shape(Activity) -> ok | {error, Reason}.
canonical_bytes(Activity) ->
% Strip signature, canonicalize via dag-cbor, return bytes for sig coverage
Stripped = maps:remove(signature, Activity),
cid:cbor_encode(canonicalize_for_sig(Stripped)).
verify_signature(Activity, ActorState) ->
% Time-aware: find key with id == sig.key_id that was active at published
% Per design §9.6
...
```
**Tests:**
- Envelope shape: required fields present (id, type, actor, published, signature)
- Envelope shape: type is a known activity-type or unknown-but-string
- Envelope shape: signature has key_id, algorithm, value
- Sig verify: valid RSA-SHA256 signature against published key → ok
- Sig verify: valid Ed25519 signature → ok
- Sig verify: tampered envelope → fail
- Sig verify: key superseded before activity timestamp → fail
- Sig verify: key superseded after activity timestamp → ok (historical valid)
**Acceptance:** `bash next/tests/envelope.sh` passes 15+ cases.
---
## Step 3 — JSONL log + sequence numbers
**Deliverables:**
```erlang
% next/kernel/log.erl
-module(log).
-export([open/1, append/2, read_segment/2, tip/1, replay/3]).
% Per design §15.2: per-actor outbox, segments cap ~64MB,
% format = JSONL (one canonical JSON-LD activity per line)
open(ActorId) ->
BasePath = log_path_for_actor(ActorId),
fs:mkdir_p(BasePath),
{ok, #{base => BasePath, current => current_segment(BasePath), seq => next_seq(BasePath)}}.
append(LogState, Activity) ->
Json = jsonld:encode(Activity),
Path = current_segment_path(LogState),
Line = <<Json/binary, "\n">>,
fs:append_file(Path, Line),
NewSeq = LogState#{seq := LogState.seq + 1},
rotate_if_needed(NewSeq).
% replay/3 calls Fun(Activity, Acc) for every activity in chronological order
replay(LogState, InitAcc, Fun) -> ...
```
**Tests:**
- Append + read back gives identical activity (round-trip).
- Sequence numbers monotonic and gap-free per actor.
- Segment rotation at size threshold.
- Replay visits all activities in append order across multiple segments.
- Restart preserves tip pointer (seq number resumes correctly).
- Concurrent appends (using gen_server-mediated access) are serialized correctly.
**Acceptance:** `bash next/tests/log.sh` passes 10+ cases.
---
## Step 4 — Genesis bundle
**Deliverables:**
Genesis bundle SX sources (per design §12.2). Each is a small SX file authored
by hand for the bootstrap set:
```
next/genesis/
├── manifest.sx # bundle root: lists all definitions
├── activity-types/
│ ├── create.sx # DefineActivity{name: "Create", ...}
│ ├── update.sx
│ └── delete.sx
├── object-types/
│ ├── sx-artifact.sx
│ ├── note.sx
│ ├── tombstone.sx
│ ├── define-activity.sx # DefineObject for the Define* meta types
│ ├── define-object.sx
│ ├── define-projection.sx
│ ├── define-validator.sx
│ ├── define-codec.sx
│ ├── define-sig-suite.sx
│ └── snapshot.sx
├── projections/
│ ├── activity-log.sx # identity projection
│ ├── by-type.sx
│ ├── by-actor.sx
│ ├── by-object.sx
│ ├── actor-state.sx
│ ├── define-registry.sx # the chicken-and-egg projection
│ └── audience-graph.sx
├── validators/
│ ├── envelope-shape.sx
│ ├── signature.sx
│ └── type-schema.sx
├── codecs/
│ ├── dag-cbor.sx # delegates to cid:cbor_encode/decode BIFs
│ ├── raw.sx
│ └── dag-json.sx
├── sig-suites/
│ ├── rsa-sha256-2018.sx
│ └── ed25519-2020.sx
└── audience/
├── public.sx
├── followers.sx
└── direct.sx
```
Plus a build-time bundler:
```erlang
% next/kernel/bootstrap.erl
-module(bootstrap).
-export([build_genesis/1, verify_genesis/1, load_genesis/1]).
build_genesis(SourceDir) ->
% Walk SourceDir, parse each .sx file, build a single dag-cbor bundle,
% compute its CID, write bundle.cbor + CID to data/genesis/
...
verify_genesis(BundlePath) ->
% Compute CID of the bundle as loaded; compare to expected (hardcoded
% in the kernel binary). Mismatch → halt.
...
load_genesis(BundlePath) ->
% Parse the bundle, register all definitions in the in-memory registry
...
```
**Tests:**
- All genesis SX files parse cleanly.
- Bundle CID is deterministic (rebuild same sources → same CID).
- Bundle reload reproduces the exact same registry state.
- Tampered bundle → `verify_genesis` returns `{error, cid_mismatch}`.
**Acceptance:** `bash next/tests/bootstrap.sh` passes; `next/data/genesis/bundle.cbor`
created with a known stable CID.
---
## Step 5 — Registry mechanism + bootstrap dispatch
**Deliverables:**
Registries are gen_servers, one per kind, each holding the active version map:
```erlang
% next/kernel/registry.erl
-module(registry).
-behaviour(gen_server).
-export([start_link/0, lookup/2, register/3, list/1]).
% Internal state:
% #{activity_types => #{Name => #{cid, schema_fn, semantics_fn, supersedes}},
% object_types => ...,
% projections => ...,
% validators => ...,
% codecs => ...,
% sig_suites => ...,
% ...}
lookup(Kind, Name) -> {ok, Entry} | {error, not_found}.
register(Kind, Name, Entry) -> ok | {error, Reason}.
list(Kind) -> [#{name, cid}].
```
The `define-registry` projection's fold updates this gen_server's state when
new `Define*` activities arrive. (Bootstrapping circle resolved: at startup,
`bootstrap:load_genesis/1` populates the registry directly; from then on, the
projection fold maintains it.)
**Tests:**
- After genesis load, `registry:list(activity_types)` returns Create/Update/Delete.
- `registry:lookup(activity_types, "Create")` returns the schema and semantics.
- A new `DefineActivity{name: "Pin"}` activity (synthesised, hand-signed for the
test) routes through the projection fold, ends up in the registry.
- Lookup never caches across activities (verified by introducing a new definition
mid-test and confirming the next lookup sees it).
**Acceptance:** `bash next/tests/registry.sh` passes 10+ cases.
---
## Step 6 — Validation pipeline + POST /activity
**Deliverables:**
```erlang
% next/kernel/pipeline.erl
-module(pipeline).
-export([validate_inbound/1, validate_outbound/1]).
% Per design §14, run stages in order, halt on first failure.
validate_inbound(Activity) ->
Stages = [
fun stage_envelope/1,
fun stage_signature/1,
fun stage_replay/1,
fun stage_audience/1,
fun stage_activity_schema/1,
fun stage_object_schema/1,
fun stage_content_validators/1,
fun stage_capabilities/1,
fun stage_trust/1
],
run_stages(Activity, Stages).
validate_outbound(Activity) ->
% Subset of inbound stages (no replay, no trust check; auth done at HTTP layer)
...
```
```erlang
% next/kernel/outbox.erl
-module(outbox).
-export([publish/2]).
publish(ActorId, ActivityRequest) ->
Activity = construct_envelope(ActorId, ActivityRequest),
Signed = sig:sign(Activity, ActorId),
case pipeline:validate_outbound(Signed) of
ok ->
log:append(actor_log(ActorId), Signed),
projection:async_fold(Signed),
{ok, #{cid => cid:from_sx(Signed),
ap_id => maps:get(id, Signed)}};
{error, Reason} ->
{error, Reason}
end.
```
**Tests:**
- Valid activity through full pipeline → appended to log.
- Bad envelope → 400, not in log.
- Bad signature → 401, not in log.
- Replayed activity → 200 duplicate, not re-appended.
- Schema violation (e.g. Create with no object) → 422.
- Activity logged before projection completes (async).
**Acceptance:** `bash next/tests/pipeline.sh` passes 15+ cases.
---
## Step 7 — Projection scheduler
**Deliverables:**
```erlang
% next/kernel/projection.erl
-module(projection).
-export([start_link/1, async_fold/1, query/2, snapshot/1]).
-behaviour(gen_server).
% One gen_server per active projection. State:
% #{cid, name, fold_fn, current_state, log_tip,
% snapshot_dir, last_snapshot_at}
% async_fold/1 broadcasts a new activity to every projection gen_server;
% each folds it into its own state. Failures (gas, sandbox violation)
% tag the activity but don't affect log durability.
% query/2 returns current state (or state-as-of)
% snapshot/1 forces a snapshot now (also runs periodically)
```
```erlang
% next/kernel/sandbox.erl
-module(sandbox).
-export([eval_pure/2, eval_crypto/2, eval_effectful/3]).
% eval_pure runs an SX function in pure mode: no IO platform, gas budget,
% deterministic. Used by projection folds, validators, audience predicates.
% Wrapper over the SX runtime evaluator with a stripped platform.
```
**Tests:**
- New activity → all projections fold it concurrently.
- Projection fold completes within gas budget.
- Gas-exhausting fold → activity tagged, projection state unchanged, no kernel crash.
- Sandbox violation (fold tries IO) → same handling.
- Snapshot create + reload → state matches.
- Snapshot CID stable across kernel restarts.
**Acceptance:** `bash next/tests/projection.sh` passes 15+ cases.
---
## Step 8 — HTTP server + endpoints
**Deliverables:**
Core endpoints (per design §16.1):
```
GET /actors/<id> # actor doc
GET /actors/<id>/outbox # OrderedCollection
GET /actors/<id>/outbox?page=true # OrderedCollectionPage
POST /activity # publish (auth: bearer token)
GET /artifacts/<cid> # CID-addressed artifact
GET /artifacts/<cid>/raw
GET /projections # list of projections
GET /projections/<name> # full state
GET /projections/<name>?at=<ts> # time-travel
GET /projections/<name>/<key> # indexed lookup
GET /define-registry
GET /.well-known/sx-capabilities
GET /.well-known/webfinger
```
```erlang
% next/kernel/http_server.erl
-module(http_server).
-export([start/1, route/1]).
start(Port) ->
http:listen(Port, fun ?MODULE:route/1).
route(Request) -> {Status, Headers, Body}.
```
Content negotiation per `Accept`:
- `application/activity+json` (default)
- `application/cbor` (dag-cbor)
- `application/json` (compact, no @context expansion)
- `application/sx`
Auth on `POST /activity`: bearer token from env var `NEXT_PUBLISH_TOKEN`.
**Tests:**
- Each endpoint returns expected shape for known artifact.
- Content negotiation: same artifact in 4 representations.
- 404 for unknown artifact CID.
- 401 for `POST /activity` without token.
- Pagination: outbox with > 50 activities returns OrderedCollectionPage.
**Acceptance:** `bash next/tests/http.sh` passes 20+ cases.
---
## Step 9 — Smoke tests
**The proof points.** Two end-to-end smoke tests demonstrate, between them, that
fed-sx is genuinely a substrate for distributed reactive applications expressed
as data — not a system you extend by writing kernel code.
- **9a — Pin smoke test (`next/tests/smoke_pin.sh`)** — verb extensibility:
defining a new activity type and projection at runtime via `Define*`
artifacts. Verifies the meta-level (§5).
- **9b — Reactive application smoke test (`next/tests/smoke_app.sh`)** —
application extensibility: defining a new subscription type, subscribing,
registering a trigger, and observing the full reactive loop fire end-to-end
without kernel code changes. Verifies §§18-19.
Both must pass for milestone 1 acceptance.
### Step 9a — Pin smoke test
**Test script:** `next/tests/smoke_pin.sh`
```bash
#!/usr/bin/env bash
set -euo pipefail
# 0. Start a fresh fed-sx kernel (background)
./next/scripts/start.sh fresh
sleep 2
TOKEN=$(cat next/data/keys/publish.token)
# 1. Verify actor exists
curl -s http://localhost:9999/actors/next | jq -e '.type == "Person"'
# 2. Verify outbox has actor's first Create{Person}
curl -s http://localhost:9999/actors/next/outbox?page=true \
| jq -e '.orderedItems | length == 1 and .[0].type == "Create"'
# 3. Verify Pin is NOT a known activity type
curl -s http://localhost:9999/define-registry?kind=activity_types \
| jq -e '.[] | select(.name == "Pin") | length == 0' || exit 1
# 4. Publish DefineActivity{name: "Pin", schema: ..., semantics: ...}
PIN_DEF=$(cat <<'JSON'
{
"type": "Create",
"object": {
"type": "DefineActivity",
"name": "Pin",
"schema": "(fn (act) (and (string? (-> act :object :path)) (cid? (-> act :object :cid))))",
"semantics": "(fn (state act) (assoc-in state [:pins (-> act :object :path)] (-> act :object :cid)))"
}
}
JSON
)
curl -s -X POST http://localhost:9999/activity \
-H "Authorization: Bearer $TOKEN" \
-H "Content-Type: application/activity+json" \
-d "$PIN_DEF" | jq -e '.cid' > /dev/null
# 5. Verify Pin IS now a known activity type
curl -s http://localhost:9999/define-registry?kind=activity_types \
| jq -e '.[] | select(.name == "Pin") | length == 1'
# 6. Also publish a DefineProjection{name: "pin-state"} that folds Pin into state
PIN_PROJ=$(cat <<'JSON'
{
"type": "Create",
"object": {
"type": "DefineProjection",
"name": "pin-state",
"initial-state": "{}",
"fold": "(fn (state act) (if (= (:type act) \"Pin\") (assoc state (-> act :object :path) (-> act :object :cid)) state))"
}
}
JSON
)
curl -s -X POST http://localhost:9999/activity \
-H "Authorization: Bearer $TOKEN" \
-d "$PIN_PROJ" | jq -e '.cid'
# 7. Now publish a Pin activity
PIN=$(cat <<'JSON'
{
"type": "Pin",
"object": {
"type": "PinSpec",
"path": "/docs/intro",
"cid": "bafyreigh2akiscaildc3xqxx4xqxx4xqxx4xqxx4xqxx4xqxx4xqxx4xqxxe"
}
}
JSON
)
curl -s -X POST http://localhost:9999/activity \
-H "Authorization: Bearer $TOKEN" \
-d "$PIN" | jq -e '.cid'
# 8. Verify Pin appears in outbox
curl -s http://localhost:9999/actors/next/outbox?page=true \
| jq -e '.orderedItems | map(select(.type == "Pin")) | length == 1'
# 9. Verify pin-state projection has the entry
sleep 1 # allow async projection
curl -s http://localhost:9999/projections/pin-state \
| jq -e '."/docs/intro" == "bafyreigh2akiscaildc3xqxx4xqxx4xqxx4xqxx4xqxx4xqxx4xqxx4xqxxe"'
# 10. Negative test: publish a malformed Pin (missing path) → expect 422
BAD_PIN='{"type": "Pin", "object": {"cid": "bafy..."}}'
HTTP_STATUS=$(curl -s -o /dev/null -w "%{http_code}" -X POST http://localhost:9999/activity \
-H "Authorization: Bearer $TOKEN" -d "$BAD_PIN")
[[ "$HTTP_STATUS" == "422" ]] || { echo "expected 422, got $HTTP_STATUS"; exit 1; }
# 11. Restart kernel; verify state recovers
./next/scripts/stop.sh
./next/scripts/start.sh
sleep 2
curl -s http://localhost:9999/projections/pin-state \
| jq -e '."/docs/intro" == "bafyreigh2akiscaildc3xqxx4xqxx4xqxx4xqxx4xqxx4xqxx4xqxxe"'
echo "✓ Pin smoke test passed — verb extensibility demonstrated end-to-end"
```
**Acceptance for 9a:** smoke test exits 0. The whole flow happens with **zero
fed-sx kernel code changes** between defining the verb and using it.
### Step 9b — Reactive application smoke test
**The bigger proof point.** Demonstrates that fed-sx supports distributed
reactive applications composed of `DefineSubscription` + `DefineTrigger` +
`DefineProjection` — the application model from §§18-19.
The test runs on a single instance (federation is v2), so the "subscriber" and
"publisher" are the same actor. That's intentional — milestone 1 proves the
mechanism; milestone 2 spreads it across instances.
**Test script:** `next/tests/smoke_app.sh`
```bash
#!/usr/bin/env bash
set -euo pipefail
# Assumes 9a has already run (fresh kernel optional; can run alongside).
TOKEN=$(cat next/data/keys/publish.token)
BASE=http://localhost:9999
# 1. Verify "Topic" subscription type and "Subscribe" verb are NOT yet defined.
curl -s "$BASE/define-registry?kind=subscription_types" \
| jq -e 'map(select(.name == "Topic")) | length == 0'
# 2. Publish DefineSubscription{name: "Topic", ...}
TOPIC_DEF=$(cat <<'JSON'
{
"type": "Create",
"object": {
"type": "DefineSubscription",
"name": "Topic",
"schema": "(fn (sub) (string? (-> sub :tag)))",
"match": "(fn (sub act) (and (= (:type act) \"Note\") (member? (-> sub :tag) (or (-> act :object :tags) (list)))))",
"delivery": "{:default :push :modes (list :push :pull)}"
}
}
JSON
)
curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$TOPIC_DEF" | jq -e '.cid'
# 3. Verify Topic IS now a known subscription type.
curl -s "$BASE/define-registry?kind=subscription_types" \
| jq -e 'map(select(.name == "Topic")) | length == 1'
# 4. Subscribe to the "smoketest" topic.
SUBSCRIBE=$(cat <<'JSON'
{
"type": "Subscribe",
"object": {"type": "Topic", "tag": "smoketest"}
}
JSON
)
SUB_CID=$(curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$SUBSCRIBE" | jq -r '.cid')
# 5. Verify subscriptions projection has the new entry.
sleep 1
curl -s "$BASE/projections/subscriptions" \
| jq -e '.["https://next.rose-ash.com/actors/next"] | map(select(.type == "Topic")) | length == 1'
# 6. Define a projection that records matched activities (per-application
# namespace would happen via DefineApplication in v1.x; for v1 the
# projection is global to the actor).
TOPIC_PROJ=$(cat <<'JSON'
{
"type": "Create",
"object": {
"type": "DefineProjection",
"name": "topic-events",
"initial-state": "{}",
"fold": "(fn (state act) (if (and (= (:type act) \"Note\") (member? \"smoketest\" (or (-> act :object :tags) (list)))) (assoc-in state [(:cid act)] act) state))"
}
}
JSON
)
curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$TOPIC_PROJ" | jq -e '.cid'
# 7. Define a trigger: when a Topic{smoketest} subscription matches, publish
# a TestEcho activity. We need an "Echo" activity type first.
ECHO_DEF=$(cat <<'JSON'
{
"type": "Create",
"object": {
"type": "DefineActivity",
"name": "TestEcho",
"schema": "(fn (act) (cid? (-> act :object :echoes)))",
"semantics": "(fn (state act) state)"
}
}
JSON
)
curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$ECHO_DEF" | jq -e '.cid'
TRIGGER=$(cat <<JSON
{
"type": "Create",
"object": {
"type": "DefineTrigger",
"name": "echo-on-smoketest",
"when-subscription": "$SUB_CID",
"cascade-limit": 1,
"then": "(fn (act sub env) {:publish (list {:type \"TestEcho\" :object {:echoes (:cid act)}})})"
}
}
JSON
)
curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$TRIGGER" | jq -e '.cid'
# 8. Capture outbox length so we can detect new entries.
BEFORE=$(curl -s "$BASE/actors/next/outbox?page=true" \
| jq -r '.orderedItems | length')
# 9. Publish a Note tagged "smoketest" — should match subscription, fire trigger,
# cause TestEcho to be published.
NOTE=$(cat <<'JSON'
{
"type": "Create",
"object": {
"type": "Note",
"content": "hello reactive world",
"tags": ["smoketest"]
}
}
JSON
)
NOTE_CID=$(curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$NOTE" | jq -r '.cid')
# 10. Wait for projection + trigger.
sleep 2
# 11. Verify topic-events projection captured the Note.
curl -s "$BASE/projections/topic-events" \
| jq -e ". | to_entries | length == 1"
# 12. Verify outbox grew by exactly TWO activities (the Note + the trigger's TestEcho).
AFTER=$(curl -s "$BASE/actors/next/outbox?page=true" \
| jq -r '.orderedItems | length')
[[ $((AFTER - BEFORE)) == 2 ]] || { echo "expected +2 activities, got $((AFTER - BEFORE))"; exit 1; }
# 13. Verify the latest activity is a TestEcho referencing the original Note's CID.
curl -s "$BASE/actors/next/outbox?page=true" \
| jq -e ".orderedItems[0] | .type == \"TestEcho\" and .object.echoes == \"$NOTE_CID\""
# 14. Negative case: publish a Note WITHOUT the "smoketest" tag — must NOT
# trigger, must NOT echo.
BEFORE2=$(curl -s "$BASE/actors/next/outbox?page=true" | jq -r '.orderedItems | length')
NOTE_OTHER=$(cat <<'JSON'
{"type": "Create", "object": {"type": "Note", "content": "no match", "tags": ["other"]}}
JSON
)
curl -s -X POST "$BASE/activity" \
-H "Authorization: Bearer $TOKEN" -d "$NOTE_OTHER" | jq -e '.cid'
sleep 2
AFTER2=$(curl -s "$BASE/actors/next/outbox?page=true" | jq -r '.orderedItems | length')
[[ $((AFTER2 - BEFORE2)) == 1 ]] || { echo "expected +1 activity (no echo), got $((AFTER2 - BEFORE2))"; exit 1; }
# 15. Cascade limit check: prove the trigger doesn't recursively echo TestEcho.
# The TestEcho activity itself should NOT match the Topic{smoketest}
# subscription (it's not a Note), so no cascade, but verify cascade-depth
# was set to 1 on the echo so a future trigger on TestEcho would refuse.
LATEST_ECHO=$(curl -s "$BASE/actors/next/outbox?page=true" \
| jq -r '.orderedItems | map(select(.type == "TestEcho")) | .[0]')
echo "$LATEST_ECHO" | jq -e '."cascade-depth" == 1'
# 16. Restart kernel; verify subscription, trigger, projection all survive.
./next/scripts/stop.sh
./next/scripts/start.sh
sleep 2
curl -s "$BASE/projections/subscriptions" \
| jq -e '.["https://next.rose-ash.com/actors/next"] | map(select(.type == "Topic")) | length == 1'
curl -s "$BASE/projections/topic-events" | jq -e ". | to_entries | length >= 1"
curl -s "$BASE/define-registry?kind=triggers" \
| jq -e 'map(select(.name == "echo-on-smoketest")) | length == 1'
echo "✓ Reactive application smoke test passed — Subscribe + Trigger + Projection demonstrated end-to-end"
```
**What this proves (and what it doesn't):**
Proves:
- `DefineSubscription` + `Subscribe` mechanism works end-to-end.
- Subscription's `match-fn` evaluates correctly in pure mode against inbound
activities.
- `DefineTrigger` fires on subscription matches.
- Trigger's `then-sx` can publish derived activities (the `:publish` result).
- Cascade-depth metadata propagates correctly.
- Subscription state, trigger registration, and projection state all survive
kernel restart (snapshot + log replay).
- The full reactive application loop works without any kernel code changes
between defining the components and exercising them.
Does NOT prove (deferred to milestone 2+):
- Cross-instance subscriptions (federation).
- Trigger `:effect` results calling effectful primitives.
- `DefineApplication` bundle install/update/fork.
- Per-application namespace isolation.
- Cascade prevention against malicious cascading from peer instances.
**Acceptance for 9b:** smoke test exits 0. Like 9a, **zero fed-sx kernel code
changes** between defining the application components and observing them
operate.
---
## Acceptance criteria for milestone 1
All of:
1. **Each step's test suite passes** (`bash next/tests/<step>.sh`).
2. **Both smoke tests pass** (`bash next/tests/smoke_pin.sh` and
`bash next/tests/smoke_app.sh`).
3. **Erlang-on-SX baseline preserved** — adding fed-sx kernel modules in
`next/kernel/*.erl` doesn't break Phase 1-8 conformance.
4. **Restart durability** — kill the kernel mid-write, restart, projections
resume from snapshot, no log corruption.
5. **Manual Mastodon poke** — point a Mastodon account at
`https://next.rose-ash.com/actors/next` and verify the actor doc fetches and
webfinger discovery works (read-only AP interop, no follow).
## What lands when
This is the work-order an agent (or human) follows. Steps 1-3 can be done in
parallel after the Erlang Phase 8 BIFs land. Steps 4-7 are sequential. Step 8
can start in parallel with step 7. Step 9 is the integration test.
```
Phase 7+8 (loops/erlang) ───┐
┌─── Step 1 ──┬─── Step 2 ──┬─── Step 3
│ │ │
└─────────────┼─── Step 4 ──┴────┐
│ │
└─── Step 5 ───────┤
Step 6 ─────┤
Step 7 ─────┤
Step 8 ─────┤
Step 9 ─────┘
```
Estimated effort if done by a focused agent loop, one feature per iteration:
~30-50 commits across all 9 steps. Could plausibly be a `loops/fed-sx` workstream
once Phase 7+8 are done.
## What's deferred to milestone 2
- **Federation** (the second-biggest piece). `POST /inbox`, Follow lifecycle,
delivery queue, backfill, capability negotiation between peers. Whole of
design §13.
- **Multi-actor** with per-user OAuth and capability tokens. Design §9.5.
- **IPFS storage backend** as a `DefineStorage` entry. Design §15.3.
- **Browser client + operator dashboard** (probably in Elm-on-SX or similar).
- **Rich verbs**: `Endorse`, `Supersede`, `Test`, `Build`, `Compose`, `Note`,
`Announce`. All defined as `DefineActivity` artifacts, federated.
- **Cross-host conformance** — Python/JS/Haskell hosts running fed-sx. Design
§11.8.
- **OpenTimestamps proofs** as a `DefineProof` entry.
- **Performance work** — JIT-compiled folds, snapshot acceleration, federation
batching.
Milestone 2 unlocks "real federation between two fed-sx instances." Milestone 3
is the rose-ash port (blog, market, events, federation, account, orders) as
fed-sx applications.
---
## Appendix A: open questions for milestone 1
A few things still under-specified; resolve as work begins.
1. **HTTP server library.** Does the Phase 8 `http:listen/2` BIF wrap an
existing OCaml HTTP server (the sx.rose-ash.com one) or something simpler?
Implementation choice deferred to Phase 8.
2. **JSON-LD library.** AP wire format requires JSON-LD canonicalization for
signature coverage. Either pull a library or write a minimal subset for the
shapes we actually use. Probably the latter — our envelope is well-defined.
3. **Bearer token rotation.** v1 uses a single env-var token. Token rotation
without restart needs registry-style mgmt; can wait.
4. **Snapshot rate limits.** Default in design is "every 1000 activities or
60 seconds." Tunable per-projection later; v1 uses the default.
5. **Genesis bundle format.** Dag-cbor map per §12.2; concrete schema needs
one round of refinement once we author the actual definitions in step 4.