From 58d74455596e2b6836f391b0580327368fa23ae5 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Fri, 15 May 2026 00:16:03 +0000
Subject: [PATCH] =?UTF-8?q?vm-ext:=20phase=20C=20=E2=80=94=20extension-opc?=
 =?UTF-8?q?ode-id=20SX=20primitive?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.
---
 hosts/ocaml/bin/run_tests.ml        | 51 ++++++++++++++++++++++++++++-
 hosts/ocaml/lib/sx_vm_extensions.ml | 19 +++++++++++
 2 files changed, 69 insertions(+), 1 deletion(-)

diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml
index b08eadd5..4995b507 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"))