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/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

@@ -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 ->
@@ -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/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/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

@@ -26,8 +26,9 @@ type ocaml =
     parameters : string list;
     as_parameter : bool;
     as_argument_for : string option;
-    zero_alloc_check : Zero_alloc_annotations.t;
-    allow_illegal_crossing : bool
+    zero_alloc_check : Zero_alloc_annotations.Check.t;
+    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.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";
@@ -828,16 +831,24 @@ 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 );
-    ( "-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" )
+       indirect calls. " ^ Zero_alloc_annotations.Check.doc );
+    ( "-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} *)
@@ -865,8 +876,9 @@ let initial =
         parameters = [];
         as_parameter = false;
         as_argument_for = None;
-        zero_alloc_check = Zero_alloc_annotations.Check_default;
-        allow_illegal_crossing = false
+        zero_alloc_check = Zero_alloc_annotations.Check.Check_default;
+        zero_alloc_assert = Zero_alloc_annotations.Assert.Assert_default;
+        infer_with_bounds = false
       };
     merlin =
       { build_path = [];

src/kernel/mconfig.mli

@@ -24,8 +24,9 @@ type ocaml =
     parameters : string list;
     as_parameter : bool;
     as_argument_for : string option;
-    zero_alloc_check : Zero_alloc_annotations.t;
-    allow_illegal_crossing : bool
+    zero_alloc_check : Zero_alloc_annotations.Check.t;
+    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/parsing/ast_helper.ml

@@ -147,7 +147,7 @@ module Typ = struct
         | Default as x -> x
         | Abbreviation _ as x -> x
         | Mod (jkind, modes) -> Mod (loop_jkind jkind, modes)
-        | With (jkind, typ) -> With (loop_jkind jkind, loop typ)
+        | With (jkind, typ, modalities) -> With (loop_jkind jkind, loop typ, modalities)
         | Kind_of typ -> Kind_of (loop typ)
         | Product jkinds -> Product (List.map loop_jkind jkinds)
       in

src/ocaml/parsing/ast_iterator.ml

@@ -842,9 +842,10 @@ let default_iterator =
          | Mod (t, mode_list) ->
              this.jkind_annotation this t;
              this.modes this mode_list
-         | With (t, ty) ->
+         | With (t, ty, modalities) ->
              this.jkind_annotation this t;
-             this.typ this ty
+             this.typ this ty;
+             this.modalities this modalities
          | Kind_of ty -> this.typ this ty
          | Product ts -> List.iter (this.jkind_annotation this) ts);
 

src/ocaml/parsing/ast_mapper.ml

@@ -946,8 +946,8 @@ let default_mapper =
         | Abbreviation (s : string) -> Abbreviation s
         | Mod (t, mode_list) ->
           Mod (this.jkind_annotation this t, this.modes this mode_list)
-        | With (t, ty) ->
-          With (this.jkind_annotation this t, this.typ this ty)
+        | With (t, ty, modalities) ->
+          With (this.jkind_annotation this t, this.typ this ty, this.modalities this modalities)
         | Kind_of ty -> Kind_of (this.typ this ty)
         | Product ts -> Product (List.map (this.jkind_annotation this) ts)
       in