Update merlin for 5.2.0minus-6

src/analysis/completion.ml

@@ -289,7 +289,7 @@ let fold_sumtype_constructors ~env ~init ~f t =
       | Type_record_unboxed_product _
       | Type_abstract _
       | Type_open -> init
-      | Type_variant (constrs, _) -> List.fold_right constrs ~init ~f
+      | Type_variant (constrs, _, _) -> List.fold_right constrs ~init ~f
     end
   | _ -> init
 
@@ -678,7 +678,7 @@ let branch_complete buffer ?get_doc ?target_type ?kinds ~keywords prefix =
           match Types.get_desc t with
           | Types.Tconstr (p, _, _) -> (
             match (Env.find_type p env).Types.type_kind with
-            | Types.Type_record (labels, _) -> Declaration (t, labels)
+            | Types.Type_record (labels, _, _) -> Declaration (t, labels)
             | _ -> Maybe)
           | _ -> Maybe
         with _ -> Maybe
@@ -722,7 +722,7 @@ let branch_complete buffer ?get_doc ?target_type ?kinds ~keywords prefix =
               Description labels
             with _ -> (
               match decl.Types.type_kind with
-              | Types.Type_record (lbls, _) -> Declaration (ty, lbls)
+              | Types.Type_record (lbls, _, _) -> Declaration (ty, lbls)
               | _ -> Maybe)
           end
           | _ | (exception _) -> Maybe

src/analysis/construct.ml

@@ -504,9 +504,9 @@ module Gen = struct
           with Not_found -> (
             let def = Env.find_type_descrs path env in
             match def with
-            | Type_variant (constrs, _) -> constructor env rtyp path constrs
-            | Type_record (labels, _) -> record env rtyp path labels Legacy
-            | Type_record_unboxed_product (labels, _) ->
+            | Type_variant (constrs, _, _) -> constructor env rtyp path constrs
+            | Type_record (labels, _, _) -> record env rtyp path labels Legacy
+            | Type_record_unboxed_product (labels, _, _) ->
               record env rtyp path labels Unboxed_product
             | Type_abstract _ | Type_open -> [])
         end

src/analysis/destruct.ml

@@ -101,7 +101,7 @@ let rec gen_patterns ?(recurse = true) env type_expr =
     [ Tast_helper.Pat.tuple env type_expr patterns ]
   | Tconstr (path, _params, _) -> begin
     match Env.find_type_descrs path env with
-    | Type_record (labels, _) ->
+    | Type_record (labels, _, _) ->
       let lst =
         List.map labels ~f:(fun lbl_descr ->
             let lidloc = mk_id lbl_descr.lbl_name in
@@ -111,7 +111,7 @@ let rec gen_patterns ?(recurse = true) env type_expr =
                 (mk_var lbl_descr.lbl_name) ))
       in
       [ Tast_helper.Pat.record env type_expr lst Asttypes.Closed ]
-    | Type_variant (constructors, _) ->
+    | Type_variant (constructors, _, _) ->
       let prefix =
         let path = Printtyp.shorten_type_path env path in
         fun name ->

src/analysis/ptyp_of_type.ml

@@ -226,11 +226,11 @@ and type_declaration id
     match type_kind with
     | Type_abstract _ -> Parsetree.Ptype_abstract
     | Type_open -> Ptype_open
-    | Type_variant (constrs, _) ->
+    | Type_variant (constrs, _, _) ->
       Ptype_variant (List.map ~f:constructor_declaration constrs)
-    | Type_record (labels, _repr) ->
+    | Type_record (labels, _repr, _) ->
       Ptype_record (List.map ~f:label_declaration labels)
-    | Type_record_unboxed_product (labels, _repr) ->
+    | Type_record_unboxed_product (labels, _repr, _) ->
       Ptype_record_unboxed_product (List.map ~f:label_declaration labels)
   in
   let manifest = Option.map ~f:core_type type_manifest in

src/kernel/mconfig.ml

@@ -26,7 +26,7 @@ type ocaml =
     parameters : string list;
     as_parameter : bool;
     as_argument_for : string option;
-    zero_alloc_check : Zero_alloc_annotations.t;
+    zero_alloc_check : Zero_alloc_annotations.Check.t;
     allow_illegal_crossing : bool
   }
 
@@ -57,7 +57,7 @@ let dump_ocaml x =
       ("parameters", `List (List.map ~f:Json.string x.parameters));
       ("as_parameter", `Bool x.as_parameter);
       ( "zero_alloc_check",
-        `String (Zero_alloc_annotations.to_string x.zero_alloc_check) )
+        `String (Zero_alloc_annotations.Check.to_string x.zero_alloc_check) )
     ]
 
 (** Some paths can be resolved relative to a current working directory *)
