Merge 5.2.0minus-19 (#185)

* Import ocaml sources for oxcaml/oxcaml@951524cd4f4e

* Automatic merges

* Add typing/mode_hint.mli

* Commit conflicts

* Resolve easy conflicts

* Fix some type errors

* Changes for new shapes

* Fixup errors in lexer

* Fix typing errors

* Fixup syntax_doc

* Bump magic numbers

* Fix tests

* Add ignored flags

* Import ocaml sources for oxcaml/oxcaml@c2a3ea6fbd0b

* Automatic merges

* Disable warning 47

* Use MB.of_int

Author: liam923

src/analysis/construct.ml

@@ -521,7 +521,7 @@ module Gen = struct
                   val_loc = Location.none;
                   val_attributes = [];
                   val_zero_alloc = Zero_alloc.default;
-                  val_modalities = Mode.Modality.Value.id;
+                  val_modalities = Mode.Modality.id;
                   val_uid = Uid.mk ~current_unit:(Env.get_unit_name ())
                 }
               in

src/analysis/index_occurrences.ml

@@ -91,9 +91,9 @@ let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid =
 
 let items ~index ~stamp (config : Mconfig.t) items =
   let module Shape_reduce = Shape_reduce.Make (struct
-    let fuel = 10
+    let fuel () = Misc_stdlib.Maybe_bounded.of_int 10
 
-    let read_unit_shape ~unit_name =
+    let read_unit_shape ~diagnostics:_ ~unit_name =
       log ~title:"read_unit_shape" "inspecting %s" unit_name;
       let read unit_name =
         let cms = Format.sprintf "%s.cms" unit_name in
@@ -112,6 +112,12 @@ let items ~index ~stamp (config : Mconfig.t) items =
       | None ->
         log ~title:"read_unit_shape" "failed to find %s" unit_name;
         None
+
+    let projection_rules_for_merlin_enabled = true
+    let fuel_for_compilation_units () : Misc_stdlib.Maybe_bounded.t = Unbounded
+    let max_shape_reduce_steps_per_variable () : Misc_stdlib.Maybe_bounded.t =
+      Unbounded
+    let max_compilation_unit_depth () : Misc_stdlib.Maybe_bounded.t = Unbounded
   end) in
   let current_buffer_path =
     Filename.concat config.query.directory config.query.filename

src/analysis/locate.ml

@@ -880,8 +880,8 @@ let get_linked_uids ~config ~comp_unit decl_uid =
 let find_definition_uid ~config ~env ~(decl : Env_lookup.item) path =
   let namespace = decl.namespace in
   let module Reduce = Shape_reduce.Make (struct
-    let fuel = 10
-    let read_unit_shape ~unit_name =
+    let fuel () = Misc_stdlib.Maybe_bounded.of_int 10
+    let read_unit_shape ~diagnostics:_ ~unit_name =
       log ~title:"read_unit_shape" "inspecting %s" unit_name;
       match
         load_cmt
@@ -895,6 +895,12 @@ let find_definition_uid ~config ~env ~(decl : Env_lookup.item) path =
       | Error () ->
         log ~title:"read_unit_shape" "failed to find %s" unit_name;
         None
+
+    let projection_rules_for_merlin_enabled = true
+    let fuel_for_compilation_units () : Misc_stdlib.Maybe_bounded.t = Unbounded
+    let max_shape_reduce_steps_per_variable () : Misc_stdlib.Maybe_bounded.t =
+      Unbounded
+    let max_compilation_unit_depth () : Misc_stdlib.Maybe_bounded.t = Unbounded
   end) in
   let shape = Env.shape_of_path ~namespace env path in
   log ~title:"shape_of_path" "initial: %a" Logger.fmt

src/analysis/ptyp_of_type.ml

@@ -163,7 +163,7 @@ and value_description id
     { val_type; val_kind = _; val_loc; val_attributes; val_modalities; _ } =
   let type_ = core_type val_type in
   let snap = Btype.snapshot () in
