ocaml · voodoos · May 13, 2024 · Mar 4, 2022 · Mar 4, 2022 · Mar 10, 2022
diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
@@ -6,7 +6,7 @@ name: CI
 # events but only for the master branch
 on:
   push:
-    branches: [ master ]
+    branches: [ master; 500 ]
     paths-ignore:
       - '**.md'
       - '**.txt'
@@ -38,9 +38,9 @@ jobs:
         os:
           - macos-latest
           - ubuntu-latest
-          - windows-latest
+          # - windows-latest
         ocaml-compiler:
-          - 4.14.x
+          - 5.2.x
     # The type of runner that the job will run on
     runs-on: ${{ matrix.os }}
 
@@ -51,12 +51,12 @@ jobs:
     # Steps represent a sequence of tasks that will be executed as part of the job
     steps:
       # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
-      - uses: actions/checkout@v3
+      - name: Checkout tree
+        uses: actions/checkout@v4
 
-      - name: Set up OCaml ${{ matrix.ocaml-compiler }}
+      - name: Set-up OCaml ${{ matrix.ocaml-compiler }}
         uses: ocaml/setup-ocaml@v2
         with:
-          # Version of the OCaml compiler to initialise
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
 
       - name: Install dependencies

diff --git a/.github/workflows/ocaml-lsp-compat.yml b/.github/workflows/ocaml-lsp-compat.yml
@@ -34,7 +34,7 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - 4.14.x
+          - 5.2.x
     # The type of runner that the job will run on
     runs-on: ${{ matrix.os }}
 

diff --git a/CHANGES.md b/CHANGES.md
@@ -2,6 +2,7 @@ merlin NEXT_VERSION
 ==================
 
   + merlin binary
