wip: compatibility with merlin-lib 412-5.2~preview

dune-project

@@ -66,8 +66,8 @@ possible and does not make any assumptions about IO.
   (csexp (>= 1.5))
   (ocamlformat-rpc-lib (>= 0.21.0))
   (odoc :with-doc)
-  (ocaml (and (>= 4.14) (< 5.2)))
-  (merlin-lib (and (>= 4.9) (< 5.0)))))
+  (ocaml (and (>= 5.2) (< 5.3)))
+  (merlin-lib (and (>= 4.14) (< 6.0)))))
 
 (package
  (name jsonrpc)

ocaml-lsp-server.opam

@@ -42,8 +42,8 @@ depends: [
   "csexp" {>= "1.5"}
   "ocamlformat-rpc-lib" {>= "0.21.0"}
   "odoc" {with-doc}
-  "ocaml" {>= "4.14" & < "5.2"}
-  "merlin-lib" {>= "4.9" & < "5.0"}
+  "ocaml" {>= "5.2" & < "5.3"}
+  "merlin-lib" {>= "4.14" & < "6.0"}
 ]
 dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git"
 build: [

ocaml-lsp-server/src/code_actions/action_add_rec.ml

@@ -6,7 +6,7 @@ let action_title = "Add missing `rec` keyword"
 let let_bound_vars bindings =
   List.filter_map bindings ~f:(fun vb ->
       match vb.Typedtree.vb_pat.pat_desc with
-      | Typedtree.Tpat_var (id, loc) -> Some (id, loc)
+      | Typedtree.Tpat_var (id, loc, _) -> Some (id, loc)
       | _ -> None)
 
 (** If the cursor position is inside a let binding which should have a ret tag

ocaml-lsp-server/src/code_actions/action_extract.ml

@@ -69,7 +69,8 @@ let tightest_enclosing_binder_position typedtree range =
       | Texp_letexception (_, body)
       | Texp_open (_, body) -> found_if_expr_contains body
       | Texp_letop { body; _ } -> found_if_case_contains [ body ]
-      | Texp_function { cases; _ } -> found_if_case_contains cases
+      | Texp_function (_, Tfunction_cases { cases; _ }) ->
+        found_if_case_contains cases
       | Texp_match (_, cases, _) -> found_if_case_contains cases
       | Texp_try (_, cases) -> found_if_case_contains cases
       | _ -> ())

ocaml-lsp-server/src/code_actions/action_inline.ml

@@ -63,7 +63,7 @@ let find_inline_task typedtree pos =
       match expr.exp_desc with
       | Texp_let
           ( Nonrecursive
-          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }); _ }
+          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _); _ }
               ; vb_expr = inlined_expr
               ; _
               }
@@ -79,7 +79,7 @@ let find_inline_task typedtree pos =
       match item.str_desc with
       | Tstr_value
           ( Nonrecursive
-          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }); _ }
+          , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _); _ }
               ; vb_expr = inlined_expr
               ; _
               }
@@ -190,8 +190,9 @@ end = struct
     let pat_iter (type k) (iter : I.iterator)
         (pat : k Typedtree.general_pattern) =
       match pat.pat_desc with
-      | Tpat_var (id, { loc; _ }) -> paths := Loc.Map.set !paths loc (Pident id)
-      | Tpat_alias (pat, id, { loc; _ }) ->
+      | Tpat_var (id, { loc; _ }, _) ->
+        paths := Loc.Map.set !paths loc (Pident id)
+      | Tpat_alias (pat, id, { loc; _ }, _) ->
         paths := Loc.Map.set !paths loc (Pident id);
         I.default_iterator.pat iter pat
       | _ -> I.default_iterator.pat iter pat
@@ -279,22 +280,9 @@ let rec beta_reduce (uses : Uses.t) (paths : Paths.t)
   let apply func args =
     if List.is_empty args then func else H.Exp.apply func args
   in
+  ignore (apply, beta_reduce_arg);
   match app.pexp_desc with
