Add type hovers for jkinds

Author: liam923

src/analysis/type_enclosing.ml

@@ -9,6 +9,7 @@ type type_info =
   | Type of Env.t * Types.type_expr
   | Type_decl of Env.t * Ident.t * Types.type_declaration
   | Type_constr of Env.t * Types.constructor_description
+  | Jkind of Env.t * Types.jkind_lr
   | String of string
 
 type typed_enclosings =
@@ -34,6 +35,10 @@ let print_type ~verbosity type_info =
     wrap_printing_env env (fun () ->
         Printtyp.modtype env ppf m;
         Format.flush_str_formatter ())
+  | Jkind (env, jkind) ->
+    wrap_printing_env env (fun () ->
+        Jkind.format_expanded ppf jkind;
+        Format.flush_str_formatter ())
   | String s -> s
 
 let from_nodes ~path =
@@ -57,6 +62,21 @@ let from_nodes ~path =
     | Module_declaration_name { md_type = { mty_type = m } }
     | Module_type_declaration_name { mtd_type = Some { mty_type = m } } ->
       ret (Modtype (env, m))
+    | Jkind_annotation annot -> (
+      (* CR-someday: We need to parse the annotation because the compiler doesn't include
+         the parsed jkind in the relevant spots. We should track it so that this is less
+         hacky. It would also make it easier to deal with with-bounds. *)
+      (* [Jkind.of_annotation] will fail to parse jkinds with with-bounds. For now, this
+         isn't important. Usually, users will be hovering a jkind to know what an
+         abbreviation means. *)
+      try
+        (* The context isn't important. It's just used for printing error messages, which
+           we immediately discard anyways. *)
+        let jkind =
+          Jkind.of_annotation ~context:(Type_variable "fake_for_merlin") annot
+        in
+        ret (Jkind (env, jkind))
+      with Jkind.Error.User_error _ -> None)
     | Class_field
         { cf_desc = Tcf_method (_, _, Tcfk_concrete (_, { exp_type })) } ->
     begin

src/analysis/type_enclosing.mli

@@ -39,6 +39,7 @@ type type_info =
   | Type of Env.t * Types.type_expr
   | Type_decl of Env.t * Ident.t * Types.type_declaration
   | Type_constr of Env.t * Types.constructor_description
+  | Jkind of Env.t * Types.jkind_lr
   | String of string
 
 type typed_enclosings =

src/ocaml/typing/jkind.ml

@@ -1843,15 +1843,15 @@ module Const = struct
   end
 
   module To_out_jkind_const : sig
