Parenthesize

Makefile

@@ -12,8 +12,9 @@ ocamlmerlin ocamlmerlin-server ocamlmerlin-lsp:
 clean:
 	dune clean
 
-test: build
-	dune runtest --force
+test:
+	dune build --workspace=dune-workspace.test merlin.install
+	dune runtest --workspace=dune-workspace.test --force
 
 preprocess:
 	dune build @preprocess

dune-workspace.test

@@ -0,0 +1,7 @@
+(lang dune 1.0)
+(context (opam (switch 4.03.0)))
+(context (opam (switch 4.04.2)))
+(context (opam (switch 4.05.0)))
+(context (opam (switch 4.06.1)))
+(context (opam (switch 4.07.1)))
+(context (opam (switch 4.08.0)))

src/analysis/completion.ml

@@ -151,7 +151,7 @@ open Query_protocol.Compl
 let map_entry f entry =
   {entry with desc = f entry.desc; info = f entry.info}
 
-let make_candidate ?get_doc ~attrs ~exact ?prefix_path name ?loc ?path ty =
+let make_candidate ~get_doc ~attrs ~exact ~prefix_path name ?loc ?path ty =
   let ident = match path with
     | Some path ->
       (* this is not correct: the ident is not persistent, the printing of some
@@ -284,6 +284,8 @@ let get_candidates ?get_doc ?target_type ?prefix_path ~prefix kind ~validate env
   let lbl_attributes l = l.Types.lbl_attributes in
   let mtd_attributes t = t.Types.mtd_attributes in
   let md_attributes t = t.Types.md_attributes in
+  let make_candidate ~attrs ~exact name ?loc ?path ty =
+    make_candidate ~get_doc ~prefix_path ~attrs ~exact name ?loc ?path ty in
   let make_weighted_candidate ?(priority=0) ~attrs ~exact name ?loc ?path ty =
     (* Just like [make_candidate] but associates some metadata to the candidate.
        The candidates are later sorted using these metadata.
@@ -300,7 +302,7 @@ let get_candidates ?get_doc ?target_type ?prefix_path ~prefix kind ~validate env
       try Path.scope (Option.get path)
       with _ -> 0
     in
-    let item = make_candidate ?get_doc ~attrs ~exact name ?loc ?path ty in
+    let item = make_candidate ~attrs ~exact name ?loc ?path ty in
     (- priority, - time, name), item
   in
   let is_internal name = name = "" || name.[0] = '_' in
@@ -482,6 +484,8 @@ let complete_prefix ?get_doc ?target_type ?(kinds=[]) ~prefix ~is_label
     then false
     else (Hashtbl.add seen n (); true)
   in
+  let make_candidate ~attrs ~exact name ?loc ?path ty =
+    make_candidate ~get_doc ~attrs ~exact name ?loc ?path ty in
   let find ?prefix_path ~is_label prefix =
     let valid tag name =
       try
@@ -502,13 +506,14 @@ let complete_prefix ?get_doc ?target_type ?(kinds=[]) ~prefix ~is_label
     in
     let add_label_description ({Types.lbl_name = name; _} as l) candidates =
       if not (valid `Label name) then candidates else
-        make_candidate ?get_doc ~exact:(name = prefix) name (`Label l) ~attrs:[]
+        make_candidate ~prefix_path ~exact:(name = prefix) name
+          (`Label l) ~attrs:[]
         :: candidates
     in
     let add_label_declaration ty ({Types.ld_id = name; _} as l) candidates =
       let name = Ident.name name in
       if not (valid `Label name) then candidates else
-        make_candidate ?get_doc ~exact:(name = prefix) name
+        make_candidate ~prefix_path ~exact:(name = prefix) name
           (`Label_decl (ty,l)) ~attrs:[]
         :: candidates
     in
@@ -548,7 +553,8 @@ let complete_prefix ?get_doc ?target_type ?(kinds=[]) ~prefix ~is_label
           if name = prefix && uniq (`Mod, name) then
             try
               let path, md, attrs = Type_utils.lookup_module (Longident.Lident name) env in
-              make_candidate ?get_doc ~exact:true name ~path (`Mod md) ~attrs
+              make_candidate ~prefix_path:(Some prefix) ~exact:true ~path name
+                 (`Mod md) ~attrs
               :: candidates
             with Not_found ->
               default :: candidates

src/ocaml/typing/402/oprint.ml

@@ -27,17 +27,19 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then
-    fprintf ppf "( %s )" name
+    if name <> "" && (name.[0] = '*' || name.[String.length name - 1] = '*')
+    then fprintf ppf "( %s )" name
+    else fprintf ppf "(%s)" name
   else
     pp_print_string ppf name
 
@@ -502,7 +504,7 @@ and print_out_constr ppf (name, tyl,ret_type_opt) =
   | None ->
       begin match tyl with
       | [] ->
-          pp_print_string ppf name
+          value_ident ppf name
       | _ ->
           fprintf ppf "@[<2>%s of@ %a@]" name
             (print_typlist print_simple_out_type " *") tyl

src/ocaml/typing/403/oprint.ml

@@ -30,17 +30,19 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then
-    fprintf ppf "( %s )" name
+    if name <> "" && (name.[0] = '*' || name.[String.length name - 1] = '*')
+    then fprintf ppf "( %s )" name
+    else fprintf ppf "(%s)" name
   else
     pp_print_string ppf name
 
@@ -538,17 +540,20 @@ and print_out_constr ppf (name, tyl,ret_type_opt) =
   | None ->
       begin match tyl with
       | [] ->
-          pp_print_string ppf name
+          value_ident ppf name
       | _ ->
-          fprintf ppf "@[<2>%s of@ %a@]" name
+          fprintf ppf "@[<2>%a of@ %a@]"
+            value_ident name
             (print_typlist print_simple_out_type " *") tyl
       end
   | Some ret_type ->
       begin match tyl with
       | [] ->
-          fprintf ppf "@[<2>%s :@ %a@]" name print_simple_out_type  ret_type
+        fprintf ppf "@[<2>%a :@ %a@]"
+            value_ident name print_simple_out_type  ret_type
       | _ ->
-          fprintf ppf "@[<2>%s :@ %a -> %a@]" name
+        fprintf ppf "@[<2>%a :@ %a -> %a@]"
+            value_ident name
             (print_typlist print_simple_out_type " *")
             tyl print_simple_out_type ret_type
       end

src/ocaml/typing/404/oprint.ml

@@ -30,13 +30,13 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then

src/ocaml/typing/405/oprint.ml

@@ -30,13 +30,13 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then

src/ocaml/typing/406/oprint.ml

@@ -34,13 +34,13 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then

src/ocaml/typing/407/oprint.ml

@@ -34,13 +34,13 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then

src/ocaml/typing/407_0/oprint.ml

@@ -34,13 +34,13 @@ let rec print_ident ppf =
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  ||
-  (match name.[0] with
-      'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' ->
-        false
-    | _ -> true)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name ->
+    match name.[0] with
+    | 'a'..'z' | 'A'..'Z' | '\223'..'\246' | '\248'..'\255' | '_' -> false
+    | _ -> true
 
 let value_ident ppf name =
   if parenthesized_ident name then

src/ocaml/typing/408/oprint.ml

@@ -55,9 +55,10 @@ let all_ident_chars s =
   let len = String.length s in
   loop s len 0
 
-let parenthesized_ident name =
-  (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  || not (all_ident_chars name)
+let parenthesized_ident = function
+  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+  | "[]" | "()" -> false
+  | name -> not (all_ident_chars name)
 
 let value_ident ppf name =
   if parenthesized_ident name then

tests/completion/dune

@@ -6,3 +6,12 @@
      (setenv MERLIN %{exe:../merlin-wrapper}
        (run %{bin:mdx} test --syntax=cram %{t}))
      (diff? %{t} %{t}.corrected))))