-  let modalities = Mode.Modality.Value.zap_to_id val_modalities in
+  let modalities = Mode.Modality.zap_to_id val_modalities in
   Btype.backtrack snap;
   { Parsetree.pval_name = var_of_id id;
     pval_type = type_;

src/analysis/stack_or_heap_enclosing.ml

@@ -43,7 +43,7 @@ let from_nodes ~lsp_compat ~pos ~path =
          value binding. However, the LSP hover at this point will describe just the
          pattern, so we don't override the location in the [lsp_compat] regime. *)
       let loc = if lsp_compat then None else Some vb_loc in
-      ret ?loc (Alloc_mode alloc_mode.mode)
+      ret ?loc (Alloc_mode alloc_mode)
     | Expression { exp_desc; _ }, _ -> (
       match exp_desc with
       | Texp_function { alloc_mode; body; _ } -> (
@@ -76,8 +76,8 @@ let from_nodes ~lsp_compat ~pos ~path =
         in
         match body_loc with
         | Some loc when cursor_is_inside loc -> None
-        | _ -> ret (Alloc_mode alloc_mode.mode))
-      | Texp_array (_, _, _, alloc_mode) -> ret (Alloc_mode alloc_mode.mode)
+        | _ -> ret (Alloc_mode alloc_mode))
+      | Texp_array (_, _, _, alloc_mode) -> ret (Alloc_mode alloc_mode)
       | Texp_construct
           ({ loc; txt = _lident }, { cstr_repr; _ }, args, maybe_alloc_mode)
         -> (
@@ -89,7 +89,7 @@ let from_nodes ~lsp_compat ~pos ~path =
           if lsp_compat && cursor_is_inside loc then Some loc else None
         in
         match maybe_alloc_mode with
-        | Some alloc_mode -> ret ?loc (Alloc_mode alloc_mode.mode)
+        | Some alloc_mode -> ret ?loc (Alloc_mode alloc_mode)
         | None -> (
           match args with
           | [] -> ret_no_alloc ?loc "constructor without arguments"
@@ -102,18 +102,18 @@ let from_nodes ~lsp_compat ~pos ~path =
       | Texp_record { representation; alloc_mode = maybe_alloc_mode; _ } -> (
         match (maybe_alloc_mode, representation) with
         | _, Record_inlined _ -> None
-        | Some alloc_mode, _ -> ret_alloc alloc_mode.mode
+        | Some alloc_mode, _ -> ret_alloc alloc_mode
         | None, Record_unboxed -> ret_no_alloc "unboxed record"
         | None, (Record_boxed _ | Record_float | Record_ufloat | Record_mixed _)
           -> ret Unexpected_no_alloc)
       | Texp_field (_, _, _, _, boxed_or_unboxed, _) -> (
         match boxed_or_unboxed with
-        | Boxing (alloc_mode, _) -> ret_alloc alloc_mode.mode
+        | Boxing (alloc_mode, _) -> ret_alloc alloc_mode
         | Non_boxing _ -> None)
       | Texp_variant (_, maybe_exp_and_alloc_mode) ->
         maybe_exp_and_alloc_mode
         |> Option.map ~f:(fun (_, (alloc_mode : Typedtree.alloc_mode)) ->
-               alloc_mode.mode)
+               alloc_mode)
         |> ret_maybe_alloc "variant without argument"
       | _ -> None)
     | _ -> None

src/analysis/syntax_doc.ml

@@ -143,7 +143,7 @@ let get_mod_bound_doc mod_bound =
       | Everything
   end in
   let* parsed =
-    match Typemode.Axis_pair.of_string mod_bound with
+    match Typemode.Modifier_axis_pair.of_string mod_bound with
     | exception Not_found -> (
       match mod_bound with
       | "everything" -> Some Everything
@@ -200,24 +200,17 @@ let get_mod_bound_doc mod_bound =
      }
     : syntax_info)
 
-module Modal_axis_pair = struct
-  type t = P : 'a Mode.Value.Axis.t * 'a -> t
-
-  let of_string s =
-    match Typemode.Axis_pair.of_string s with
-    | exception Not_found -> None
-    | P (Modal axis, mode) -> Some (P (axis, mode))
-    | P (Nonmodal _, _) -> None
-end
-
 let get_mode_doc mode =
   let open Option.Infix in
-  let* (P (axis, mode)) = Modal_axis_pair.of_string mode in
+  let* (P (axis, mode)) =
+    match Typemode.Mode_axis_pair.of_string mode with
+    | exception Not_found -> None
+    | res -> Some res
+  in
   let* description =
     match (axis, mode) with
     | Comonadic Areality, Local ->
       Some "Values with this mode cannot escape the current region"
