Commit merge conflicts

src/ocaml/parsing/ast_helper.ml

@@ -191,6 +191,8 @@ module Pat = struct
   let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))
   let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
   let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))
+  let record_unboxed_product ?loc ?attrs a b =
+    mk ?loc ?attrs (Ppat_record_unboxed_product (a, b))
   let array ?loc ?attrs a b = mk ?loc ?attrs (Ppat_array (a, b))
   let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b))
   let constraint_ ?loc ?attrs a b c = mk ?loc ?attrs (Ppat_constraint (a, b, c))
@@ -225,7 +227,10 @@ module Exp = struct
   let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b))
   let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b))
   let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b))
+  let record_unboxed_product ?loc ?attrs a b =
+    mk ?loc ?attrs (Pexp_record_unboxed_product (a, b))
   let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b))
+  let unboxed_field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_unboxed_field (a, b))
   let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c))
   let array ?loc ?attrs a b = mk ?loc ?attrs (Pexp_array (a, b))
   let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c))
@@ -256,9 +261,15 @@ module Exp = struct
   let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable
   let stack ?loc ?attrs e = mk ?loc ?attrs (Pexp_stack e)
   let comprehension ?loc ?attrs e = mk ?loc ?attrs (Pexp_comprehension e)
+<<<<<<< janestreet/merlin-jst:merge-5.2.0minus-5
   let hole ?(loc = !default_loc) ?attrs () =
     let id = Location.mkloc hole_txt loc in
     mk ~loc ?attrs  @@ Pexp_extension (id, PStr [])
