From 9dbea76dd546dc8a2644bf2c1da47eac01b247f4 Mon Sep 17 00:00:00 2001 From: Bikal Gurung Date: Wed, 11 Feb 2026 19:20:50 +0000 Subject: [PATCH] Fix externref trait-object cast path for wasm-gc Fixes moonbitlang/moonbit-docs#1123. The wasm-gc backend was emitting invalid cast sequences when trait-object conversion involved #external values across supertrait chains. This change adds a Pidentity lowering path in clam_of_core and tightens Pcast lowering to avoid redundant casts and preserve source/target type intent. In wasm_of_clam_gc, Lcast now handles Ref_extern<->Ref_any with the dedicated conversion ops (Extern_convert_any / Any_convert_extern) instead of generic ref_cast where needed. --- src/clam_of_core.ml | 16 +++++++++++++++- src/wasm_of_clam_gc.ml | 19 ++++++++++++++++--- 2 files changed, 31 insertions(+), 4 deletions(-) diff --git a/src/clam_of_core.ml b/src/clam_of_core.ml index f8a1ff5..3eb41cf 100644 --- a/src/clam_of_core.ml +++ b/src/clam_of_core.ml @@ -250,14 +250,28 @@ let rec transl_expr ~name_hint ~mtype_defs ~addr_tbl ~type_defs ~object_methods | Ref _ | Ref_lazy_init _ | Ref_nullable _ | Ref_extern | Ref_string | Ref_bytes | Ref_func | Ref_any -> Prefeq) + | Pidentity -> ( + match[@warning "-fragile-match"] args with + | arg :: [] -> + let source_type = transl_type (Mcore.type_of_expr arg) in + let target_type = transl_type ty in + if Ltype.equal source_type target_type then go arg + else + bind arg (fun source -> + Lcast { expr = Lvar { var = source }; target_type }) + | _ -> assert false) | Pcast { kind } -> ( match[@warning "-fragile-match"] args with | arg :: [] -> ( match kind with | Constr_to_enum | Make_newtype -> go arg | Unfold_rec_newtype | Enum_to_constr -> + let source_type = transl_type (Mcore.type_of_expr arg) in let target_type = transl_type ty in - Lcast { expr = go arg; target_type }) + if Ltype.equal source_type target_type then go arg + else + bind arg (fun source -> + Lcast { expr = Lvar { var = source }; target_type })) | _ -> assert false) | Penum_field { index; tag = _ } -> ( let tid = diff --git a/src/wasm_of_clam_gc.ml b/src/wasm_of_clam_gc.ml index 125b8ff..e2db46b 100644 --- a/src/wasm_of_clam_gc.ml +++ b/src/wasm_of_clam_gc.ml @@ -95,6 +95,12 @@ let addr_to_string = Basic_fn_address.to_wasm_name let add_cst = Wasmir_util.add_cst let add_dummy_i32 rest = add_cst 0 rest +let cast_operand_type (e : Clam.lambda) = + match Clam_util.no_located e with + | Lvar { var } -> Some (Ident.get_type var) + | Lcast { target_type; _ } -> Some target_type + | _ -> None + type loop_info = { params : Ident.t list; break_used : bool ref } type ctx = { @@ -574,9 +580,16 @@ and compileExpr0 ~(tail : bool) ~ctx ~global_ctx ~type_defs (body : Clam.lambda) let tid_base = tid in generic_get var @> struct_get tid_base 0 @: generic_get var @> call closure_ffi_name @: rest - | Lcast { expr; target_type = Ref_any } -> got expr rest - | Lcast { expr; target_type } -> - gon expr (ref_cast (result target_type) @: rest) + | Lcast { expr; target_type = Ref_any } -> ( + match cast_operand_type expr with + | Some Ref_extern -> gon expr (Ast.Extern_convert_any @: rest) + | _ -> got expr rest) + | Lcast { expr; target_type = Ref_extern } -> ( + match cast_operand_type expr with + | Some Ref_any -> gon expr (Ast.Any_convert_extern @: rest) + | _ -> gon expr (ref_cast (result Ref_extern) @: rest)) + | Lcast { expr; target_type } -> + gon expr (ref_cast (result target_type) @: rest) | Lcatch { body; on_exception; type_ } -> assert !Basic_config.test_mode; let body = gon body [] in