-    | Comonadic Areality, Regional -> None
     | Comonadic Areality, Global ->
       Some "Values with this mode can escape any region"
     | Monadic Contention, Contended ->
@@ -287,7 +280,11 @@ let get_mode_doc mode =
 
 let get_modality_doc modality =
   let open Option.Infix in
-  let* (P (axis, _)) = Modal_axis_pair.of_string modality in
+  let* (P (axis, _)) =
+    match Typemode.Modality_axis_pair.of_string modality with
+    | exception Not_found -> None
+    | res -> Some res
+  in
   let description =
     (* CR-someday: Detect the context that the modality is within to make this message
        more detailed. Ex: "This field is always stronger than _, even if the record has a

src/kernel/mconfig.ml

@@ -630,7 +630,9 @@ let ocaml_ignored_flags =
     "-cfg-prologue-validate";
     "-no-cfg-prologue-validate";
     "-cfg-prologue-shrink-wrap";
-    "-no-cfg-prologue-shrink-wrap"
+    "-no-cfg-prologue-shrink-wrap";
+    "-gdwarf-pedantic";
+    "-ddwarf-metrics"
   ]
 
 let ocaml_ignored_parametrized_flags =
@@ -710,7 +712,16 @@ let ocaml_ignored_parametrized_flags =
     "-shape-format";
     "-gdwarf-compression";
     "-gdwarf-fission";
-    "-cfg-prologue-shrink-wrap-threshold"
+    "-cfg-prologue-shrink-wrap-threshold";
+    "-gdwarf-config-shape-reduce-depth";
+    "-gdwarf-config-shape-eval-depth";
+    "-gdwarf-config-max-cms-files-per-unit";
+    "-gdwarf-config-max-cms-files-per-variable";
+    "-gdwarf-config-max-type-to-shape-depth";
+    "-gdwarf-config-max-shape-reduce-steps-per-variable";
+    "-gdwarf-config-max-evaluation-steps-per-variable";
+    "-gdwarf-config-shape-reduce-fuel";
+    "-gdwarf-fidelity"
   ]
 
 let ocaml_warnings_spec ~error =

src/kernel/mtyper.ml

@@ -40,7 +40,7 @@ type typedtree_items =
   | Interface_items of
       { items : (Parsetree.signature_item, Typedtree.signature_item) item list;
         psig_modalities : Parsetree.modalities;
-        sig_modalities : Mode.Modality.Value.Const.t;
+        sig_modalities : Mode.Modality.Const.t;
         sig_sloc : Location.t
       }
   | Implementation_items of

src/ocaml-index/lib/index.ml

@@ -50,7 +50,7 @@ module Reduce_conf (Loaded_shapes : sig
   val shapes : (Compilation_unit.t, Shape.t) Hashtbl.t
 end) =
 struct
-  let fuel = 10
+  let fuel () = Misc_stdlib.Maybe_bounded.of_int 10
 
   let try_load ~unit_name () =
     match
@@ -83,9 +83,15 @@ struct
       | Some artifact -> Merlin_analysis.Locate.Artifact.impl_shape artifact
     end
 
-  let read_unit_shape ~unit_name =
+  let read_unit_shape ~diagnostics:_ ~unit_name =
     Log.debug "Read unit shape: %s\n%!" unit_name;
     try_load ~unit_name ()
+
+  let projection_rules_for_merlin_enabled = true
+  let fuel_for_compilation_units () : Misc_stdlib.Maybe_bounded.t = Unbounded
+  let max_shape_reduce_steps_per_variable () : Misc_stdlib.Maybe_bounded.t =
+    Unbounded
+  let max_compilation_unit_depth () : Misc_stdlib.Maybe_bounded.t = Unbounded
 end
 
 let init_load_path_once ~do_not_use_cmt_loadpath =

src/ocaml/parsing/ast_mapper.ml

@@ -102,6 +102,7 @@ module C = struct
     | Pconst_integer _
     | Pconst_unboxed_integer _
     | Pconst_char _
+    | Pconst_untagged_char _
     | Pconst_float _
     | Pconst_unboxed_float _
       -> c