+||||||| ocaml-flambda/flambda-backend:581b385a59911c05d91e2de7868e16f791e0c67a
+=======
+  let overwrite ?loc ?attrs a b = mk ?loc ?attrs (Pexp_overwrite (a, b))
+  let hole ?loc ?attrs () = mk ?loc ?attrs Pexp_hole
+>>>>>>> ocaml-flambda/flambda-backend:df4a6e0ba4f74dc790e0ad79f15ea73be1225c4b
 
   let case lhs ?guard rhs =
     {

src/ocaml/parsing/ast_helper.mli

@@ -130,6 +130,8 @@ module Pat:
     val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
     val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag
                 -> pattern
+    val record_unboxed_product: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list
+                -> closed_flag -> pattern
     val array: ?loc:loc -> ?attrs:attrs -> mutable_flag -> pattern list ->
       pattern
     val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
@@ -154,7 +156,7 @@ module Exp:
     val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list
               -> expression -> expression
     val function_ : ?loc:loc -> ?attrs:attrs -> function_param list
-                   -> function_constraint option -> function_body
+                   -> function_constraint -> function_body
                    -> expression
     val apply: ?loc:loc -> ?attrs:attrs -> expression
                -> (arg_label * expression) list -> expression
@@ -170,7 +172,10 @@ module Exp:
                  -> expression
     val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list
                 -> expression option -> expression
+    val record_unboxed_product: ?loc:loc -> ?attrs:attrs -> (lid * expression) list
+                -> expression option -> expression
     val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+    val unboxed_field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
     val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
                   -> expression
     val array: ?loc:loc -> ?attrs:attrs -> mutable_flag -> expression list ->
@@ -216,6 +221,8 @@ module Exp:
     val stack : ?loc:loc -> ?attrs:attrs -> expression -> expression
     val comprehension :
       ?loc:loc -> ?attrs:attrs -> comprehension_expression -> expression
+    val overwrite : ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
+    val hole : ?loc:loc -> ?attrs:attrs -> unit -> expression
 
     val case: pattern -> ?guard:expression -> expression -> case
     val binding_op: str -> pattern -> expression -> loc -> binding_op

src/ocaml/parsing/ast_iterator.ml

@@ -178,7 +178,8 @@ module T = struct
     | Ptype_abstract -> ()
     | Ptype_variant l ->
         List.iter (sub.constructor_declaration sub) l
-    | Ptype_record l -> List.iter (sub.label_declaration sub) l
+    | Ptype_record l | Ptype_record_unboxed_product l ->
+        List.iter (sub.label_declaration sub) l
     | Ptype_open -> ()
 
   let iter_constructor_argument sub {pca_type; pca_loc; pca_modalities} =
@@ -431,14 +432,17 @@ module E = struct
   let iter_function_constraint sub : function_constraint -> _ =
     (* Enable warning 9 to ensure that the record pattern doesn't miss any
        field. *)
-    fun[@ocaml.warning "+9"] { mode_annotations; type_constraint } ->
+    fun[@ocaml.warning "+9"] { mode_annotations; ret_type_constraint; ret_mode_annotations } ->
       sub.modes sub mode_annotations;
-      match type_constraint with
-      | Pconstraint ty ->
+      begin match ret_type_constraint with
+      | Some (Pconstraint ty) ->
           sub.typ sub ty
-      | Pcoerce (ty1, ty2) ->
+      | Some (Pcoerce (ty1, ty2)) ->
           Option.iter (sub.typ sub) ty1;
           sub.typ sub ty2
+      | None -> ()
+      end;
+      sub.modes sub ret_mode_annotations
 
   let iter_function_body sub : function_body -> _ = function
     | Pfunction_body expr ->
@@ -461,7 +465,7 @@ module E = struct
         sub.expr sub e
     | Pexp_function (params, constraint_, body) ->
         List.iter (iter_function_param sub) params;
-        iter_opt (iter_function_constraint sub) constraint_;
+        iter_function_constraint sub constraint_;
         iter_function_body sub body
     | Pexp_apply (e, l) ->
         sub.expr sub e; List.iter (iter_snd (sub.expr sub)) l
@@ -474,10 +478,12 @@ module E = struct
         iter_loc sub lid; iter_opt (sub.expr sub) arg
     | Pexp_variant (_lab, eo) ->
         iter_opt (sub.expr sub) eo
-    | Pexp_record (l, eo) ->
+    | Pexp_record (l, eo)
+    | Pexp_record_unboxed_product (l, eo) ->
         List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l;
         iter_opt (sub.expr sub) eo
-    | Pexp_field (e, lid) ->
+    | Pexp_field (e, lid)
+    | Pexp_unboxed_field (e, lid) ->
         sub.expr sub e; iter_loc sub lid
     | Pexp_setfield (e1, lid, e2) ->
         sub.expr sub e1; iter_loc sub lid;
@@ -532,6 +538,8 @@ module E = struct
     | Pexp_unreachable -> ()
     | Pexp_stack e -> sub.expr sub e
     | Pexp_comprehension e -> iter_comp_exp sub e
+    | Pexp_overwrite (e1, e2) -> sub.expr sub e1; sub.expr sub e2
+    | Pexp_hole -> ()
 
   let iter_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
     iter_loc sub pbop_op;
@@ -565,7 +573,8 @@ module P = struct
             sub.pat sub p)
           p
     | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
-    | Ppat_record (lpl, _cf) ->
+    | Ppat_record (lpl, _cf)
+    | Ppat_record_unboxed_product (lpl, _cf) ->
         List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl
     | Ppat_array (_mut, pl) -> List.iter (sub.pat sub) pl
     | Ppat_or (p1, p2) -> sub.pat sub p1; sub.pat sub p2

src/ocaml/parsing/ast_mapper.ml

@@ -223,6 +223,8 @@ module T = struct
     | Ptype_variant l ->
         Ptype_variant (List.map (sub.constructor_declaration sub) l)
     | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l)
+    | Ptype_record_unboxed_product l ->
+        Ptype_record_unboxed_product (List.map (sub.label_declaration sub) l)
     | Ptype_open -> Ptype_open
 
   let map_constructor_argument sub x =
@@ -485,9 +487,10 @@ module E = struct
     | Pcoerce (ty1, ty2) ->
         Pcoerce (Option.map (sub.typ sub) ty1, sub.typ sub ty2)
 
