(** {1 [test_ext] — canonical example VM extension}

    A minimal extension demonstrating the registration pattern from
    [plans/sx-vm-opcode-extension.md].  The opcode IDs (220, 221) sit at
    the top of the extension range, well clear of anything a real
    language port would claim.

    Two operand-less opcodes:

    - [test_ext.OP_TEST_PUSH_42] (220) — pushes the integer 42.
    - [test_ext.OP_TEST_DOUBLE_TOS] (221) — pops the integer on TOS,
      pushes 2× it.

    These are the smallest stack manipulations that prove the extension
    mechanism wires through end-to-end (registry → dispatch → human-
    readable disassembly).  Real ports (Erlang Phase 9, future Haskell
    perf phases) replace this template with their own opcode set.

    Loading: [Test_ext.register ()] adds the extension to
    [Sx_vm_extensions].  Run-time binaries that want the test opcodes
    available call this once at startup.  Unit tests in
    [bin/run_tests.ml] do exactly that. *)

open Sx_types

(** Per-instance state for [test_ext].  Counts how many times the
    handlers ran — purely so the extension has *some* state, exercising
    the [extension_state] machinery. *)
type Sx_vm_extension.extension_state += TestExtState of {
  mutable invocations : int;
}

module M : Sx_vm_extension.EXTENSION = struct
  let name = "test_ext"
  let init () = TestExtState { invocations = 0 }

  let opcodes st =
    let bump () = match st with
      | TestExtState s -> s.invocations <- s.invocations + 1
      | _ -> ()
    in
    [
      (220, "test_ext.OP_TEST_PUSH_42",
       (fun vm _frame -> bump (); Sx_vm.push vm (Integer 42)));

      (221, "test_ext.OP_TEST_DOUBLE_TOS",
       (fun vm _frame ->
         bump ();
         let v = Sx_vm.pop vm in
         match v with
         | Integer n -> Sx_vm.push vm (Integer (n * 2))
         | _ -> raise (Eval_error
             "test_ext.OP_TEST_DOUBLE_TOS: TOS is not an integer")));
    ]
end

(** Register [test_ext] in [Sx_vm_extensions].  Idempotent only by
    failing loudly — calling twice raises [Failure].  Binaries call this
    once at startup; tests may [_reset_for_tests] then re-register. *)
let register () = Sx_vm_extensions.register (module M : Sx_vm_extension.EXTENSION)

(** Read the invocation counter from the live registry state.  Returns
    [None] if [register] hasn't been called yet. *)
let invocation_count () =
  match Sx_vm_extensions.state_of_extension "test_ext" with
  | Some (TestExtState s) -> Some s.invocations
  | _ -> None