Update merlin for 5.2.0minus-6

src/analysis/context.ml

@@ -98,7 +98,7 @@ let inspect_pattern (type a) ~cursor ~lid (p : a Typedtree.general_pattern) =
   match p.pat_desc with
   | Tpat_any when Longident.last lid = "_" -> None
   | Tpat_var (_, str_loc, _, _) when Longident.last lid = str_loc.txt -> None
-  | Tpat_alias (_, _, str_loc, _, _) when Longident.last lid = str_loc.txt ->
+  | Tpat_alias (_, _, str_loc, _, _, _) when Longident.last lid = str_loc.txt ->
     (* Assumption: if [Browse.enclosing] stopped on this node and not on the
        subpattern, then it must mean that the cursor is on the alias. *)
     None

src/analysis/destruct.ml

@@ -339,7 +339,7 @@ let rec destructible patt =
   let open Typedtree in
   match patt.pat_desc with
   | Tpat_any | Tpat_var _ -> true
-  | Tpat_alias (p, _, _, _, _) -> destructible p
+  | Tpat_alias (p, _, _, _, _, _) -> destructible p
   | _ -> false
 
 let is_package ty =
@@ -369,8 +369,8 @@ let rec subst_patt initial ~by patt =
     let open Typedtree in
     match patt.pat_desc with
     | Tpat_any | Tpat_var _ | Tpat_constant _ -> patt
-    | Tpat_alias (p, x, y, uid, m) ->
-      { patt with pat_desc = Tpat_alias (f p, x, y, uid, m) }
+    | Tpat_alias (p, x, y, uid, m, ty) ->
+      { patt with pat_desc = Tpat_alias (f p, x, y, uid, m, ty) }
     | Tpat_tuple lst ->
       { patt with
         pat_desc = Tpat_tuple (List.map lst ~f:(fun (lbl, p) -> (lbl, f p)))
@@ -408,8 +408,8 @@ let rec rm_sub patt sub =
   let open Typedtree in
   match patt.pat_desc with
   | Tpat_any | Tpat_var _ | Tpat_constant _ -> patt
-  | Tpat_alias (p, x, y, uid, m) ->
-    { patt with pat_desc = Tpat_alias (f p, x, y, uid, m) }
+  | Tpat_alias (p, x, y, uid, m, ty) ->
+    { patt with pat_desc = Tpat_alias (f p, x, y, uid, m, ty) }
   | Tpat_tuple lst ->
     { patt with
       pat_desc = Tpat_tuple (List.map lst ~f:(fun (lbl, p) -> (lbl, f p)))
@@ -473,8 +473,8 @@ let rec qualify_constructors ~unmangling_tables f pat =
   in
   let pat_desc =
     match pat.pat_desc with
-    | Tpat_alias (p, id, loc, uid, m) ->
-      Tpat_alias (qualify_constructors f p, id, loc, uid, m)
+    | Tpat_alias (p, id, loc, uid, m, ty) ->
+      Tpat_alias (qualify_constructors f p, id, loc, uid, m, ty)
     | Tpat_tuple ps ->
       Tpat_tuple
         (List.map ps ~f:(fun (lbl, p) -> (lbl, qualify_constructors f p)))
@@ -532,8 +532,9 @@ let find_branch patterns sub =
       match patt.pat_desc with
       | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) ->
         false
-      | Tpat_alias (p, _, _, _, _) | Tpat_variant (_, Some p, _) | Tpat_lazy p
-        -> is_sub_patt p ~sub
+      | Tpat_alias (p, _, _, _, _, _)
+      | Tpat_variant (_, Some p, _)
+      | Tpat_lazy p -> is_sub_patt p ~sub
       | Tpat_tuple lst ->
         List.exists lst ~f:(fun (_lbl, p) -> is_sub_patt ~sub p)
       | Tpat_unboxed_tuple lst ->
@@ -615,7 +616,7 @@ module Conv = struct
         mkpat (Ppat_var nm)
       | Tpat_any | Tpat_var _ -> mkpat Ppat_any
       | Tpat_constant c -> mkpat (Ppat_constant (Untypeast.constant c))
-      | Tpat_alias (p, _, _, _, _) -> loop p
+      | Tpat_alias (p, _, _, _, _, _) -> loop p
       | Tpat_tuple lst ->
         let lst = List.map ~f:(fun (lbl, p) -> (lbl, loop p)) lst in
         mkpat (Ppat_tuple (lst, Closed))

src/analysis/occurrences.ml

@@ -60,7 +60,8 @@ let uid_and_loc_of_node env node =
     let md = Env.find_module (Pident ident) env in
     Some (md.md_uid, mb_name.loc)
   | Pattern
-      { pat_desc = Tpat_var (_, name, uid, _) | Tpat_alias (_, _, name, uid, _);
+      { pat_desc =
+          Tpat_var (_, name, uid, _) | Tpat_alias (_, _, name, uid, _, _);
         _
       } -> Some (uid, name.loc)
   | Type_declaration { typ_type; typ_name; _ } ->

src/analysis/typedtree_utils.ml

@@ -27,7 +27,7 @@ let let_bound_vars bindings =
       match value_binding.Typedtree.vb_pat.pat_desc with
       | Tpat_var (id, loc, _, _) -> Some (id, loc)
       | Typedtree.Tpat_any
-      | Typedtree.Tpat_alias (_, _, _, _, _)
+      | Typedtree.Tpat_alias (_, _, _, _, _, _)
       | Typedtree.Tpat_constant _
       | Typedtree.Tpat_tuple _
       | Typedtree.Tpat_unboxed_tuple _
@@ -70,6 +70,6 @@ let pat_var_id_and_loc = function
   | _ -> None
 
 let pat_alias_pat_id_and_loc = function
-  | Typedtree.{ pat_desc = Tpat_alias (pat, id, loc, _, _); _ } ->
+  | Typedtree.{ pat_desc = Tpat_alias (pat, id, loc, _, _, _); _ } ->
     Some (pat, id, loc)
   | _ -> None

src/kernel/mconfig.ml

@@ -27,7 +27,8 @@ type ocaml =
     as_parameter : bool;
     as_argument_for : string option;
     zero_alloc_check : Zero_alloc_annotations.Check.t;
-    allow_illegal_crossing : bool
+    zero_alloc_assert : Zero_alloc_annotations.Assert.t;
+    infer_with_bounds : bool
   }
 
 let dump_warnings st =
@@ -57,7 +58,9 @@ 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.Check.to_string x.zero_alloc_check) )
+        `String (Zero_alloc_annotations.Check.to_string x.zero_alloc_check) );
+      ( "zero_alloc_assert",
+        `String (Zero_alloc_annotations.Assert.to_string x.zero_alloc_assert) )
     ]
 
 (** Some paths can be resolved relative to a current working directory *)