+    - Support for OCaml 5.2 (#1757)
     - destruct: Removal of residual patterns (#1737, fixes #1560)
     - Do not erase fields' names when destructing punned record fields (#1734,
       fixes #1661)
@@ -14,6 +15,8 @@ merlin 4.14
 Thu Feb 22 14:00:42 CET 2024
 
   + merlin binary
+    - Preliminary support for OCaml 5.2
+    - Some regressions in recovery and destruct are present.
     - Add a "heap_mbytes" field to Merlin server responses to report heap usage (#1717)
     - Add cache stats to telemetry (#1711)
     - Add new SyntaxDocument command to find information about the node under the cursor (#1706)
@@ -28,18 +31,21 @@ Thu Feb 22 14:00:42 CET 2024
     - vim: load merlin under the ocamlinterface and ocamllex filetypes (#1340)
     - Fix merlinpp not using binary file open (#1725, fixes #1724)
 
-merlin 4.13
-===========
+merlin 4.13.1
+=============
 Fri Dec  1 15:00:42 CET 2023
 
   + merlin binary
     - Fix a follow-up issue to the preference of non-ghost nodes introduced in #1660 (#1690, fixes #1689)
     - Add `-cache-lifespan` flag, that sets cache invalidation period. (#1698,
       #1705)
+    - Ignore the new 5.1 `cmi-file` flag instead of rejecting it (#1710, fixes
+      #1703)
     - Fix Merlin locate not fallbacking on the correct file in case of ambiguity
       (@goldfirere, #1699)
     - Fix Merlin reporting errors provoked by the recovery itself (#1709, fixes
       #1704)
+    - Add support for OCaml 5.1.1 (#1714)
   + editor modes
     - vim: load merlin when Vim is compiled with +python3/dyn (e.g. MacVim)
     - emacs: highlight only first error line by default (#1693, fixes #1663)
@@ -59,6 +65,7 @@ merlin 4.11
 Thu Sep 24 18:01:42 CEST 2023
 
   + merlin binary
+    - Add support for OCaml 5.1
     - Improve error messages for missing configuration reader (#1669)
     - Fix regression causing crash when using ppxes under Windows (#1673)
     - Fix confusion between aliased modules and module types (#1676,
@@ -75,7 +82,7 @@ Thu Sep 24 18:01:42 CEST 2023
     - emacs: remove use of obsolete `defadvice` macro (#1675)
 
 merlin 4.10
-==========
+===========
 Thu Aug 24 17:17:42 CEST 2023
 
   + merlin binary
@@ -106,9 +113,11 @@ Thu Aug 24 17:17:42 CEST 2023
 
 merlin 4.9
 ==========
-Fri May 26 15:23:42 CEST 2023
+unreleased
 
   + merlin binary
+    - Preview support for OCaml 5.1-alpha1. Short path is temporary disabled and
+      inline records might not behave as expected.
     - Allow monadic IO in dot protocol (#1581)
     - Add a `scope` option to the `occurrences` command in preparation for
       the upcoming `project-wide-occurrences` feature (#1596)
@@ -141,11 +150,15 @@ merlin 4.8
 Fri Feb 24 16:55:42 CEST 2023
 
   + merlin binary
-    - Update internal typer to match OCaml 4.14.1 release (#1557)
+    - Recognize OCaml 5.0 cmi magic number in compiler version mismatch message
+      (#1554, fixes #1553)
+    - Upgrade Merlin from the RC2 to the stable 5.0.0 compiler release (#1559,
+      fixes #1558)
     - Improve type-enclosing behaviour when used on records' labels (#1565,
       fixes #1564)
-    - Restore compatibility with some OCaml compiler's debug flags that were
-      incorrectly rejected by Merlin (#1556)
+    - Restore compatibility with the compiler's command line by accepting the
+      `-safe-string` flag as a no-op instead of rejecting it (#1544, fixes
+      #1518)
     - Traverse aliases when jumping to declaration. This matches
       jump-to-definition's behavior (#1563)
     - Improve locate's behavior in various ill-typed expressions (#1546, fixes
@@ -155,13 +168,29 @@ Fri Feb 24 16:55:42 CEST 2023
       fixes #1540)
     - On Windows, change to a harmless directory when launching server to avoid
       locking down current directory (#1569, fixes #1474)
+  + editor modes
+    - emacs: Fix misuse of `eq` comparison (#1549, @mattiase)
+    - emacs: xref works from context menus; better highlighting of xref matches;
+      xref recognises operators and binding operators at the cursor position;
+      bad locations are filtered out (#1385, fixes #1410, @mattiase)
   + test suite
     - Add multiple tests for locate over ill-typed expressions (#1546)
     - Add non-regression tests for other fixes in this release
+    - Add a test for incorrect alert defaults (#1559)
+
+merlin 4.7.1
+============
+Thu Dec 13 11:49:42 CEST 2022
+
+  + merlin binary
+    - Restore compatibility with the compiler's command line by accepting
+      the `-safe-string` flag as a no-op instead of rejecting it. (#1544,
+      fixes #1518)
+    - Mark some C variables as unused to remove warnings (#1541, @antalsz)
 
 merlin 4.7
 ==========
-Thu Nov 24 13:31:42 CEST 2022
+Thu Nov 24 17:49:42 CEST 2022
 
   + merlin binary
     - Replace custom "holes" AST nodes by extensions. This restores binary

diff --git a/README.md b/README.md
@@ -178,9 +178,9 @@ If you're a Merlin user and depend on our public API, we recommend that you cont
 Next Steps
 ==========
 
-To use Merlin with a multi-file project, it is necessary to have a [.merlin](https://github.com/ocaml/merlin/wiki/project-configuration) file, 
+To use Merlin with a multi-file project, it is necessary to have a [.merlin](https://github.com/ocaml/merlin/wiki/project-configuration) file,
 unless your project is built using Dune.
-Note that, in a project using Dune, user-created `.merlin` files will take precedence over the configuration provided by Dune to Merlin. 
+Note that, in a project using Dune, user-created `.merlin` files will take precedence over the configuration provided by Dune to Merlin.
 
 Read more in the [wiki](https://github.com/ocaml/merlin/wiki) to learn how to make full use of Merlin in your projects.
 

diff --git a/dot-merlin-reader.opam b/dot-merlin-reader.opam
@@ -11,7 +11,7 @@ build: [
   ["dune" "build" "-p" name "-j" jobs]
 ]
 depends: [
-  "ocaml" {>= "4.08" & < "5.0"}
+  "ocaml" {>= "5.2" }
   "dune" {>= "2.9.0"}
   "merlin-lib" {>= "4.9"}
   "ocamlfind" {>= "1.6.0"}

diff --git a/merlin-lib.opam b/merlin-lib.opam
@@ -10,7 +10,7 @@ build: [
   ["dune" "build" "-p" name "-j" jobs]
 ]
 depends: [
-  "ocaml" {>= "4.14" & < "4.15"}
+  "ocaml" {>= "5.2" & < "5.3"}
   "dune" {>= "2.9.0"}
   "csexp" {>= "1.5.1"}
   "menhir"    {dev & >= "20201216"}

diff --git a/merlin.opam b/merlin.opam
@@ -11,7 +11,7 @@ build: [
   ["dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
 depends: [
-  "ocaml" {>= "4.14" & < "4.15"}
+  "ocaml" {>= "5.2" & < "5.3"}
   "dune" {>= "2.9.0"}
   "merlin-lib" {= version}
   "dot-merlin-reader" {>= "4.9"}

diff --git a/src/analysis/ast_iterators.ml b/src/analysis/ast_iterators.ml
@@ -0,0 +1,51 @@
+open Std
+open Typedtree
+
+let {Logger. log} = Logger.for_section "iterators"
+
+(* The compiler contains an iterator that aims to gather definitions but
+ignores local values like let-in expressions and local type definition. To
+provide occurrences in the active buffer we extend the compiler's iterator with
+these cases. *)
+let iter_on_defs ~uid_to_locs_tbl =
+  let log = log ~title:"iter_on_defs" in
+  let register_uid uid fragment =
+    let loc = Misc_utils.loc_of_decl ~uid fragment in
+    Option.iter loc ~f:(fun loc ->
+      Types.Uid.Tbl.add uid_to_locs_tbl uid loc)
+  in
+  let iter_decl = Cmt_format.iter_on_declarations ~f:register_uid in
+  let register_uid uid loc =
+    Types.Uid.Tbl.add uid_to_locs_tbl uid loc
+  in
+  { iter_decl with
+    expr = (fun sub ({ exp_extra; _ } as expr) ->
+      List.iter exp_extra ~f:(fun (exp_extra, _loc, _attr) ->
+        match exp_extra with
+        | Texp_newtype' (typ_id, typ_name, uid) ->
+          log "Found newtype %s wit id %a (%a)\n%!" typ_name.txt
+            Logger.fmt (Fun.flip Ident.print_with_scope typ_id)
+            Logger.fmt (fun fmt -> Location.print_loc fmt typ_name.loc);
+          register_uid uid typ_name;
+          ()
+        | _ -> ());
+      iter_decl.expr sub expr);
+  }
+
+let build_uid_to_locs_tbl ~(local_defs : Mtyper.typedtree) () =
+  let uid_to_locs_tbl : string Location.loc Types.Uid.Tbl.t =
+    Types.Uid.Tbl.create 64
+  in
+  let iter = iter_on_defs ~uid_to_locs_tbl in
+  begin match local_defs with
+  | `Interface sign ->
+    iter.signature iter sign
+  | `Implementation str ->
+    iter.structure iter str end;
+  uid_to_locs_tbl
+
+let iter_on_usages ~f (local_defs : Mtyper.typedtree) =
+  let iter = Cmt_format.iter_on_occurrences ~f in
+  begin match local_defs with
+  | `Interface signature -> iter.signature iter signature
+  | `Implementation structure -> iter.structure iter structure end
diff --git a/src/analysis/browse_tree.ml b/src/analysis/browse_tree.ml
@@ -60,87 +60,6 @@ let dummy = {
   t_children = lazy []
 }
 
-let rec normalize_type_expr env type_expr =
-  match Types.get_desc type_expr with
-  | Types.Tconstr (path,_,_) ->
-    normalize_type_decl env (Env.find_type path env)
-  | _ -> raise Not_found
-
-and normalize_type_decl env decl = match decl.Types.type_manifest with
-  | Some expr -> normalize_type_expr env expr
-  | None -> decl
-
-let id_of_constr_decl c = `Id c.Types.cd_id
-
-let same_constructor env a b =
-  let name = function
-    | `Description d -> d.Types.cstr_name
-    | `Declaration d -> Ident.name d.Typedtree.cd_id
-    | `Extension_constructor ec -> Ident.name ec.Typedtree.ext_id
-  in
-  if name a <> name b then false
-  else begin
-    let get_decls = function
-      | `Description d ->
-        let ty = normalize_type_expr env d.Types.cstr_res in
-        begin match ty.Types.type_kind with
-        | Types.Type_variant (decls, _) ->
-          List.map decls ~f:id_of_constr_decl
-        | Type_open ->
-          [`Uid d.cstr_uid]
-        | _ -> assert false
-        end
-      | `Declaration d ->
-        [`Id d.Typedtree.cd_id]
-      | `Extension_constructor ext_cons ->
-        let des = Env.find_ident_constructor ext_cons.Typedtree.ext_id env in
-        [`Uid des.cstr_uid]
-    in
-    let a = get_decls a in
-    let b = get_decls b in
-    let same a b = match a, b with
-      | `Id a, `Id b -> Ident.same a b
-      | `Uid a, `Uid b -> Shape.Uid.equal a b
-      | _, _ -> false
-    in
-    List.exists a ~f:(fun id -> List.exists b ~f:(same id))
-  end
-
-let all_occurrences path =
-  let rec aux acc t =
-    let acc =
-      let paths = Browse_raw.node_paths t.t_node in
-      let same l = Path.same path l.Location.txt in
-      match List.filter ~f:same paths with
-      | [] -> acc
-      | paths -> (t, paths) :: acc
-    in
-    if Browse_raw.has_attr ~name:"merlin.hide" t.t_node then
-      acc
-    else
-      List.fold_left ~f:aux ~init:acc (Lazy.force t.t_children)
-  in
-  aux []
-
-let all_constructor_occurrences ({t_env = env; _},d) t =
-  let rec aux acc t =
-    let acc =
-      match Browse_raw.node_is_constructor t.t_node with
-      | Some d' when (
-          (* Don't try this at home kids. *)
-          try same_constructor env d d'.Location.txt
-          with Not_found -> same_constructor t.t_env d d'.Location.txt
-        ) ->
-        {d' with Location.txt = t} :: acc
-      | _ -> acc
-    in
-    if Browse_raw.has_attr ~name:"merlin.hide" t.t_node then
-      acc
-    else
-      List.fold_left ~f:aux ~init:acc (Lazy.force t.t_children)
-  in
-  aux [] t
-
 let all_occurrences_of_prefix path node =
   let rec path_prefix ~prefix path =
     Path.same prefix path ||

diff --git a/src/analysis/browse_tree.mli b/src/analysis/browse_tree.mli
@@ -45,12 +45,5 @@ val of_browse : Mbrowse.t -> t
 
 val dummy : t
 
-val all_occurrences : Path.t -> t -> (t * Path.t Location.loc list) list
-val all_constructor_occurrences :
-  t * [ `Description of Types.constructor_description
-      | `Declaration of Typedtree.constructor_declaration
-      | `Extension_constructor of Typedtree.extension_constructor ]
-  -> t -> t Location.loc list
-
 val all_occurrences_of_prefix :
   Path.t -> Browse_raw.node -> (Path.t Location.loc * Longident.t) list
diff --git a/src/analysis/completion.ml b/src/analysis/completion.ml
@@ -219,8 +219,8 @@ let make_candidate ~get_doc ~attrs ~exact ~prefix_path name ?loc ?path ty =
       | Some p, Some loc ->
         let namespace = (* FIXME: that's just terrible *)
           match kind with
-          | `Value -> `Vals
-          | `Type -> `Type
+          | `Value -> Shape.Sig_component_kind.Value
+          | `Type -> Type
           | _ -> assert false
         in
         begin match get_doc (`Completion_entry (namespace, p, loc)) with
@@ -280,7 +280,7 @@ let fold_sumtype_constructors ~env ~init ~f t =
       (Path.name path);
     begin match Env.find_type_descrs path env with
     | exception Not_found -> init
-    | Type_record _ | Type_abstract | Type_open -> init
+    | Type_record _ | Type_abstract _ | Type_open -> init
     | Type_variant (constrs, _) ->
       List.fold_right constrs ~init ~f
     end
@@ -650,7 +650,9 @@ let branch_complete buffer ?get_doc ?target_type ?kinds ~keywords prefix =
                 let lbls = Datarepr.labels_of_type p decl in
                 let labels = List.map lbls ~f:(fun (_,lbl) ->
                     try
-                      let _, lbl_arg, lbl_res = Ctype.instance_label false lbl in
+                      let _, lbl_arg, lbl_res =
+                        Ctype.instance_label ~fixed:false lbl
+                      in
                       begin try
                           Ctype.unify_var env ty lbl_res;
                         with _ -> ()

diff --git a/src/analysis/completion.mli b/src/analysis/completion.mli
@@ -52,7 +52,7 @@ val map_entry : ('a -> 'b) ->
 
 val branch_complete
   :  Mconfig.t
-  -> ?get_doc:([> `Completion_entry of Namespaced_path.Namespace.t
+  -> ?get_doc:([> `Completion_entry of Env_lookup.Namespace.t
                 * Path.t * Location.t ] -> [> `Found of string ])
   -> ?target_type:Types.type_expr
   -> ?kinds:Compl.kind list