-  | Pexp_apply
-      ( { pexp_desc = Pexp_fun (Nolabel, None, pat, body); _ }
-      , (Nolabel, arg) :: args' ) -> beta_reduce_arg pat (apply body args') arg
-  | Pexp_apply
-      ({ pexp_desc = Pexp_fun ((Labelled l as lbl), None, pat, body); _ }, args)
-    -> (
-    let m_matching_arg, args' =
-      find_map_remove args ~f:(function
-          | Asttypes.Labelled l', e when String.equal l l' -> Some e
-          | _ -> None)
-    in
-    match m_matching_arg with
-    | Some arg -> beta_reduce_arg pat (apply body args') arg
-    | None -> H.Exp.fun_ lbl None pat (beta_reduce uses paths (apply body args))
-    )
+  (* TODO: restore beta_reduction *)
   | _ -> app
 
 let inlined_text pipeline task =

ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml

@@ -67,7 +67,7 @@ let rec mark_value_unused_edit name contexts =
           (function
            | ( { loc = field_loc; _ }
              , _
-             , { pat_desc = Tpat_var (ident, _); pat_loc; _ } )
+             , { pat_desc = Tpat_var (ident, _, _); pat_loc; _ } )
              when Ident.name ident = name ->
              (* Special case for record shorthand *)
              if
@@ -96,7 +96,7 @@ let rec mark_value_unused_edit name contexts =
     match m_field_edit with
     | Some e -> Some e
     | None -> mark_value_unused_edit name cs)
-  | Pattern { pat_desc = Tpat_var (ident, _); pat_loc = loc; _ } :: _ ->
+  | Pattern { pat_desc = Tpat_var (ident, _, _); pat_loc = loc; _ } :: _ ->
     if Ident.name ident = name then
       let+ start = Position.of_lexical_position loc.loc_start in
       { TextEdit.range = Range.create ~start ~end_:start; newText = "_" }