-  let map_function_constraint sub { mode_annotations; type_constraint } =
+  let map_function_constraint sub { mode_annotations; ret_type_constraint; ret_mode_annotations } =
     { mode_annotations = sub.modes sub mode_annotations;
-      type_constraint = map_type_constraint sub type_constraint;
+      ret_type_constraint = Option.map (map_type_constraint sub) ret_type_constraint;
+      ret_mode_annotations = sub.modes sub ret_mode_annotations
     }
 
   let map_iterator sub = function
@@ -532,7 +535,7 @@ module E = struct
     | Pexp_function (ps, c, b) ->
       function_ ~loc ~attrs
         (List.map (map_function_param sub) ps)
-        (map_opt (map_function_constraint sub) c)
+        (map_function_constraint sub c)
         (map_function_body sub b)
     | Pexp_apply (e, l) ->
         apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l)
@@ -550,8 +553,14 @@ module E = struct
     | Pexp_record (l, eo) ->
         record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
           (map_opt (sub.expr sub) eo)
+    | Pexp_record_unboxed_product (l, eo) ->
+        record_unboxed_product ~loc ~attrs
+          (List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
+          (map_opt (sub.expr sub) eo)
     | Pexp_field (e, lid) ->
         field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
+    | Pexp_unboxed_field (e, lid) ->
+        unboxed_field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
     | Pexp_setfield (e1, lid, e2) ->
         setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid)
           (sub.expr sub e2)
@@ -605,6 +614,8 @@ module E = struct
     | Pexp_unreachable -> unreachable ~loc ~attrs ()
     | Pexp_stack e -> stack ~loc ~attrs (sub.expr sub e)
     | Pexp_comprehension c -> comprehension ~loc ~attrs (map_cexp sub c)
+    | Pexp_overwrite (e1, e2) -> overwrite ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+    | Pexp_hole -> hole ~loc ~attrs ()
 
   let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
     let open Exp in
@@ -644,6 +655,9 @@ module P = struct
     | Ppat_record (lpl, cf) ->
         record ~loc ~attrs
                (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf
+    | Ppat_record_unboxed_product (lpl, cf) ->
+        record_unboxed_product ~loc ~attrs
+               (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf
     | Ppat_array (mut, pl) -> array ~loc ~attrs mut (List.map (sub.pat sub) pl)
     | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
     | Ppat_constraint (p, t, m) ->
@@ -778,12 +792,13 @@ let default_mapper =
     binding_op = E.map_binding_op;
 
     module_declaration =
-      (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} ->
+      (fun this {pmd_name; pmd_type; pmd_modalities; pmd_attributes; pmd_loc} ->
          Md.mk
            (map_loc this pmd_name)
            (this.module_type this pmd_type)
            ~attrs:(this.attributes this pmd_attributes)
            ~loc:(this.location this pmd_loc)
+           ~modalities:(this.modalities this pmd_modalities)
       );
 
     module_substitution =

src/ocaml/parsing/builtin_attributes.ml

@@ -509,6 +509,10 @@ let has_unboxed attrs = has_attribute "unboxed" attrs
 
 let has_boxed attrs = has_attribute "boxed" attrs
 
+let has_unsafe_allow_any_kind_in_intf attrs = has_attribute "unsafe_allow_any_kind_in_intf" attrs
+
+let has_unsafe_allow_any_kind_in_impl attrs = has_attribute "unsafe_allow_any_kind_in_impl" attrs
+
 let parse_empty_payload attr =
   match attr.attr_payload with
   | PStr [] -> Some ()
@@ -617,6 +621,15 @@ let zero_alloc_attribute (attr : Parsetree.attribute)  =
         warn_payload attr.attr_loc attr.attr_name.txt
           "Only 'all', 'check', 'check_opt', 'check_all', and 'check_none' are supported")
 
+let attribute_with_ignored_payload name attr =
+  when_attribute_is [name; "ocaml." ^ name] attr ~f:(fun () -> ())
+
+let unsafe_allow_any_kind_in_impl_attribute =
+  attribute_with_ignored_payload "unsafe_allow_any_kind_in_impl"
+
+let unsafe_allow_any_kind_in_intf_attribute =
+  attribute_with_ignored_payload "unsafe_allow_any_kind_in_intf"
+
 let afl_inst_ratio_attribute attr =
   clflags_attribute_with_int_payload attr
     ~name:"afl_inst_ratio" Clflags.afl_inst_ratio
@@ -626,7 +639,8 @@ let parse_standard_interface_attributes attr =
   warning_attribute attr;
   principal_attribute attr;
   noprincipal_attribute attr;
-  nolabels_attribute attr
+  nolabels_attribute attr;
+  unsafe_allow_any_kind_in_intf_attribute attr
 
 let parse_standard_implementation_attributes attr =
   warning_attribute attr;
@@ -639,8 +653,15 @@ let parse_standard_implementation_attributes attr =
   afl_inst_ratio_attribute attr;
   flambda_o3_attribute attr;
   flambda_oclassic_attribute attr;
+<<<<<<< janestreet/merlin-jst:merge-5.2.0minus-5
   zero_alloc_attribute attr
   *)