@@ -828,12 +828,12 @@ let ocaml_flags =
     );
     ( "-zero-alloc-check",
       Marg.param "string" (fun zero_alloc_str ocaml ->
-          match Zero_alloc_annotations.of_string zero_alloc_str with
+          match Zero_alloc_annotations.Check.of_string zero_alloc_str with
           | Some zero_alloc_check -> { ocaml with zero_alloc_check }
           | None ->
             failwith ("Invalid value for -zero-alloc-check: " ^ zero_alloc_str)),
       " Check that annotated functions do not allocate and do not have \
-       indirect calls. " ^ Zero_alloc_annotations.doc );
+       indirect calls. " ^ Zero_alloc_annotations.Check.doc );
     ( "-allow-illegal-crossing",
       Marg.unit (fun ocaml -> { ocaml with allow_illegal_crossing = true }),
       "Type declarations will not be checked along the portability or \
@@ -865,7 +865,7 @@ let initial =
         parameters = [];
         as_parameter = false;
         as_argument_for = None;
-        zero_alloc_check = Zero_alloc_annotations.Check_default;
+        zero_alloc_check = Zero_alloc_annotations.Check.Check_default;
         allow_illegal_crossing = false
       };
     merlin =

src/kernel/mconfig.mli

@@ -24,7 +24,7 @@ type ocaml =
     parameters : string list;
     as_parameter : bool;
     as_argument_for : string option;
-    zero_alloc_check : Zero_alloc_annotations.t;
+    zero_alloc_check : Zero_alloc_annotations.Check.t;
     allow_illegal_crossing : bool
   }
 

src/ocaml/parsing/builtin_attributes.ml

@@ -633,16 +633,8 @@ let zero_alloc_attribute ~in_signature (attr : Parsetree.attribute)  =
       | "all" -> Clflags.zero_alloc_assert := A.Assert.Assert_all
       | "all_opt" -> Clflags.zero_alloc_assert := A.Assert.Assert_all_opt
       | _ ->
-<<<<<<< janestreet/merlin-jst:rae/with-kinds-roll
-        warn_payload attr.attr_loc attr.attr_name.txt
-          "Only 'all', 'check', 'check_opt', 'check_all', and 'check_none' are supported")
-*)
-||||||| ocaml-flambda/flambda-backend:df4a6e0ba4f74dc790e0ad79f15ea73be1225c4b
-        warn_payload attr.attr_loc attr.attr_name.txt
-          "Only 'all', 'check', 'check_opt', 'check_all', and 'check_none' are supported")
-=======
         warn ())
->>>>>>> ocaml-flambda/flambda-backend:main
+*)
 
 let attribute_with_ignored_payload name attr =
   when_attribute_is [name; "ocaml." ^ name] attr ~f:(fun () -> ())
@@ -661,7 +653,9 @@ let parse_standard_interface_attributes attr =
   principal_attribute attr;
   noprincipal_attribute attr;
   nolabels_attribute attr;
+  (* merlin-jst: See {comments} above
   zero_alloc_attribute ~in_signature:true attr;
+  *)
   unsafe_allow_any_mode_crossing_attribute attr
 
 let parse_standard_implementation_attributes attr =
@@ -674,17 +668,9 @@ let parse_standard_implementation_attributes attr =
   afl_inst_ratio_attribute attr;
   flambda_o3_attribute attr;
   flambda_oclassic_attribute attr;
-<<<<<<< janestreet/merlin-jst:rae/with-kinds-roll
   zero_alloc_attribute attr
   *)
-  unsafe_allow_any_kind_in_impl_attribute attr
-||||||| ocaml-flambda/flambda-backend:df4a6e0ba4f74dc790e0ad79f15ea73be1225c4b
-  zero_alloc_attribute attr;
-  unsafe_allow_any_kind_in_impl_attribute attr
-=======
-  zero_alloc_attribute ~in_signature:false attr;
   unsafe_allow_any_mode_crossing_attribute attr
->>>>>>> ocaml-flambda/flambda-backend:main
 
 let has_no_mutable_implied_modalities attrs =
   has_attribute "no_mutable_implied_modalities" attrs

src/ocaml/parsing/pprintast.ml

@@ -463,27 +463,13 @@ and jkind_annotation ?(nested = false) ctxt f k = match k.pjkind_desc with
           (pp_print_list ~pp_sep:pp_print_space mode) modes
       ) f (t, modes)
     end
-<<<<<<< janestreet/merlin-jst:rae/with-kinds-roll
-  | With (t, ty) ->
-    Misc_stdlib.pp_parens_if nested (fun f (t, ty) ->
-      pp f "%a with %a" (jkind_annotation ~nested:true ctxt) t (core_type ctxt)
-        ty
-    ) f (t, ty)
-||||||| ocaml-flambda/flambda-backend:df4a6e0ba4f74dc790e0ad79f15ea73be1225c4b
-  | With (t, ty) ->
-    Misc.pp_parens_if nested (fun f (t, ty) ->
-      pp f "%a with %a" (jkind_annotation ~nested:true ctxt) t (core_type ctxt)
-        ty
-    ) f (t, ty)
-=======
   | With (t, ty, modalities) ->
-    Misc.pp_parens_if nested (fun f (t, ty, modalities) ->
+    Misc_stdlib.pp_parens_if nested (fun f (t, ty, modalities) ->
       pp f "%a with %a%a"
         (jkind_annotation ~nested:true ctxt) t
         (core_type ctxt) ty
         optional_space_atat_modalities modalities;
     ) f (t, ty, modalities)
->>>>>>> ocaml-flambda/flambda-backend:main
   | Kind_of ty -> pp f "kind_of_ %a" (core_type ctxt) ty
   | Product ts ->
     Misc_stdlib.pp_parens_if nested (fun f ts ->