erlang: Phase 10b slice — real OP_BIF_LENGTH handler, end-to-end VM proof

hosts/ocaml/bin/run_tests.ml

@@ -1631,14 +1631,51 @@ let run_foundation_tests () =
      Printf.printf "  FAIL: unknown erlang opcode: got %s\n"
        (Sx_types.inspect other));
 
-  (* Dispatching an erlang opcode raises the not-wired Eval_error
+  (* Phase 10b vertical slice: erlang.OP_BIF_LENGTH (230) is a REAL
-     (bytecode emission is a later phase; SX stub dispatcher is the
+     handler. Build [CONST 0; OP_BIF_LENGTH; RETURN] with an Erlang
-     working path). 230 = erlang.OP_BIF_LENGTH. *)
+     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));
+
+  (* A still-stubbed opcode (231 = erlang.OP_BIF_HD) 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 [| 230; 50 |]) globals);
+     ignore (Sx_vm.execute_module (make_bc_seq [| 231; 50 |]) globals);
      incr fail_count;
-     Printf.printf "  FAIL: erlang.OP_BIF_LENGTH dispatch should have raised\n"
+     Printf.printf "  FAIL: erlang.OP_BIF_HD dispatch should have raised\n"
    with
    | Sx_types.Eval_error msg
      when (let needle = "not yet wired" in

hosts/ocaml/lib/extensions/erlang_ext.ml

@@ -64,6 +64,41 @@ module M : Sx_vm_extension.EXTENSION = struct
       (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
     [
       op 222 "erlang.OP_PATTERN_TUPLE";
       op 223 "erlang.OP_PATTERN_LIST";
@@ -73,7 +108,7 @@ module M : Sx_vm_extension.EXTENSION = struct
       op 227 "erlang.OP_RECEIVE_SCAN";
       op 228 "erlang.OP_SPAWN";
       op 229 "erlang.OP_SEND";
-      op 230 "erlang.OP_BIF_LENGTH";
+      op_bif_length;
       op 231 "erlang.OP_BIF_HD";
       op 232 "erlang.OP_BIF_TL";
       op 233 "erlang.OP_BIF_ELEMENT";