coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

erlang: Phase 10b — 7 more real hot-BIF handlers (HD/TL/TUPLE_SIZE/IS_*), +9 e2e tests

Browse Source
This commit is contained in:
giles
2026-05-15 08:51:01 +00:00
parent e6261c2519
commit 708b5a2b12
2 changed files with 168 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
hosts/ocaml/lib/extensions/erlang_ext.ml
View File

@@ -99,6 +99,84 @@ module M : Sx_vm_extension.EXTENSION = struct
in
Sx_vm.push vm (Integer (walk 0 v))))
in
(* Phase 10b — simple hot-BIF handlers. Erlang bool is the atom
{"tag"->"atom"; "name"->"true"|"false"}; mk_atom builds it. *)
let mk_atom nm =
let h = Hashtbl.create 2 in
Hashtbl.replace h "tag" (String "atom");
Hashtbl.replace h "name" (String nm);
Dict h
in
let er_bool b = mk_atom (if b then "true" else "false") in
let is_tag v t = match v with
| Dict d -> er_tag d = t
| _ -> false
in
let op_bif_hd =
(231, "erlang.OP_BIF_HD",
(fun (vm : Sx_vm.vm) _f ->
bump ();
match Sx_vm.pop vm with
| Dict d when er_tag d = "cons" ->
(match Hashtbl.find_opt d "head" with
| Some h -> Sx_vm.push vm h
| None -> raise (Eval_error "erlang.OP_BIF_HD: cons without :head"))
| _ -> raise (Eval_error "erlang.OP_BIF_HD: not a cons")))
in
let op_bif_tl =
(232, "erlang.OP_BIF_TL",
(fun (vm : Sx_vm.vm) _f ->
bump ();
match Sx_vm.pop vm with
| Dict d when er_tag d = "cons" ->
(match Hashtbl.find_opt d "tail" with
| Some t -> Sx_vm.push vm t
| None -> raise (Eval_error "erlang.OP_BIF_TL: cons without :tail"))
| _ -> raise (Eval_error "erlang.OP_BIF_TL: not a cons")))
in
let op_bif_tuple_size =
(234, "erlang.OP_BIF_TUPLE_SIZE",
(fun (vm : Sx_vm.vm) _f ->
bump ();
match Sx_vm.pop vm with
| Dict d when er_tag d = "tuple" ->
let n = match Hashtbl.find_opt d "elements" with
| Some (List es) -> List.length es
| Some (ListRef r) -> List.length !r
| _ -> raise (Eval_error
"erlang.OP_BIF_TUPLE_SIZE: tuple without :elements")
in
Sx_vm.push vm (Integer n)
| _ -> raise (Eval_error "erlang.OP_BIF_TUPLE_SIZE: not a tuple")))
in
let op_bif_is_integer =
(236, "erlang.OP_BIF_IS_INTEGER",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (match v with Integer _ -> true | _ -> false))))
in
let op_bif_is_atom =
(237, "erlang.OP_BIF_IS_ATOM",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (is_tag v "atom"))))
in
let op_bif_is_list =
(238, "erlang.OP_BIF_IS_LIST",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (is_tag v "cons" || is_tag v "nil"))))
in
let op_bif_is_tuple =
(239, "erlang.OP_BIF_IS_TUPLE",
(fun (vm : Sx_vm.vm) _f ->
bump ();
let v = Sx_vm.pop vm in
Sx_vm.push vm (er_bool (is_tag v "tuple"))))
in
[
op 222 "erlang.OP_PATTERN_TUPLE";
op 223 "erlang.OP_PATTERN_LIST";
@@ -109,15 +187,15 @@ module M : Sx_vm_extension.EXTENSION = struct
op 228 "erlang.OP_SPAWN";
op 229 "erlang.OP_SEND";
op_bif_length;
op 231 "erlang.OP_BIF_HD";
op 232 "erlang.OP_BIF_TL";
op_bif_hd;
op_bif_tl;
op 233 "erlang.OP_BIF_ELEMENT";
op 234 "erlang.OP_BIF_TUPLE_SIZE";
op_bif_tuple_size;
op 235 "erlang.OP_BIF_LISTS_REVERSE";
op 236 "erlang.OP_BIF_IS_INTEGER";
op 237 "erlang.OP_BIF_IS_ATOM";
op 238 "erlang.OP_BIF_IS_LIST";
op 239 "erlang.OP_BIF_IS_TUPLE";
op_bif_is_integer;
op_bif_is_atom;
op_bif_is_list;
op_bif_is_tuple;
]
end