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.
This commit is contained in:
@@ -1469,7 +1469,56 @@ let run_foundation_tests () =
|
|||||||
Printf.printf " FAIL: duplicate extension name should have raised\n"
|
Printf.printf " FAIL: duplicate extension name should have raised\n"
|
||||||
with Failure _ ->
|
with Failure _ ->
|
||||||
incr pass_count;
|
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")
|
||||||
|
|
||||||
|
|
||||||
(* ====================================================================== *)
|
(* ====================================================================== *)
|
||||||
|
|||||||
@@ -87,3 +87,22 @@ let install_dispatch () =
|
|||||||
Sx_vm.extension_dispatch_ref := dispatch
|
Sx_vm.extension_dispatch_ref := dispatch
|
||||||
|
|
||||||
let () = install_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"))
|
||||||
|
|||||||
@@ -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
|
Does not require any extension to actually exist — the primitive returns
|
||||||
`nil` for unknown names, and the compiler falls back.
|
`nil` for unknown names, and the compiler falls back.
|
||||||
|
|
||||||
- [ ] Register `extension-opcode-id` in `sx_primitives.ml`.
|
- [x] Register `extension-opcode-id` in `sx_primitives.ml`.
|
||||||
- [ ] Returns `Integer id` when registered, `Nil` otherwise.
|
- [x] Returns `Integer id` when registered, `Nil` otherwise.
|
||||||
|
|
||||||
**Tests:**
|
**Tests:**
|
||||||
- Primitive returns nil for unknown name.
|
- Primitive returns nil for unknown name.
|
||||||
@@ -457,6 +457,20 @@ familiarity.
|
|||||||
|
|
||||||
Newest first.
|
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`
|
- **2026-05-14** — Phase B done. Added `hosts/ocaml/lib/sx_vm_extension.ml`
|
||||||
(interface: `handler` type, `extension_state` extensible variant,
|
(interface: `handler` type, `extension_state` extensible variant,
|
||||||
`EXTENSION` module type) and `sx_vm_extensions.ml` (registry: `register`,
|
`EXTENSION` module type) and `sx_vm_extensions.ml` (registry: `register`,
|
||||||
|
|||||||
Reference in New Issue
Block a user