Not very good

src/analysis/outline.ml

@@ -51,7 +51,7 @@ let get_class_field_desc_infos = function
 let outline_type ~env typ =
   let ppf, to_string = Format.to_string () in
   Printtyp.wrap_printing_env env (fun () ->
-    Type_utils.print_type_with_decl ~verbosity:(Mconfig.Verbosity.Lvl 0) env ppf typ);
+    Type_utils.print_type_with_decl ~verbosity:(Mconfig.Verbosity.Lvl 0) env ppf typ None);
   Some (to_string ())
 
 let rec summarize node =

src/analysis/type_enclosing.ml

@@ -5,7 +5,7 @@ let {Logger.log} = Logger.for_section log_section
 
 type type_info =
   | Modtype of Env.t * Types.module_type
-  | Type of Env.t * Types.type_expr
+  | Type of Env.t * Types.type_expr * Mode.Value.t option
   | Type_decl of Env.t * Ident.t * Types.type_declaration
   | String of string
 
@@ -17,11 +17,13 @@ let from_nodes ~path =
     let open Browse_raw in
     let ret x = Some (Mbrowse.node_loc node, x, tail) in
     match[@ocaml.warning "-9"] node with
-    | Expression {exp_type = t}
+    | Expression exp ->
+        let mode = Typecore.lookup_mode_for_merlin exp in
+        ret (Type (env, exp.exp_type, mode))
     | Pattern {pat_type = t}
     | Core_type {ctyp_type = t}
     | Value_description { val_desc = { ctyp_type = t } } ->
-      ret (Type (env, t))
+      ret (Type (env, t, None))
     | Type_declaration { typ_id = id; typ_type = t} ->
       ret (Type_decl (env, id, t))
     | Module_expr {mod_type = Types.Mty_for_hole} -> None
@@ -41,20 +43,20 @@ let from_nodes ~path =
                Tcfk_concrete
                  (_, {exp_type})) } ->
       begin match Types.get_desc exp_type with
-        | Tarrow (_, _, t, _) -> ret (Type (env, t))
+        | Tarrow (_, _, t, _) -> ret (Type (env, t, None))
         | _ -> None
       end
     | Class_field
         { cf_desc =
             Tcf_val (_, _, _, Tcfk_concrete (_, {exp_type = t }), _) } ->
-      ret (Type (env, t))
+      ret (Type (env, t, None))
     | Class_field { cf_desc =
                       Tcf_method (_, _, Tcfk_virtual {ctyp_type = t }) } ->
-      ret (Type (env, t))
+      ret (Type (env, t, None))
     | Class_field { cf_desc =
                       Tcf_val (_, _, _, Tcfk_virtual {ctyp_type = t }, _) } ->
-      ret (Type (env, t))
-    | Binding_op { bop_op_type; _ } -> ret (Type(env, bop_op_type))
+      ret (Type (env, t, None))
+    | Binding_op { bop_op_type; _ } -> ret (Type(env, bop_op_type, None))
     | _ -> None
   in
   List.filter_map ~f:aux path
@@ -106,7 +108,7 @@ let from_reconstructed ~nodes ~cursor ~verbosity exprs =
       | Some (Context.Label { lbl_name; lbl_arg; _ }) ->
         log ~title:"from_reconstructed" "ctx: label %s" lbl_name;
         let ppf, to_string = Format.to_string () in
-        Type_utils.print_type_with_decl ~verbosity env ppf lbl_arg;
+        Type_utils.print_type_with_decl ~verbosity env ppf lbl_arg None;
         Some (loc, String (to_string ()), `No)
       | Some Context.Constant -> None
       | _ ->

src/analysis/type_enclosing.mli

@@ -36,7 +36,7 @@ val log_section : string
 
 type type_info =
   | Modtype of Env.t * Types.module_type
-  | Type of Env.t * Types.type_expr
+  | Type of Env.t * Types.type_expr * Mode.Value.t option
   | Type_decl of Env.t * Ident.t * Types.type_declaration
   | String of string
 

src/analysis/type_utils.ml

@@ -204,7 +204,7 @@ let print_short_modtype verbosity env ppf md  =
   | _ ->
     Printtyp.modtype env ppf md
 
-let print_type_with_decl ~verbosity env ppf typ =
+let print_type_with_decl ~verbosity env ppf typ mode =
   match verbosity with
   | Verbosity.Smart | Lvl 0 ->  Printtyp.type_scheme env ppf typ
   | Lvl _ -> begin
@@ -217,8 +217,14 @@ let print_type_with_decl ~verbosity env ppf typ =
       let is_abstract = Btype.type_kind_is_abstract decl in
       (* Print expression only if it is parameterized or abstract *)
       let print_expr = is_abstract || params <> [] in
-      if print_expr then
-        Printtyp.type_scheme env ppf typ;
+      if print_expr then begin
+        match mode with
+        | None -> Printtyp.type_scheme env ppf typ
+        | Some mode ->
+            fprintf ppf "%a @@ %a"
+              (Printtyp.type_scheme env) typ
+              Mode.Regionality.Const.print (Mode.Value.constrain_upper mode).locality
+      end;
       (* If not abstract, also print the declaration *)
       if not is_abstract then
         begin
@@ -290,7 +296,7 @@ let type_in_env ?(verbosity=Verbosity.default) ?keywords ~context env ppf expr =
     let open Typedtree in
     match str.str_items with
     | [ { str_desc = Tstr_eval (exp,_,_); _ }] ->
-      print_type_with_decl ~verbosity env ppf exp.exp_type
+      print_type_with_decl ~verbosity env ppf exp.exp_type None
     | _ -> failwith "unhandled expression"
   in
   Printtyp.wrap_printing_env env ~verbosity @@ fun () ->

src/analysis/type_utils.mli

@@ -65,6 +65,7 @@ val print_type_with_decl :
   -> Env.t
   -> Format.formatter
   -> Types.type_expr
+  -> Mode.Value.t option
   -> unit
 (** [print_type_or_decl] behaves like [Printtyp.type_scheme], it prints the
     type expression, except if it is a type constructor and verbosity is set then

src/frontend/query_commands.ml

@@ -321,9 +321,9 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
           let ret x = (loc, x, tail) in
           match text with
           | Type_enclosing.String str -> ret (`String str)