@@ -130,7 +130,7 @@ let enclosing_value_binding_range name =
               Texp_let
                 ( _
                 , [ { vb_pat =
-                        { pat_desc = Tpat_var (_, { txt = name'; _ }); _ }
+                        { pat_desc = Tpat_var (_, { txt = name'; _ }, _); _ }
                     ; _
                     }
                   ]

ocaml-lsp-server/src/dune

@@ -34,7 +34,8 @@
   yojson
   dune-rpc
   ocamlformat-rpc-lib
-  ocamlc-loc)
+  ocamlc-loc
+  unix)
  (lint
   (pps ppx_yojson_conv))
  (instrumentation

ocaml-lsp-server/src/folding_range.ml

@@ -206,11 +206,9 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       | Pexp_extension _
       | Pexp_let _
       | Pexp_open _
-      | Pexp_fun _
       | Pexp_poly _
       | Pexp_sequence _
       | Pexp_constraint _
-      | Pexp_function _
       | Pexp_newtype _
       | Pexp_lazy _
       | Pexp_letexception _
@@ -228,7 +226,8 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) =
       | Pexp_setinstvar _
       | Pexp_override _
       | Pexp_assert _
-      | Pexp_unreachable -> Ast_iterator.default_iterator.expr self expr
+      | Pexp_unreachable
+      | _ -> Ast_iterator.default_iterator.expr self expr
     in
 
     let module_binding (self : Ast_iterator.iterator)

ocaml-lsp-server/src/merlin_config.ml

@@ -50,6 +50,7 @@ end
 module Config = struct
   type t =
     { build_path : string list
+    ; hidden_path : string list
     ; source_path : string list
     ; cmi_path : string list
     ; cmt_path : string list
@@ -64,6 +65,7 @@ module Config = struct
 
   let empty =
     { build_path = []
+    ; hidden_path = []
     ; source_path = []
     ; cmi_path = []
     ; cmt_path = []
@@ -97,6 +99,8 @@ module Config = struct
       function
       | `B path ->
         ({ config with build_path = path :: config.build_path }, errors)
+      | `H path ->
+        ({ config with hidden_path = path :: config.hidden_path }, errors)
       | `S path ->
         ({ config with source_path = path :: config.source_path }, errors)
       | `CMI path -> ({ config with cmi_path = path :: config.cmi_path }, errors)
@@ -123,6 +127,7 @@ module Config = struct
     let clean list = List.rev (List.filter_dup list) in
     fun config ->
       { build_path = clean config.build_path
+      ; hidden_path = clean config.hidden_path
       ; source_path = clean config.source_path
       ; cmi_path = clean config.cmi_path
       ; cmt_path = clean config.cmt_path
@@ -138,6 +143,7 @@ module Config = struct
   let merge t (merlin : Mconfig.merlin) failures config_path =
     { merlin with
       build_path = t.build_path @ merlin.build_path
+    ; hidden_path = t.hidden_path @ merlin.hidden_path
     ; source_path = t.source_path @ merlin.source_path
     ; cmi_path = t.cmi_path @ merlin.cmi_path
     ; cmt_path = t.cmt_path @ merlin.cmt_path

ocaml-lsp-server/src/semantic_highlighting.ml

@@ -380,16 +380,15 @@ end = struct
               Token_modifiers_set.empty);
         self.typ self ct;
         `Custom_iterator
+      | Ptyp_any -> `Custom_iterator
       | Ptyp_variant (_, _, _)
       | Ptyp_alias (_, _)
       | Ptyp_arrow _
       | Ptyp_extension _
       | Ptyp_package _
       | Ptyp_object _
-      | Ptyp_tuple _ -> `Default_iterator
-      | Ptyp_any ->
-        ();
-        `Custom_iterator
+      | Ptyp_tuple _
+      | _ -> `Default_iterator
     in
     match iter with
     | `Default_iterator -> Ast_iterator.default_iterator.typ self ct
@@ -428,7 +427,7 @@ end = struct
       match (pvb_pat.ppat_desc, pvb_expr.pexp_desc) with
       | Parsetree.Ppat_var fn_name, _ -> (
         match pvb_expr.pexp_desc with
-        | Pexp_fun _ | Pexp_function _ ->
+        | Pexp_function _ ->
           add_token
             fn_name.loc
             (Token_type.of_builtin Function)
@@ -558,19 +557,6 @@ end = struct
           Option.iter vo ~f:(fun v -> self.expr self v));
         `Custom_iterator
       | Pexp_apply (expr, args) -> pexp_apply self expr args
-      | Pexp_function _ | Pexp_let (_, _, _) -> `Default_iterator
-      | Pexp_fun (_, expr_opt, pat, expr) ->
-        (match expr_opt with
-        | None -> self.pat self pat
-        | Some e ->
-          if Loc.compare e.pexp_loc pat.ppat_loc < 0 then (
-            self.expr self e;
-            self.pat self pat)
-          else (
-            self.pat self pat;
-            self.expr self e));
-        self.expr self expr;
-        `Custom_iterator
       | Pexp_try (_, _)
       | Pexp_tuple _
       | Pexp_variant (_, _)
@@ -640,6 +626,7 @@ end = struct
             then self.expr self pbop_exp);
         self.expr self body;
         `Custom_iterator
+      | Pexp_unreachable -> `Custom_iterator
       | Pexp_array _
       | Pexp_ifthenelse (_, _, _)
       | Pexp_while (_, _)
@@ -652,8 +639,7 @@ end = struct
       | Pexp_poly (_, _)
       | Pexp_object _ | Pexp_pack _
       | Pexp_open (_, _)
-      | Pexp_extension _ -> `Default_iterator
-      | Pexp_unreachable -> `Custom_iterator
+      | Pexp_extension _ | _ -> `Default_iterator
     with
     | `Default_iterator -> Ast_iterator.default_iterator.expr self exp
     | `Custom_iterator -> self.attributes self pexp_attributes
@@ -786,7 +772,7 @@ end = struct
       | Ptyp_alias (_, _)
       | Ptyp_variant (_, _, _)
       | Ptyp_poly (_, _)
-      | Ptyp_tuple _ | Ptyp_any | Ptyp_var _ -> Token_type.of_builtin Variable)
+      | Ptyp_tuple _ | Ptyp_any | _ -> Token_type.of_builtin Variable)
       (Token_modifiers_set.singleton Declaration);
     self.typ self pval_type;
     (* TODO: handle pval_prim ? *)

ocaml-lsp-server/src/workspace_symbol.ml

@@ -66,7 +66,7 @@ end = struct
   open Browse_tree
 
   let id_of_patt = function
-    | { pat_desc = Tpat_var (id, _); _ } -> Some id
+    | { pat_desc = Tpat_var (id, _, _); _ } -> Some id
     | _ -> None
 
   let mk ?(children = []) ~location ~deprecated outline_kind id =