+
+(alias
+ (name runtest)
+ (deps (:t parenthesize.t) parenthesize.ml)
+ (action
+   (progn
+     (setenv MERLIN %{exe:../merlin-wrapper}
+       (run %{bin:mdx} test --syntax=cram %{t}))
+     (diff? %{t} %{t}.corrected))))

tests/completion/parenthesize.ml

@@ -0,0 +1,11 @@
+module MyList = struct
+  [@@@ocaml.warning "-65"]
+  type 'a t =
+    | (::) of 'a * 'a t
+    | []
+  type u = ()
+  let (mod) = ()
+  let random = 1
+end
+
+let _ = MyList.

tests/completion/parenthesize.t

@@ -0,0 +1,46 @@
+  $ $MERLIN single complete-prefix -position 11:15 -prefix MyList. \
+  > -filename parenthesize.ml < parenthesize.ml | jq ".value.entries | sort_by(.name)"
+  [
+    {
+      "name": "()",
+      "kind": "Constructor",
+      "desc": "MyList.u",
+      "info": ""
+    },
+    {
+      "name": "(::)",
+      "kind": "Constructor",
+      "desc": "'a * 'a MyList.t -> 'a MyList.t",
+      "info": ""
+    },
+    {
+      "name": "(mod)",
+      "kind": "Value",
+      "desc": "MyList.u",
+      "info": ""
+    },
+    {
+      "name": "[]",
+      "kind": "Constructor",
+      "desc": "'a MyList.t",
+      "info": ""
+    },
+    {
+      "name": "random",
+      "kind": "Value",
+      "desc": "int",
+      "info": ""
+    },
+    {
+      "name": "t",
+      "kind": "Type",
+      "desc": "type 'a t = (::) of 'a * 'a MyList.t | []",
+      "info": ""
+    },
+    {
+      "name": "u",
+      "kind": "Type",
+      "desc": "type u = ()",
+      "info": ""
+    }
+  ]