Merge 5.2.0minus-18 (#180)

* Import ocaml sources for oxcaml/oxcaml@dec889241a6

* Automatic merges

* Commit merge conflicts

* Fix conflicts

* Fix type errors in merlin-specific code

* Bump magic numbers

* Promote tests

* Add ignored flags

* Fix formatting

Author: liam923

src/analysis/context.ml

@@ -97,8 +97,9 @@ let inspect_pattern (type a) ~cursor ~lid (p : a Typedtree.general_pattern) =
       Format.fprintf fmt "current pattern is: %a" (Printtyped.pattern 0) p);
   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_var (_, str_loc, _, _, _) when Longident.last lid = str_loc.txt -> None
+  | 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, ty) ->
-      { patt with pat_desc = Tpat_alias (f p, x, y, uid, m, ty) }
+    | Tpat_alias (p, x, y, uid, s, m, ty) ->
+      { patt with pat_desc = Tpat_alias (f p, x, y, uid, s, 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, ty) ->
-    { patt with pat_desc = Tpat_alias (f p, x, y, uid, m, ty) }
+  | Tpat_alias (p, x, y, uid, s, m, ty) ->
+    { patt with pat_desc = Tpat_alias (f p, x, y, uid, s, 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, ty) ->
-      Tpat_alias (qualify_constructors f p, id, loc, uid, m, ty)
+    | Tpat_alias (p, id, loc, uid, s, m, ty) ->
+      Tpat_alias (qualify_constructors f p, id, loc, uid, s, m, ty)
     | Tpat_tuple ps ->
       Tpat_tuple
         (List.map ps ~f:(fun (lbl, p) -> (lbl, qualify_constructors f p)))
@@ -532,7 +532,7 @@ let find_branch patterns sub =
       match patt.pat_desc with
       | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) ->
         false
-      | Tpat_alias (p, _, _, _, _, _)
+      | Tpat_alias (p, _, _, _, _, _, _)
       | Tpat_variant (_, Some p, _)
       | Tpat_lazy p -> is_sub_patt p ~sub
       | Tpat_tuple lst ->
@@ -611,12 +611,12 @@ module Conv = struct
       in
       match pat.pat_desc with
       | Tpat_or (pa, pb, _) -> mkpat (Ppat_or (loop pa, loop pb))
-      | Tpat_var (_, ({ txt = "*extension*"; _ } as nm), _, _) ->
+      | Tpat_var (_, ({ txt = "*extension*"; _ } as nm), _, _, _) ->
         (* PR#7330 *)
         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

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

src/analysis/outline.ml

@@ -36,7 +36,7 @@ open Browse_raw
 open Browse_tree
 
 let id_of_patt = function
-  | { pat_desc = Tpat_var (id, _, _, _); _ } -> Some id
+  | { pat_desc = Tpat_var (id, _, _, _, _); _ } -> Some id
   | _ -> None
 
 let mk ?(children = []) ~location ~deprecated outline_kind outline_type id =

src/analysis/typedtree_utils.ml

@@ -25,9 +25,9 @@ let let_bound_vars bindings =
   List.filter_map
     ~f:(fun value_binding ->
       match value_binding.Typedtree.vb_pat.pat_desc with
-      | Tpat_var (id, loc, _, _) -> Some (id, loc)
+      | 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 _
@@ -66,10 +66,10 @@ let location_of_declaration ~uid =
   | Class_type ctd -> Some ctd.ci_id_name
 
 let pat_var_id_and_loc = function
-  | Typedtree.{ pat_desc = Tpat_var (id, loc, _, _); _ } -> Some (id, loc)
+  | Typedtree.{ pat_desc = Tpat_var (id, loc, _, _, _); _ } -> Some (id, loc)
   | _ -> 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

@@ -626,7 +626,11 @@ let ocaml_ignored_flags =
     "-keep-llvmir";
     "-llvm-path";
     "-ddwarf-types";
-    "-ocamlcfg"
+    "-ocamlcfg";
+    "-cfg-prologue-validate";
+    "-no-cfg-prologue-validate";
+    "-cfg-prologue-shrink-wrap";
+    "-no-cfg-prologue-shrink-wrap"
   ]
 
 let ocaml_ignored_parametrized_flags =
@@ -705,7 +709,8 @@ let ocaml_ignored_parametrized_flags =
     "-save-ir-before";
     "-shape-format";
     "-gdwarf-compression";
-    "-gdwarf-fission"
+    "-gdwarf-fission";
+    "-cfg-prologue-shrink-wrap-threshold"
   ]
 
 let ocaml_warnings_spec ~error =

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
@@ -806,9 +806,9 @@ let pattern_paths (type k) { Typedtree.pat_desc; pat_extra; _ } =
     match (pat_desc : k pattern_desc) with
     | Tpat_construct (lid_loc, { Types.cstr_name; cstr_res; _ }, _, _) ->
       fake_path lid_loc cstr_res cstr_name
-    | Tpat_var (id, { Location.loc; txt }, _, _) ->
+    | 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/merlin_specific/tast_helper.ml

@@ -21,9 +21,10 @@ module Pat = struct
       | None -> str.Asttypes.loc
       | Some loc -> loc
     in
+    let sort = Jkind.Sort.new_var () in
     let mode = Mode.Value.newvar () in
     let pat_desc =
-      Tpat_var (Ident.create_local str.Asttypes.txt, str, uid, mode)
+      Tpat_var (Ident.create_local str.Asttypes.txt, str, uid, sort, mode)
     in
     { pat_desc;
       pat_loc;

src/ocaml/typing/jkind_intf.ml

@@ -131,6 +131,16 @@ module type Sort = sig
     val for_tuple : t
 
     val for_idx : t
+
+    val for_loop_index : t
+
+    val for_constructor : t
+
+    val for_module_field : t
+
+    val for_boxed_variant : t
+
+    val for_exception : t
   end
 
   module Var : sig

src/ocaml/typing/jkind_types.ml

@@ -202,6 +202,16 @@ module Sort = struct
     let for_list_element = value
 
     let for_idx = bits64
+
+    let for_loop_index = value
+
+    let for_constructor = value
+
+    let for_module_field = value
+
+    let for_boxed_variant = value
+
+    let for_exception = value
   end
 
   module Var = struct