+||||||| ocaml-flambda/flambda-backend:581b385a59911c05d91e2de7868e16f791e0c67a
+  zero_alloc_attribute attr
+=======
+  zero_alloc_attribute attr;
+  unsafe_allow_any_kind_in_impl_attribute attr
+>>>>>>> ocaml-flambda/flambda-backend:df4a6e0ba4f74dc790e0ad79f15ea73be1225c4b
 
 let has_no_mutable_implied_modalities attrs =
   has_attribute "no_mutable_implied_modalities" attrs

src/ocaml/parsing/builtin_attributes.mli

@@ -35,6 +35,8 @@
     - ocaml.tailcall
     - ocaml.tail_mod_cons
     - ocaml.unboxed
+    - ocaml.unsafe_allow_any_kind_in_impl
+    - ocaml.unsafe_allow_any_kind_in_intf
     - ocaml.untagged
     - ocaml.unrolled
     - ocaml.warnerror
@@ -198,6 +200,9 @@ val explicit_arity: Parsetree.attributes -> bool
 val has_unboxed: Parsetree.attributes -> bool
 val has_boxed: Parsetree.attributes -> bool
 
+val has_unsafe_allow_any_kind_in_impl: Parsetree.attributes -> bool
+val has_unsafe_allow_any_kind_in_intf: Parsetree.attributes -> bool
+
 val parse_standard_interface_attributes : Parsetree.attribute -> unit
 val parse_standard_implementation_attributes : Parsetree.attribute -> unit
 

src/ocaml/parsing/language_extension.ml

@@ -63,6 +63,7 @@ let get_level_ops : type a. a t -> (module Extension_level with type t = a) =
   | Comprehensions -> (module Unit)
   | Mode -> (module Maturity)
   | Unique -> (module Maturity)
+  | Overwriting -> (module Unit)
   | Include_functor -> (module Unit)
   | Polymorphic_parameters -> (module Unit)
   | Immutable_arrays -> (module Unit)
@@ -82,12 +83,12 @@ let get_level_ops : type a. a t -> (module Extension_level with type t = a) =
    But we've decided to punt on this issue in the short term.
 *)
 let is_erasable : type a. a t -> bool = function
-  | Mode | Unique | Layouts -> true
+  | Mode | Unique | Overwriting | Layouts -> true
   | Comprehensions | Include_functor | Polymorphic_parameters | Immutable_arrays
   | Module_strengthening | SIMD | Labeled_tuples | Small_numbers | Instances ->
     false
 
-let maturity_of_unique_for_drf = Alpha
+let maturity_of_unique_for_drf = Stable
 
 let maturity_of_unique_for_destruction = Alpha
 
@@ -98,6 +99,7 @@ module Exist_pair = struct
     | Pair (Comprehensions, ()) -> Beta
     | Pair (Mode, m) -> m
     | Pair (Unique, m) -> m
