diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 031f1b40525..cb11991fd93 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -1066,12 +1066,19 @@ let check_concrete params thing = else bug () "unhandled parametric binding" ;; +let rec simplified_ty (t:Ast.ty) : Ast.ty = + match t with + Ast.TY_exterior t + | Ast.TY_mutable t + | Ast.TY_constrained (t, _) -> simplified_ty t + | _ -> t +;; let project_type (base_ty:Ast.ty) (comp:Ast.lval_component) : Ast.ty = - match (base_ty, comp) with + match (simplified_ty base_ty, comp) with (Ast.TY_rec elts, Ast.COMP_named (Ast.COMP_ident id)) -> begin match atab_search elts id with diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index e409602a69e..e33e3ed4f11 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -1887,12 +1887,12 @@ let trans_visitor in match expr with Ast.EXPR_binary (binop, a, b) -> - assert (is_prim_type (atom_type cx a)); - assert (is_prim_type (atom_type cx b)); + assert (is_prim_type (simplified_ty (atom_type cx a))); + assert (is_prim_type (simplified_ty (atom_type cx b))); trans_binary binop (trans_atom a) (trans_atom b) | Ast.EXPR_unary (unop, a) -> - assert (is_prim_type (atom_type cx a)); + assert (is_prim_type (simplified_ty (atom_type cx a))); let src = trans_atom a in let bits = Il.operand_bits word_bits src in let dst = Il.Reg (Il.next_vreg (emitter()), Il.ValTy bits) in @@ -2218,13 +2218,6 @@ let trans_visitor and exterior_rc_cell (cell:Il.cell) : Il.cell = exterior_ctrl_cell cell Abi.exterior_rc_slot_field_refcnt - and simplified_ty t = - match t with - Ast.TY_exterior t - | Ast.TY_mutable t - | Ast.TY_constrained (t, _) -> simplified_ty t - | _ -> t - and exterior_allocation_size (ty:Ast.ty) : Il.operand = @@ -4074,7 +4067,7 @@ let trans_visitor and trans_log id a = - match atom_type cx a with + match simplified_ty (atom_type cx a) with (* NB: If you extend this, be sure to update the * typechecking code in type.ml as well. *) Ast.TY_str -> trans_log_str a