-          | Type_enclosing.Type (env, t) when print ->
+          | Type_enclosing.Type (env, t, mode) when print ->
             Printtyp.wrap_printing_env env ~verbosity
-              (fun () -> Type_utils.print_type_with_decl ~verbosity env ppf t);
+              (fun () -> Type_utils.print_type_with_decl ~verbosity env ppf t mode);
             ret (`String (Format.flush_str_formatter ()))
           | Type_enclosing.Type_decl (env, id, t) when print ->
             Printtyp.wrap_printing_env env ~verbosity
@@ -599,7 +599,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
     let print ~nodes loc env type_ () =
       match type_ with
       | `Exp type_expr ->
-        Type_utils.print_type_with_decl ~verbosity env ppf type_expr
+        Type_utils.print_type_with_decl ~verbosity env ppf type_expr None
       | `Mod module_type ->
         (* For module_expr holes we need the type of the next enclosing
           to get a useful result *)

src/ocaml/typing/mode.mli

@@ -81,6 +81,8 @@ module Regionality : sig
       | Global
       | Regional
       | Local
+
+    val print : Format.formatter -> t -> unit
   end
 
   type t

src/ocaml/typing/typecore.ml

@@ -222,6 +222,31 @@ let error_of_filter_arrow_failure ~explanation ~first ty_fun
     end
   | Jkind_error (ty, err) -> Function_type_not_rep (ty, err)
 
+
+let stored_modes_for_merlin :
+  (Location.t, (expression * Mode.Value.t) list) Hashtbl.t =
+  Hashtbl.create 1024
+
+(* merlin: store modes keyed by location then by physical equality of
+   expression. This is a mega hack. We do it because modes aren't stored on the
+   typedtree expression.
+*)
+let store_mode_for_merlin exp mode =
+  let mode_by_exp =
+    Option.value
+      (Hashtbl.find_opt stored_modes_for_merlin exp.exp_loc)
+      ~default:[]
+  in
+  Hashtbl.replace
+    stored_modes_for_merlin
+    exp.exp_loc
+    ((exp, mode) :: mode_by_exp)
+
+let lookup_mode_for_merlin exp =
+  match Hashtbl.find_opt stored_modes_for_merlin exp.exp_loc with
+  | None -> None
+  | Some assq_list -> List.assq_opt exp assq_list
+
 (* merlin: deep copy types in errors, to keep them meaningful after
    backtracking *)
 let deep_copy () =
@@ -4871,6 +4896,7 @@ and type_expect_
   let with_explanation = with_explanation explanation in
   (* Unify the result with [ty_expected], enforcing the current level *)
   let rue exp =
+    store_mode_for_merlin exp expected_mode.mode;
     with_explanation (fun () ->
       unify_exp ~sdesc_for_hint:desc env (re exp) (instance ty_expected));
     exp

src/ocaml/typing/typecore.mli

@@ -328,3 +328,5 @@ val partial_pred :
   type_expr ->
   Typedtree.pattern ->
   Typedtree.pattern option
+
+val lookup_mode_for_merlin : Typedtree.expression -> Mode.Value.t option

tests/test-dirs/type-enclosing/jane-street/modes.t

@@ -147,7 +147,7 @@
     match x with
           ^
   With verbosity 0: "string"
-  With verbosity 1: "string"
+  With verbosity 1: "string @ Local"
 
 (V) Larger expression that is local
 
@@ -164,28 +164,45 @@ in [modes.ml] it's clear enough what each of the types correspond
 to.
 
   $ diff "$verbosity0" "$verbosity1"
-  25c25,27
+  18a19,30
+  >         "col": 25
+  >       },
+  >       "end": {
+  >         "line": 66,
+  >         "col": 26
+  >       },
+  >       "type": "string @ Local",
+  >       "tail": "no"
+  >     },
+  >     {
+  >       "start": {
+  >         "line": 66,
+  25c37,39
   <       "type": "string option",
   ---
   >       "type": "string option
   > 
   > type 'a option = None | Some of 'a",
-  37c39,41
+  37c51,53
   <       "type": "string option option",
   ---
   >       "type": "string option option
   > 
   > type 'a option = None | Some of 'a",
-  49c53,55
+  49c65,67
   <       "type": "string option option option",
   ---
   >       "type": "string option option option
   > 
   > type 'a option = None | Some of 'a",
-  61c67,69
+  61c79,81
   <       "type": "string option option option option",
   ---
   >       "type": "string option option option option
   > 
   > type 'a option = None | Some of 'a",
+  73c93
+  <       "type": "string -> local_ string option option option option",
+  ---
+  >       "type": "string -> local_ once_ string option option option option",
   [1]