Merge branch 'main' into sig_help_looping_parameter

Author: Lucccyo

.github/workflows/flambda-backend.yml

@@ -72,9 +72,9 @@ jobs:
       if: steps.cache.outputs.cache-hit != 'true'
       working-directory: flambda-backend
       run: |
-        opam switch create 4.14.0 --yes
-        opam switch link 4.14.0 --yes
-        opam install --yes dune.3.19.1 menhir.20231231
+        opam switch create 5.4.0 --yes
+        opam switch link 5.4.0 --yes
+        opam install --yes dune.3.20.2 menhir.20231231
 
     - name: Configure, build, and install flambda-backend
       if: steps.cache.outputs.cache-hit != 'true'

CHANGES.md

@@ -10,6 +10,7 @@ unreleased
     - Add initial support for project-wide renaming: occurrences can now return
       all usages of all related definitions. (#1877)
     - Fix issues with ident validation and Lid comparison for occurrences (#1924)
+    - Fix record field autocompletion (https://github.com/ocaml/merlin/pull/2028)
   + ocaml-index
     - Bump magic number after index file format change. Index can now be read lazilly (#1886)
 

doc/dev/PROTOCOL.md

@@ -544,6 +544,54 @@ The type is described in another file, and the result will be the following obje
 }
 ```
 
+### `locate-types -position <position>`
+
+	-position <position>  The position of the type to be located
+
+Checks the type of the item at the given position. Unlike `locate-type`, if the type is
+expressed via multiple paths (ex: the type is `int list` or `(int foo * string) -> unit`),
+it will return a tree that represents the type. Each entry in the tree will contains the
+definition location of that type.
+
+The below schema defines the response object (where `response` is the type of the object
+returned):
+```javascript
+response = tree | "Invalid context"
+
+tree = {
+  "data": node_data,
+  "children": [tree]
+}
+
+node_data =
+  | [ "Arrow" ]
+  | [ "Tuple" ]
+  | [ "Object" ]
+  | [ "Poly_variant" ]
+  | [ "Type_ref", { "type": string, "result": [ "Found", file, position ] } ]
+
+file = string
+
+position = {
+  "pos_fname": string,
+  "pos_lnum": int,
+  "pos_bol": int,
+  "pos_cnum": int
+}
+```
+
+The type is described in another file, and the result will be the following object:
+
+```javascript
+{
+  'file': string, // the file where the type is defined
+  'pos': {
+    'start': position, // the start of the region where the type is defined
+	'end': position // the end of the region where the type is defined
+  }
+}
+```
+
 ### `signature-help -position <position>`
 
 	-position <position>  The position where to request additional information for signature help

src/analysis/completion.ml

@@ -136,7 +136,7 @@ let classify_node = function
   | Open_declaration _ -> `Module
   | Include_declaration _ -> `Module
   | Include_description _ -> `Module
-  | Mode _ | Modality _ ->
+  | Mode _ | Modality _ | Mod_bound _ ->
     (* CR-someday: Have proper completion for modes and modalities *)
     `Expression
   | Jkind_annotation _ ->

src/analysis/construct.ml

@@ -223,11 +223,11 @@ module Gen = struct
     | Mty_signature sig_items ->
       let env = Env.add_signature sig_items env in
       Mod.structure @@ structure env sig_items
-    | Mty_functor (param, out) ->
+    | Mty_functor (param, out, _) ->
       let param =
         match param with
         | Unit -> Parsetree.Unit
-        | Named (id, in_) ->
+        | Named (id, in_, _) ->
           Parsetree.Named
             ( Location.mknoloc (Option.map ~f:Ident.name id),
               Ptyp_of_type.module_type in_,
@@ -524,7 +524,7 @@ module Gen = struct
                   val_loc = Location.none;
                   val_attributes = [];
                   val_zero_alloc = Zero_alloc.default;
-                  val_modalities = Mode.Modality.id;
+                  val_modalities = Mode.Modality.(of_const Const.id);
                   val_uid = Uid.mk ~current_unit:(Env.get_unit_name ())
                 }
               in

src/analysis/context.ml

@@ -122,7 +122,7 @@ let inspect_expression ~cursor ~lid e : t =
         Constructor (cd, lid_loc.loc)
       else Module_path
     else Module_path
-  | Texp_ident (p, lid_loc, _, _, _) ->
+  | Texp_ident (p, lid_loc, _, _, _, _) ->
     let name = Path.last p in
     log ~title:"inspect_context" "name is: [%s]" name;
     if name = "*type-error*" then

src/analysis/destruct.ml

@@ -308,7 +308,7 @@ let rec get_every_pattern loc = function
       (* We are still in the same branch, going up. *)
       get_every_pattern loc parents
     | Expression
-        { exp_desc = Typedtree.Texp_ident (Path.Pident id, _, _, _, _); _ }
+        { exp_desc = Typedtree.Texp_ident (Path.Pident id, _, _, _, _, _); _ }
       when Ident.name id = "*type-error*" -> raise Ill_typed
     | Expression { exp_desc = Typedtree.Texp_function { params; _ }; _ } ->
     begin

src/analysis/inlay_hints.ml

@@ -13,7 +13,7 @@ let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) =
       | Typedtree.Tpat_constraint _ -> true
       | Typedtree.Tpat_type (_, _)
       | Typedtree.Tpat_open (_, _, _)
-      | Typedtree.Tpat_unpack -> false)
+      | Typedtree.Tpat_unpack | Typedtree.Tpat_inspected_type _ -> false)
     pattern.pat_extra
 
 let structure_iterator hint_let_binding hint_pattern_binding

src/analysis/kind_enclosing.ml

@@ -0,0 +1,80 @@
+open Std
+open Type_utils
+
+module Kind_info = struct
+  type t = { kind : Types.jkind_l; env : Env.t }
+
+  let mk ~kind ~env = { kind; env }
+
+  let from_type ~env ty = { kind = Ctype.estimate_type_jkind env ty; env }
+
+  let to_string ~(verbosity : Mconfig.Verbosity.t) { kind; env } =
+    let kind =
+      Jkind.normalize ~mode:Require_best
+        ~context:(Ctype.mk_jkind_context_check_principal env)
+        kind
+    in
+    let print_with_verbosity ~jkind_verbosity kind =
+      Printtyp.wrap_printing_env ~verbosity env (fun () ->
+          Format.asprintf "%a"
+            (Jkind.format_verbose ~verbosity:jkind_verbosity)
+            kind)
+    in
+    let jkind_verbosity : Jkind.Format_verbosity.t =
+      match Mconfig.Verbosity.to_int ~for_smart:0 verbosity with
+      | 0 -> Not_verbose
+      | 1 ->
+        (* When verbosity=1, we should show the [Expanded] jkind. But the [Expanded] jkind
+           may be the same as the [Not_verbose] jkind, in which case we want to skip
+           directly to the [Expanded_with_all_mod_bounds] jkind. *)
+        (* Printing jkinds without with bounds is cheap. *)
+        let kind_without_with_bounds =
+          { kind with jkind = { kind.jkind with with_bounds = No_with_bounds } }
+        in
+        let unexpanded_kind =
+          print_with_verbosity ~jkind_verbosity:Not_verbose
+            kind_without_with_bounds
+        in
+        let expanded_kind =
+          print_with_verbosity ~jkind_verbosity:Expanded
+            kind_without_with_bounds
+        in
+        if String.equal unexpanded_kind expanded_kind then
+          Expanded_with_all_mod_bounds
+        else Expanded
+      | _ -> Expanded_with_all_mod_bounds
+    in
+    print_with_verbosity ~jkind_verbosity kind
+end
+
+let loc_contains_cursor (loc : Location.t) ~cursor =
+  Lexing.compare_pos loc.loc_start cursor < 0
+  && Lexing.compare_pos cursor loc.loc_end < 0
+
+let enclosings_of_node ~cursor (env, (node : Browse_raw.node)) :
+    (Location.t * Kind_info.t) list =
+  match node with
+  | Pattern pattern ->
+    [ (pattern.pat_loc, Kind_info.from_type ~env pattern.pat_type) ]
+  | Expression expr ->
+    [ (expr.exp_loc, Kind_info.from_type ~env expr.exp_type) ]
+  | Core_type core_type ->
+    let constr_enclosings =
+      match core_type.ctyp_desc with
+      | Ttyp_constr (path, ident, _) when loc_contains_cursor ident.loc ~cursor
+        ->
+        (* TODO: The env here contains placeholder jkinds for types declared in the same
+           recursive block, which causes under-approximations to be returned in some
+           cases. *)
+        let decl = Env.find_type path env in
+        [ (ident.loc, Kind_info.mk ~kind:decl.type_jkind ~env) ]
+      | _ -> []
+    in
+    constr_enclosings
+    @ [ (core_type.ctyp_loc, Kind_info.from_type ~env core_type.ctyp_type) ]
+  | Type_declaration decl ->
+    [ (decl.typ_loc, Kind_info.mk ~kind:decl.typ_type.type_jkind ~env) ]
+  | _ -> []
+
+let from_mbrowse mbrowse ~cursor : (Location.t * Kind_info.t) list =
+  List.concat_map mbrowse ~f:(enclosings_of_node ~cursor)

src/analysis/kind_enclosing.mli

@@ -0,0 +1,13 @@
+(** Provides information about the kind of the thing the cursor is on. If the cursor is
+    on an expression, it returns the kind of the type of the expression. If the cursor is
+    on a type, it returns the kind of the type. If the cursor is on a kind abbreviation,
+    it returns the expansion of the kind abbreviation. *)
+
+module Kind_info : sig
+  type t
+
+  val to_string : verbosity:Mconfig.Verbosity.t -> t -> string
+end
+
+val from_mbrowse :
+  Mbrowse.t -> cursor:Lexing.position -> (Location.t * Kind_info.t) list