Revert "Add typing hack (for testing only)"

This reverts commit 7dd2282.

Author: Ekdohibs

ocaml/lambda/translprim.ml

@@ -94,7 +94,6 @@ type prim =
   | Identity
   | Apply of Lambda.region_close * Lambda.layout
   | Revapply of Lambda.region_close * Lambda.layout
-  | Void
 
 let units_with_used_primitives = Hashtbl.create 7
 let add_used_primitive loc env path =
@@ -141,14 +140,6 @@ let to_modify_mode ~poly = function
     | None -> assert false
     | Some mode -> transl_modify_mode mode
 
-let layout_unboxed_pair_of_values =
-  Punboxed_product [Pvalue Pgenval; Pvalue Pgenval]
-
-let two_unboxed_pairs_of_values =
-  [ layout_unboxed_pair_of_values;
-    layout_unboxed_pair_of_values;
-  ]
-
 let lookup_primitive loc poly pos p =
   let mode = to_locality ~poly p.prim_native_repr_res in
   let arg_modes = List.map (to_modify_mode ~poly) p.prim_native_repr_args in
@@ -428,40 +419,6 @@ let lookup_primitive loc poly pos p =
     | "%unbox_float" -> Primitive(Punbox_float, 1)
     | "%box_float" -> Primitive(Pbox_float mode, 1)
     | "%get_header" -> Primitive (Pget_header mode, 1)
-    (* unboxed pairs of void *)
-    | "%make_unboxed_pair_o_o" ->
-      Primitive(Pmake_unboxed_product [Punboxed_product []; Punboxed_product []], 2)
-    | "%unboxed_pair_field_0_o_o" ->
-      Primitive(Punboxed_product_field (0, [Punboxed_product []; Punboxed_product []]), 1)
-    | "%unboxed_pair_field_1_o_o" ->
-      Primitive(Punboxed_product_field (1, [Punboxed_product []; Punboxed_product []]), 1)
-    (* unboxed pairs of values *)
-    | "%make_unboxed_pair_v_v" ->
-      Primitive(Pmake_unboxed_product [Pvalue Pgenval; Pvalue Pgenval], 2)
-    | "%unboxed_pair_field_0_v_v" ->
-      Primitive(Punboxed_product_field (0, [Pvalue Pgenval; Pvalue Pgenval]), 1)
-    | "%unboxed_pair_field_1_v_v" ->
-      Primitive(Punboxed_product_field (1, [Pvalue Pgenval; Pvalue Pgenval]), 1)
-    (* unboxed pairs of immediates *)
-    | "%make_unboxed_pair_i_i" ->
-      Primitive(Pmake_unboxed_product [Pvalue Pintval; Pvalue Pintval], 2)
-    | "%unboxed_pair_field_0_i_i" ->
-      Primitive(Punboxed_product_field (0, [Pvalue Pintval; Pvalue Pintval]), 1)
-    | "%unboxed_pair_field_1_i_i" ->
-      Primitive(Punboxed_product_field (1, [Pvalue Pintval; Pvalue Pintval]), 1)
-    (* unboxed pairs of (unboxed pairs of values) *)
-    | "%make_unboxed_pair_vup_vup" ->
-      Primitive(Pmake_unboxed_product [layout_unboxed_pair_of_values; layout_unboxed_pair_of_values], 2)
-    | "%unboxed_pair_field_0_vup_vup" ->
-      Primitive(Punboxed_product_field (0, two_unboxed_pairs_of_values), 1)
-    | "%unboxed_pair_field_1_vup_vup" ->
-      Primitive(Punboxed_product_field (1, two_unboxed_pairs_of_values), 1)
-    (* unboxed triples (void, int, void) *)
-    | "%make_unboxed_triple_o_i_o" ->
-      Primitive(Pmake_unboxed_product [Punboxed_product []; Pvalue Pintval; Punboxed_product []], 3)
-    (* void is special as the external is declared to have one parameter
-       but the primitive takes zero arguments *)
-    | "%void" -> Void
     | s when String.length s > 0 && s.[0] = '%' ->
        raise(Error(loc, Unknown_builtin_primitive s))
     | _ -> External p
@@ -889,7 +846,6 @@ let lambda_of_prim prim_name prim loc args arg_exps =
         ap_region_close = pos;
         ap_mode = alloc_heap;
       }
-  | Void, _ -> Lprim (Pmake_unboxed_product [], [], loc)
   | (Raise _ | Raise_with_backtrace
     | Lazy_force _ | Loc _ | Primitive _ | Sys_argv | Comparison _
     | Send _ | Send_self _ | Send_cache _ | Frame_pointers | Identity
@@ -918,7 +874,6 @@ let check_primitive_arity loc p =
     | Frame_pointers -> p.prim_arity = 0
     | Identity -> p.prim_arity = 1
     | Apply _ | Revapply _ -> p.prim_arity = 2
-    | Void -> true
   in
   if not ok then raise(Error(loc, Wrong_arity_builtin_primitive p.prim_name))
 
@@ -1040,7 +995,7 @@ let primitive_needs_event_after = function
       lambda_primitive_needs_event_after (comparison_primitive comp knd)
   | Lazy_force _ | Send _ | Send_self _ | Send_cache _
   | Apply _ | Revapply _ -> true
-  | Raise _ | Raise_with_backtrace | Loc _ | Frame_pointers | Identity | Void -> false
+  | Raise _ | Raise_with_backtrace | Loc _ | Frame_pointers | Identity -> false
 
 let transl_primitive_application loc p env ty mode path exp args arg_exps pos =
   let prim =

ocaml/typing/predef.ml

@@ -56,10 +56,6 @@ and ident_int64x2 = ident_create "int64x2"
 and ident_float32x4 = ident_create "float32x4"
 and ident_float64x2 = ident_create "float64x2"
 
-and ident_unboxed_pair = ident_create "unboxed_pair"
-and ident_unboxed_triple = ident_create "unboxed_triple"
-and ident_real_void = ident_create "void"
-
 let path_int = Pident ident_int
 and path_char = Pident ident_char
 and path_bytes = Pident ident_bytes
@@ -87,10 +83,6 @@ and path_int64x2 = Pident ident_int64x2
 and path_float32x4 = Pident ident_float32x4
 and path_float64x2 = Pident ident_float64x2
 
-and path_unboxed_pair = Pident ident_unboxed_pair
-and path_unboxed_triple = Pident ident_unboxed_triple
-and path_void = Pident ident_real_void
-
 let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
 and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
 and type_bytes = newgenty (Tconstr(path_bytes, [], ref Mnil))
@@ -222,55 +214,6 @@ let common_initial_env add_type add_extension empty_env =
       }
     in
     add_type type_ident decl env
