diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index d12b0d85..b6cc381c 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1469,7 +1469,56 @@ let run_foundation_tests () = Printf.printf " FAIL: duplicate extension name should have raised\n" with Failure _ -> incr pass_count; - Printf.printf " PASS: duplicate extension name rejected\n") + Printf.printf " PASS: duplicate extension name rejected\n"); + + Printf.printf "\nSuite: extension-opcode-id primitive\n"; + let prim = Hashtbl.find Sx_primitives.primitives "extension-opcode-id" in + + (* Known opcode (registered by TestExt above). *) + (match prim [String "test_reg.OP_PUSH_42"] with + | Integer 210 -> + incr pass_count; + Printf.printf " PASS: primitive returns Integer for registered opcode\n" + | other -> + incr fail_count; + Printf.printf " FAIL: registered opcode lookup: got %s\n" + (Sx_types.inspect other)); + + (* Unknown opcode → Nil. *) + (match prim [String "nonexistent.OP_X"] with + | Nil -> + incr pass_count; + Printf.printf " PASS: primitive returns nil for unknown opcode\n" + | other -> + incr fail_count; + Printf.printf " FAIL: unknown opcode lookup: got %s\n" + (Sx_types.inspect other)); + + (* Symbol arg also accepted (compilers may pass quoted symbols). *) + (match prim [Symbol "test_reg.OP_DOUBLE_TOS"] with + | Integer 211 -> + incr pass_count; + Printf.printf " PASS: primitive accepts Symbol args\n" + | other -> + incr fail_count; + Printf.printf " FAIL: symbol arg: got %s\n" (Sx_types.inspect other)); + + (* Wrong arity / type raises Eval_error. *) + (try + let _ = prim [] in + incr fail_count; + Printf.printf " FAIL: zero args should have raised\n" + with Sx_types.Eval_error _ -> + incr pass_count; + Printf.printf " PASS: zero args rejected\n"); + + (try + let _ = prim [Integer 42] in + incr fail_count; + Printf.printf " FAIL: integer arg should have raised\n" + with Sx_types.Eval_error _ -> + incr pass_count; + Printf.printf " PASS: integer arg rejected\n") (* ====================================================================== *) diff --git a/hosts/ocaml/lib/sx_vm_extensions.ml b/hosts/ocaml/lib/sx_vm_extensions.ml index 8e1dd288..e301b57c 100644 --- a/hosts/ocaml/lib/sx_vm_extensions.ml +++ b/hosts/ocaml/lib/sx_vm_extensions.ml @@ -87,3 +87,22 @@ let install_dispatch () = Sx_vm.extension_dispatch_ref := dispatch let () = install_dispatch () + +(** Compiler-side opcode lookup: register the [extension-opcode-id] + primitive. Compilers ([lib/compiler.sx]) call this to emit + extension opcodes by name. Returns [Integer id] when registered, + [Nil] otherwise — so missing extensions degrade to a fallback + rather than failure. *) +let () = + Sx_primitives.register "extension-opcode-id" (fun args -> + match args with + | [Sx_types.String name] -> + (match id_of_name name with + | Some id -> Sx_types.Integer id + | None -> Sx_types.Nil) + | [Sx_types.Symbol name] -> + (match id_of_name name with + | Some id -> Sx_types.Integer id + | None -> Sx_types.Nil) + | _ -> raise (Sx_types.Eval_error + "extension-opcode-id: expected one string or symbol")) diff --git a/plans/sx-vm-opcode-extension.md b/plans/sx-vm-opcode-extension.md index 0eb1de91..1515bb34 100644 --- a/plans/sx-vm-opcode-extension.md +++ b/plans/sx-vm-opcode-extension.md @@ -279,8 +279,8 @@ compiler in `lib/compiler.sx` can call it to emit extension opcodes by name. Does not require any extension to actually exist — the primitive returns `nil` for unknown names, and the compiler falls back. -- [ ] Register `extension-opcode-id` in `sx_primitives.ml`. -- [ ] Returns `Integer id` when registered, `Nil` otherwise. +- [x] Register `extension-opcode-id` in `sx_primitives.ml`. +- [x] Returns `Integer id` when registered, `Nil` otherwise. **Tests:** - Primitive returns nil for unknown name. @@ -457,6 +457,20 @@ familiarity. Newest first. +- **2026-05-15** — Phase C done. `extension-opcode-id` SX primitive + registered from `sx_vm_extensions.ml` module init (avoids the + `sx_primitives ↔ sx_vm` cycle by registering downstream of both). + Accepts a string or symbol; returns `Integer id` for registered + opcode names, `Nil` for unknown — so a missing extension at compile + time degrades to a fallback rather than failure. 5 new foundation + tests (`extension-opcode-id primitive` suite): registered lookup, + unknown → nil, symbol arg, zero-arg rejection, integer-arg + rejection. +5 pass vs Phase B baseline (4821 vs 4816), 1111 + pre-existing failures unchanged. Conformance suites green: erlang + 530/530, haskell 285/285, datalog 276/276, prolog 590/590, smalltalk + 847/847, common-lisp 487/487, apl 562/562, js 148/148, forth 632/638 + (pre-existing), tcl 3/4 (pre-existing), ocaml-on-sx unit 607/607. + - **2026-05-14** — Phase B done. Added `hosts/ocaml/lib/sx_vm_extension.ml` (interface: `handler` type, `extension_state` extensible variant, `EXTENSION` module type) and `sx_vm_extensions.ml` (registry: `register`,