@@ -452,7 +455,6 @@ let ocaml_ignored_flags =
     "-drawflambda";
     "-drawlambda";
     "-dreload";
-    "-dscheduling";
     "-dsel";
     "-dsource";
     "-dspill";
@@ -652,6 +654,7 @@ let ocaml_ignored_parametrized_flags =
     "-o";
     "-rounds";
     "-runtime-variant";
+    "-ocamlrunparam";
     "-unbox-closures-factor";
     "-use-prims";
     "-use_runtime";
@@ -834,10 +837,18 @@ let ocaml_flags =
             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.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 \
-       contention axes" )
+    ( "-zero-alloc-assert",
+      Marg.param "string" (fun zero_alloc_str ocaml ->
+          match Zero_alloc_annotations.Assert.of_string zero_alloc_str with
+          | Some zero_alloc_assert -> { ocaml with zero_alloc_assert }
+          | None ->
+            failwith ("Invalid value for -zero-alloc-assert: " ^ zero_alloc_str)),
+      " Add zero_alloc annotations to all functions. "
+      ^ Zero_alloc_annotations.Assert.doc );
+    ( "-infer-with-bounds",
+      Marg.unit (fun ocaml -> { ocaml with infer_with_bounds = true }),
+      "Infer with-bounds on kinds for type declarations. May impact \
+       performance." )
   ]
 
 (** {1 Main configuration} *)
@@ -866,7 +877,8 @@ let initial =
         as_parameter = false;
         as_argument_for = None;
         zero_alloc_check = Zero_alloc_annotations.Check.Check_default;
-        allow_illegal_crossing = false
+        zero_alloc_assert = Zero_alloc_annotations.Assert.Assert_default;
+        infer_with_bounds = false
       };
     merlin =
       { build_path = [];

src/kernel/mconfig.mli

@@ -25,7 +25,8 @@ type ocaml =
     as_parameter : bool;
     as_argument_for : string option;
     zero_alloc_check : Zero_alloc_annotations.Check.t;
-    allow_illegal_crossing : bool
+    zero_alloc_assert : Zero_alloc_annotations.Assert.t;
+    infer_with_bounds : bool
   }
 
 val dump_ocaml : ocaml -> json

src/ocaml/merlin_specific/browse_raw.ml

@@ -342,7 +342,7 @@ let of_pattern_desc (type k) (desc : k pattern_desc) =
   match desc with
   | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) ->
     id_fold
-  | Tpat_alias (p, _, _, _, _)
+  | Tpat_alias (p, _, _, _, _, _)
   | Tpat_variant (_, Some p, _)
   | Tpat_lazy p
   | Tpat_exception p -> of_pattern p