+    | Pair (Overwriting, ()) -> Alpha
     | Pair (Include_functor, ()) -> Stable
     | Pair (Polymorphic_parameters, ()) -> Stable
     | Pair (Immutable_arrays, ()) -> Stable
@@ -120,7 +122,7 @@ module Exist_pair = struct
     | Pair
         ( (( Comprehensions | Include_functor | Polymorphic_parameters
            | Immutable_arrays | Module_strengthening | Labeled_tuples
-           | Instances ) as ext),
+           | Instances | Overwriting ) as ext),
           _ ) ->
       to_string ext
 
@@ -137,6 +139,7 @@ module Exist_pair = struct
     | "unique" -> Some (Pair (Unique, Stable))
     | "unique_beta" -> Some (Pair (Unique, Beta))
     | "unique_alpha" -> Some (Pair (Unique, Alpha))
+    | "overwriting" -> Some (Pair (Overwriting, ()))
     | "include_functor" -> Some (Pair (Include_functor, ()))
     | "polymorphic_parameters" -> Some (Pair (Polymorphic_parameters, ()))
     | "immutable_arrays" -> Some (Pair (Immutable_arrays, ()))
@@ -161,6 +164,7 @@ let all_extensions =
   [ Pack Comprehensions;
     Pack Mode;
     Pack Unique;
+    Pack Overwriting;
     Pack Include_functor;
     Pack Polymorphic_parameters;
     Pack Immutable_arrays;
@@ -198,6 +202,7 @@ let equal_t (type a b) (a : a t) (b : b t) : (a, b) Misc_stdlib.eq option =
   | Comprehensions, Comprehensions -> Some Refl
   | Mode, Mode -> Some Refl
   | Unique, Unique -> Some Refl
+  | Overwriting, Overwriting -> Some Refl
   | Include_functor, Include_functor -> Some Refl
   | Polymorphic_parameters, Polymorphic_parameters -> Some Refl
   | Immutable_arrays, Immutable_arrays -> Some Refl
@@ -207,7 +212,7 @@ let equal_t (type a b) (a : a t) (b : b t) : (a, b) Misc_stdlib.eq option =
   | Labeled_tuples, Labeled_tuples -> Some Refl
   | Small_numbers, Small_numbers -> Some Refl
   | Instances, Instances -> Some Refl
-  | ( ( Comprehensions | Mode | Unique | Include_functor
+  | ( ( Comprehensions | Mode | Unique | Overwriting | Include_functor
       | Polymorphic_parameters | Immutable_arrays | Module_strengthening
       | Layouts | SIMD | Labeled_tuples | Small_numbers | Instances ),
       _ ) ->

src/ocaml/parsing/language_extension.mli

@@ -21,6 +21,7 @@ type 'a t = 'a Language_extension_kernel.t =
   | Comprehensions : unit t
   | Mode : maturity t
   | Unique : maturity t
+  | Overwriting : unit t
   | Include_functor : unit t
   | Polymorphic_parameters : unit t
   | Immutable_arrays : unit t

src/ocaml/parsing/location.ml

@@ -1103,5 +1103,17 @@ let () =
       | _ -> None
     )
 
+<<<<<<< janestreet/merlin-jst:merge-5.2.0minus-5
 let raise_errorf ?(loc = none) ?(sub = []) ?(source = Typer)=
   Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt source)))
+||||||| ocaml-flambda/flambda-backend:581b385a59911c05d91e2de7868e16f791e0c67a
+let raise_errorf ?(loc = none) ?(sub = []) =
+  Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt)))
+=======
+let raise_errorf ?(loc = none) ?(sub = []) =
+  Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt)))
+
+let todo_overwrite_not_implemented ?(kind = "") t =
+  alert ~kind t "Overwrite not implemented.";
+  assert false
+>>>>>>> ocaml-flambda/flambda-backend:df4a6e0ba4f74dc790e0ad79f15ea73be1225c4b