-  and add_type2 type_ident
-      ?(kind=fun _ -> Type_abstract)
-      ?(layout=Layout.value ~why:(Primitive type_ident))
-      ~variance ~separability env =
-    let param0 = newgenvar (Layout.value ~why:Type_argument) in
-    let param1 = newgenvar (Layout.value ~why:Type_argument) in
-    let decl =
-      {type_params = [param0; param1];
-       type_arity = 2;
-       type_kind = kind param0;
-       type_layout = layout;
-       type_loc = Location.none;
-       type_private = Asttypes.Public;
-       type_manifest = None;
-       type_variance = [variance; variance];
-       type_separability = [separability; separability];
-       type_is_newtype = false;
-       type_expansion_scope = lowest_level;
-       type_attributes = [];
-       type_unboxed_default = false;
-       type_uid = Uid.of_predef_id type_ident;
-      }
-    in
-    add_type type_ident decl env
-  and add_type3 type_ident
-      ?(kind=fun _ -> Type_abstract)
-      ?(layout=Layout.value ~why:(Primitive type_ident))
-      ~variance ~separability env =
-    let param0 = newgenvar (Layout.value ~why:Type_argument) in
-    let param1 = newgenvar (Layout.value ~why:Type_argument) in
-    let param2 = newgenvar (Layout.value ~why:Type_argument) in
-    let decl =
-      {type_params = [param0; param1; param2];
-       type_arity = 3;
-       type_kind = kind param0;
-       type_layout = layout;
-       type_loc = Location.none;
-       type_private = Asttypes.Public;
-       type_manifest = None;
-       type_variance = [variance; variance; variance];
-       type_separability = [separability; separability; separability];
-       type_is_newtype = false;
-       type_expansion_scope = lowest_level;
-       type_attributes = [];
-       type_unboxed_default = false;
-       type_uid = Uid.of_predef_id type_ident;
-      }
-    in
-    add_type type_ident decl env
   in
   let add_extension id args layouts =
     add_extension id
@@ -338,13 +281,6 @@ let common_initial_env add_type add_extension empty_env =
   |> add_type ident_unit
        ~kind:(variant [cstr ident_void []] [| [| |] |])
        ~layout:(Layout.immediate ~why:Enumeration)
-  |> add_type2 ident_unboxed_pair
-    ~variance:Variance.covariant
-    ~separability:Separability.Ind
-  |> add_type3 ident_unboxed_triple
-    ~variance:Variance.covariant
-    ~separability:Separability.Ind
-  |> add_type ident_real_void
   (* Predefined exceptions - alphabetical order *)
   |> add_extension ident_assert_failure
        [newgenty (Ttuple[type_string; type_int; type_int])]

ocaml/typing/predef.mli

@@ -71,10 +71,6 @@ val path_int64x2: Path.t
 val path_float32x4: Path.t
 val path_float64x2: Path.t
 
-val path_unboxed_pair: Path.t
-val path_unboxed_triple: Path.t
-val path_void: Path.t
-
 val path_match_failure: Path.t
 val path_invalid_argument: Path.t
 val path_assert_failure : Path.t

ocaml/typing/typeopt.ml

@@ -553,25 +553,13 @@ let value_kind env loc ty =
   with
   | Missing_cmi_fallback -> raise (Error (loc, Non_value_layout (ty, None)))
 
-let rec layout env loc sort ty =
+let layout env loc sort ty =
   match Layouts.Sort.get_default_value sort with
+  | Value -> Lambda.Pvalue (value_kind env loc ty)
   | Float64 when Language_extension.(is_at_least Layouts Alpha) ->
       Lambda.Punboxed_float
   | Float64 -> raise (Error (loc, Non_value_sort (Sort.float64,ty)))
   | Void -> raise (Error (loc, Non_value_sort (Sort.void,ty)))
-  | Value ->
-      match get_desc (scrape_ty env ty) with
-      | Tconstr(p, args, _) when Path.same p Predef.path_unboxed_pair ->
-          let layouts = List.map (layout env loc Layouts.Sort.value) args in
-          Punboxed_product layouts
-      | Tconstr(p, args, _) when Path.same p Predef.path_unboxed_triple ->
-          let layouts = List.map (layout env loc Layouts.Sort.value) args in
-          Punboxed_product layouts
-      | Tconstr(p, _, _) when Path.same p Predef.path_void ->
-          Punboxed_product []
-      | _ ->
-          Lambda.Pvalue (value_kind env loc ty)
-
 
 let layout_of_sort loc sort =
   match Layouts.Sort.get_default_value sort with