@@ -793,7 +793,7 @@ let pattern_paths (type k) { Typedtree.pat_desc; pat_extra; _ } =
       fake_path lid_loc cstr_res cstr_name
     | Tpat_var (id, { Location.loc; txt }, _, _) ->
       [ (mkloc (Path.Pident id) loc, Some (Longident.Lident txt)) ]
-    | Tpat_alias (_, id, loc, _, _) ->
+    | Tpat_alias (_, id, loc, _, _, _) ->
       [ (reloc (Path.Pident id) loc, Some (Longident.Lident loc.txt)) ]
     | _ -> []
   in

src/ocaml/typing/ctype.ml

@@ -23,6 +23,8 @@ open Errortrace
 open Mode
 open Local_store
 
+module Nonempty_list = Misc_stdlib.Nonempty_list
+
 (*
    Type manipulation after type inference
    ======================================

src/ocaml/typing/env.ml

@@ -1220,30 +1220,12 @@ let runtime_parameter_bindings () =
 
 let parameters () = Persistent_env.parameters !persistent_env
 
-<<<<<<< janestreet/merlin-jst:rae/with-kinds-roll
-let read_pers_mod modname cmi ~add_binding =
-  Persistent_env.read !persistent_env read_sign_of_cmi short_paths_components
-    modname cmi ~add_binding
-||||||| ocaml-flambda/flambda-backend:4eb95cdd48f3f2f6193e59c53e4640a008a7fd13
-let read_pers_mod modname cmi ~add_binding =
-  Persistent_env.read !persistent_env read_sign_of_cmi modname cmi
-    ~add_binding
-=======
 let read_pers_mod modname cmi =
   Persistent_env.read !persistent_env modname cmi
->>>>>>> ocaml-flambda/flambda-backend:5.2.0minus-6
 
-<<<<<<< janestreet/merlin-jst:rae/with-kinds-roll
-let find_pers_mod name =
-  Persistent_env.find !persistent_env
-    read_sign_of_cmi short_paths_components name
-||||||| ocaml-flambda/flambda-backend:4eb95cdd48f3f2f6193e59c53e4640a008a7fd13
-let find_pers_mod name =
-  Persistent_env.find !persistent_env read_sign_of_cmi name
-=======
 let find_pers_mod name ~allow_excess_args =
-  Persistent_env.find !persistent_env read_sign_of_cmi name ~allow_excess_args
->>>>>>> ocaml-flambda/flambda-backend:5.2.0minus-6
+  Persistent_env.find !persistent_env
+    read_sign_of_cmi short_paths_components name ~allow_excess_args
 
 let check_pers_mod ~loc name =
   Persistent_env.check !persistent_env
@@ -4449,23 +4431,13 @@ let sharedness_hint ppf : shared_context -> _ = function
           because it is defined outside of the probe.@]"
 
 let print_lock_item ppf (item, lid) =
-<<<<<<< janestreet/merlin-jst:rae/with-kinds-roll
   match (item : lock_item) with
-  | Module -> fprintf ppf "Modules are"
-  | Class -> fprintf ppf "Classes are"
-||||||| ocaml-flambda/flambda-backend:4eb95cdd48f3f2f6193e59c53e4640a008a7fd13
-  match item with
-  | Module -> fprintf ppf "Modules are"
-  | Class -> fprintf ppf "Classes are"
-=======
-  match item with
   | Module ->
       fprintf ppf "%a is a module, and modules are always"
         (Style.as_inline_code !print_longident) lid
   | Class ->
       fprintf ppf "%a is a class, and classes are always"
         (Style.as_inline_code !print_longident) lid
->>>>>>> ocaml-flambda/flambda-backend:5.2.0minus-6
   | Value -> fprintf ppf "The value %a is"
       (Style.as_inline_code !print_longident) lid
 

src/ocaml/typing/global_module.ml

@@ -344,7 +344,7 @@ module With_precision = struct
     (* Compute the meet, assuming the visible parts are equal *)
     let rec meet glob1 glob2 =
       let visible_args_rev =
-        Misc.Stdlib.List.merge_fold glob1.visible_args glob2.visible_args
+        Misc_stdlib.List.merge_fold glob1.visible_args glob2.visible_args
           ~cmp:compare_arg_name
           ~init:[]
           ~left_only:(fun _ _ -> raise Inconsistent)
@@ -353,7 +353,7 @@ module With_precision = struct
       in
       let hidden_args_rev =
         (* Keep only the hidden arguments that appear in both lists *)
-        Misc.Stdlib.List.merge_fold glob1.hidden_args glob2.hidden_args
+        Misc_stdlib.List.merge_fold glob1.hidden_args glob2.hidden_args
           ~cmp:compare_arg_name
           ~init:[]
           ~left_only:(fun acc_rev _ -> acc_rev)