-    (** Convert a [t] into a [Outcometree.out_jkind_const].
-        The jkind is written in terms of the built-in jkind that requires the
-        least amount of modes after the mod. For example, [value mod global many
-        unique portable uncontended external_ non_null] could be written in
-        terms of [value] (as it appears above), or in terms of [immediate]
-        (which would just be [immediate]). Since the latter requires less modes
-        to be printed, it is chosen.
+    (** Convert a [t] into a [Outcometree.out_jkind_const]. If [expanded] is
+        [false], the jkind is written in terms of the built-in jkind that
+        requires the least amount of modes after the mod. For example,
+        [value mod global many unique portable uncontended external_ non_null]
+        could be written in terms of [value] (as it appears above), or in terms
+        of [immediate] (which would just be [immediate]). Since the latter
+        requires less modes to be printed, it is chosen.
     *)
-    val convert : 'd t -> Outcometree.out_jkind_const
+    val convert : expanded:bool -> 'd t -> Outcometree.out_jkind_const
   end = struct
     type printable_jkind =
       { base : string;
@@ -1982,15 +1982,18 @@ module Const = struct
       | [out] -> Some out
       | [] -> None
 
-    let convert jkind =
+    let convert ~expanded jkind =
       (* For each primitive jkind, we try to print the jkind in terms of it
          (this is possible if the primitive is a subjkind of it). We then choose
          the "simplest". The "simplest" is taken to mean the one with the least
          number of modes that need to follow the [mod]. *)
       let simplest =
-        Builtin.all
-        |> List.filter_map (fun base -> convert_with_base ~base jkind)
-        |> select_simplest
+        match expanded with
+        | false ->
+          Builtin.all
+          |> List.filter_map (fun base -> convert_with_base ~base jkind)
+          |> select_simplest
+        | true -> None
       in
       let printable_jkind =
         match simplest with
@@ -2052,10 +2055,11 @@ module Const = struct
         base with_tys
   end
 
-  let to_out_jkind_const jkind = To_out_jkind_const.convert jkind
+  let to_out_jkind_const jkind =
+    To_out_jkind_const.convert ~expanded:false jkind
 
-  let format ppf jkind =
-    To_out_jkind_const.convert jkind |> !Oprint.out_jkind_const ppf
+  let format ~expanded ppf jkind =
+    To_out_jkind_const.convert ~expanded jkind |> !Oprint.out_jkind_const ppf
 
   (*******************************)
   (* converting user annotations *)
@@ -2181,7 +2185,7 @@ module Desc = struct
   (* CR layouts v2.8: This will probably need to be overhauled with
      [with]-types. See also [Printtyp.out_jkind_of_desc], which uses the same
      algorithm. Internal ticket 5096. *)
-  let format ppf t =
+  let format_maybe_expanded ~expanded ppf t =
     let open Format in
     let rec format_desc ~nested ppf (desc : _ t) =
       match desc.layout with
@@ -2194,10 +2198,12 @@ module Desc = struct
           (List.map (fun layout -> { desc with layout }) lays)
       | _ -> (
         match get_const desc with
-        | Some c -> Const.format ppf c
+        | Some c -> Const.format ~expanded ppf c
         | None -> assert false (* handled above *))
     in
     format_desc ppf ~nested:false t
+
+  let format ppf t = format_maybe_expanded ~expanded:false ppf t
 end
 
 module Jkind_desc = struct
@@ -3007,7 +3013,12 @@ let decompose_product ({ jkind; _ } as jk) =
    doing so, because it teaches the user that e.g. [value mod local] is better
    off spelled [value]. Possibly remove [jkind.annotation], but only after
    we have a proper printing story. Internal ticket 5096. *)
-let format ppf jkind = Desc.format ppf (Jkind_desc.get jkind.jkind)
+let format_maybe_expanded ~expanded ppf jkind =
+  Desc.format_maybe_expanded ~expanded ppf (Jkind_desc.get jkind.jkind)
+
+let format ppf jkind = format_maybe_expanded ~expanded:false ppf jkind
+
+let format_expanded ppf jkind = format_maybe_expanded ~expanded:true ppf jkind
 
 let printtyp_path = ref (fun _ _ -> assert false)
 

src/ocaml/typing/jkind.mli

@@ -747,6 +747,10 @@ val set_raw_type_expr : (Format.formatter -> Types.type_expr -> unit) -> unit
 
 val format : Format.formatter -> 'd Types.jkind -> unit
 
+(** Similar to [format], but the kind is expanded as much as possible rather
+    than written in terms of a kind abbreviation. This is used by Merlin. *)
+val format_expanded : Format.formatter -> 'd Types.jkind -> unit
+
 (** Format the history of this jkind: what interactions it has had and why
     it is the jkind that it is. Might be a no-op: see [display_histories]
     in the implementation of the [Jkind] module.
@@ -876,3 +880,11 @@ module Debug_printers : sig
     val t : Format.formatter -> 'd Const.t -> unit
   end
 end
+
+(* For Merlin *)
+
+module Error : sig
+  type t
+  
+  exception User_error of Location.t * t
+end

tests/test-dirs/type-enclosing/jkind-hover.t

@@ -0,0 +1,70 @@
+Test that hovering over jkind annotations shows their full expansion.
+
+  $ file="test.ml"
+
+  $ print_merlin_result () {
+  >   result="$1"
+  >   line=$(echo "$result" | jq '.start.line')
+  >   start=$(echo "$result" | jq '.start.col')
+  >   end=$(echo "$result" | jq '.end.col')
+  >   
+  >   start_for_cut=$((start + 1))
+  >   end_for_cut=$((end + 1))
+  >   value=$(sed -n "${line}p" "$file" | cut -c "${start_for_cut}-${end_for_cut}")
+  >   type=$(echo "$result" | jq '.type' -r)
+  >   echo "\"$value\" : \"$type\""
+  > }
+
+  $ hover () {
+  >   line="$1"
+  >   col="$2"
+  >   enclosings="$3"
+  >   
+  >   # Print the location we are hovering
+  >   sed -n "${line}p" "$file"
+  >   printf '%*s^\n' "$col" ''
+  >   
+  >   # Then print the output from Merlin
+  >   $MERLIN single type-enclosing -position "$line:$col" -filename "$file" < "$file" \
+  >     | jq -c ".value[:$enclosings][]" \
+  >     | while read -r result; do
+  >         print_merlin_result "$result"
+  >       done
+  > }
+
+  $ cat > "$file" << EOF
+  > type t1 : immutable_data
+  > type t2 : value mod portable
+  > type ('a : immediate) t3 : value
+  > type 'a t4 : immutable_data mod global with 'a
+  > EOF
+
+  $ hover 1 14 1
+  type t1 : immutable_data
+                ^
+  "immutable_data" : "value mod many forkable unyielding stateless immutable non_float"
+
+  $ hover 2 11 2
+  type t2 : value mod portable
+             ^
+  "value " : "value"
+  "value mod portable" : "value mod portable"
+
+  $ hover 3 16 1
+  type ('a : immediate) t3 : value
+                  ^
+  "immediate)" : "value mod global aliased many stateless immutable external_ non_float"
+
+  $ hover 3 28 2
+  type ('a : immediate) t3 : value
+                              ^
+  "value" : "value"
+  "type ('a : immediate) t3 : value" : "type ('a : immediate) t3"
+
+# CR-someday: It'd be nice to print the with-bounds when we enclose the whole jkind
+  $ hover 4 20 3
+  type 'a t4 : immutable_data mod global with 'a
+                      ^
+  "immutable_data " : "value mod many forkable unyielding stateless immutable non_float"
+  "immutable_data mod global " : "value mod global many stateless immutable non_float"
+  "type 'a t4 : immutable_data mod global with 'a" : "type 'a t4 : immutable_data mod global yielding unforkable with 'a"