diff --git a/analysis/src/type_utils.ml b/analysis/src/type_utils.ml index 835d449ef5..0ac940d9ba 100644 --- a/analysis/src/type_utils.ml +++ b/analysis/src/type_utils.ml @@ -476,7 +476,8 @@ let rec extract_type ?(print_opening_debug = true) { name = label; display_name = - Utils.print_maybe_exotic_ident ~allow_uident:true label; + Res_printer.print_poly_var_ident label + |> Res_doc.to_string ~width:80; args = (* Multiple arguments are represented as a Ttuple, while a single argument is just the type expression itself. *) (match field with diff --git a/analysis/src/utils.ml b/analysis/src/utils.ml index 6318d031ef..8bea86f5a6 100644 --- a/analysis/src/utils.ml +++ b/analysis/src/utils.ml @@ -242,29 +242,6 @@ let rec flatten_any_namespace_in_path path = (parts |> List.rev) @ flatten_any_namespace_in_path tail else head :: flatten_any_namespace_in_path tail -let print_maybe_exotic_ident ?(allow_uident = false) txt = - let len = String.length txt in - - let rec loop i = - if i == len then txt - else if i == 0 then - match String.unsafe_get txt i with - | 'A' .. 'Z' when allow_uident -> loop (i + 1) - | 'a' .. 'z' | '$' -> loop (i + 1) - (* Same as Res_printer.classify_ident_content: a lone [_] or one - followed by another character is not scanned as an identifier. *) - | '_' when len > 1 -> ( - match String.unsafe_get txt 1 with - | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '$' -> loop (i + 1) - | _ -> "\"" ^ txt ^ "\"") - | _ -> "\"" ^ txt ^ "\"" - else - match String.unsafe_get txt i with - | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' | '$' -> loop (i + 1) - | _ -> "\"" ^ txt ^ "\"" - in - if Res_token.is_keyword_txt txt then "\"" ^ txt ^ "\"" else loop 0 - let find_package_json root = let path = Uri.to_path root in diff --git a/changes/polyvariant-completion-labels.fix.md b/changes/polyvariant-completion-labels.fix.md new file mode 100644 index 0000000000..217d2e1ab2 --- /dev/null +++ b/changes/polyvariant-completion-labels.fix.md @@ -0,0 +1 @@ +- Editor completion shows the polymorphic variant labels `#644` and `#""` as the formatter prints them, instead of `#"644"` and `#`. diff --git a/compiler/core/bs_cmi_load.ml b/compiler/core/bs_cmi_load.ml index 8c87af9376..d143d2e99d 100644 --- a/compiler/core/bs_cmi_load.ml +++ b/compiler/core/bs_cmi_load.ml @@ -26,30 +26,18 @@ let load_cmi ~unit_name : Env.Persistent_signature.t option = (* On case-insensitive filesystems a lowercase alias can remain visible to [Sys.file_exists] briefly after its CMI is removed. Open each candidate once and parse that descriptor, so a vanished CMI is a missing module. *) - let name = unit_name ^ ".cmi" in - let lower_name = String.uncapitalize_ascii name in - let rec find = function - | [] -> None - | directory :: rest -> - let rec try_names = function - | [] -> find rest - | name :: names -> ( - let filename = Filename.concat directory name in - let path = Compiler_request_state.resolve_path filename in - match Unix.openfile path [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 with - | descriptor -> - let channel = Unix.in_channel_of_descr descriptor in - let cmi = - Fun.protect - (fun () -> Cmi_format.read_cmi_channel filename channel) - ~finally:(fun () -> close_in_noerr channel) - in - Some Env.Persistent_signature.{filename; cmi} - | exception Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> - try_names names - | exception Unix.Unix_error (error, _, _) -> - raise (Sys_error (path ^ ": " ^ Unix.error_message error))) - in - try_names (if lower_name = name then [name] else [name; lower_name]) - in - find (Config.get_load_path ()) + Misc.find_map_in_path_uncap (Config.get_load_path ()) (unit_name ^ ".cmi") + (fun filename -> + let path = Compiler_request_state.resolve_path filename in + match Unix.openfile path [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 with + | descriptor -> + let channel = Unix.in_channel_of_descr descriptor in + let cmi = + Fun.protect + (fun () -> Cmi_format.read_cmi_channel filename channel) + ~finally:(fun () -> close_in_noerr channel) + in + Some Env.Persistent_signature.{filename; cmi} + | exception Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> None + | exception Unix.Unix_error (error, _, _) -> + raise (Sys_error (path ^ ": " ^ Unix.error_message error))) diff --git a/compiler/core/config_util.ml b/compiler/core/config_util.ml index 6ff05226e0..7c041c0c30 100644 --- a/compiler/core/config_util.ml +++ b/compiler/core/config_util.ml @@ -22,27 +22,8 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* Try the name as written before its uncapitalized form: on a - case-insensitive file system both match, and the result is shown in error - messages and used in generated import paths. *) -let find_in_path_uncap path name = - let uname = Ext_string.uncapitalize_ascii name in - let rec try_dir = function - | [] -> None - | dir :: rem -> - let fullname = Filename.concat dir name in - if Sys.file_exists (Compiler_request_state.resolve_path fullname) then - Some fullname - else - let ufullname = Filename.concat dir uname in - if Sys.file_exists (Compiler_request_state.resolve_path ufullname) then - Some ufullname - else try_dir rem - in - try_dir path - (* ATTENTION: read the load path after request options have populated it. *) -let find_opt file = find_in_path_uncap (Config.get_load_path ()) file +let find_opt file = Misc.find_in_path_uncap_opt (Config.get_load_path ()) file let output_prefix name = match !((Clflags.current ()).output_name) with diff --git a/compiler/core/lam_check.ml b/compiler/core/lam_check.ml index fabd75ee9a..839d9e4c7f 100644 --- a/compiler/core/lam_check.ml +++ b/compiler/core/lam_check.ml @@ -28,10 +28,10 @@ 2. all variables are of right scope *) let check ~file ~pass lam = - let defined_variables = Hash_set_ident.create 1000 in + let defined_variables = Hash_ident.create 1000 in let success = ref true in let use (id : Ident.t) = - if not @@ Hash_set_ident.mem defined_variables id then ( + if not @@ Hash_ident.mem defined_variables id then ( Format.fprintf (Compiler_request_output.stderr_formatter ()) "\n[SANITY after %s]:%s/%d used before defined in %s@." pass id.name @@ -39,13 +39,13 @@ let check ~file ~pass lam = success := false) in let def (id : Ident.t) = - if Hash_set_ident.mem defined_variables id then ( + if Hash_ident.mem defined_variables id then ( Format.fprintf (Compiler_request_output.stderr_formatter ()) "\n[SANITY after %s]:%s/%d bound twice in %s@." pass id.name id.stamp file; success := false) - else Hash_set_ident.add defined_variables id () + else Hash_ident.add defined_variables id () in let rec check_list xs (cxt : Set_int.t) = Ext_list.iter xs (fun x -> check_staticfails x cxt) diff --git a/compiler/core/lam_dce.ml b/compiler/core/lam_dce.ml index 2f930c192d..dbb93cb896 100644 --- a/compiler/core/lam_dce.ml +++ b/compiler/core/lam_dce.ml @@ -24,10 +24,10 @@ let transitive_closure (initial_idents : Ident.t list) (ident_freevars : Set_ident.t Hash_ident.t) = - let visited = Hash_set_ident.create 31 in + let visited = Hash_ident.create 31 in let rec dfs (id : Ident.t) : unit = - if not (Hash_set_ident.mem visited id || Ext_ident.is_js_or_global id) then ( - Hash_set_ident.add visited id (); + if not (Hash_ident.mem visited id || Ext_ident.is_js_or_global id) then ( + Hash_ident.add visited id (); match Hash_ident.find_opt ident_freevars id with | None -> Ext_fmt.failwithf ~loc:__LOC__ "%s/%d not found" (Ident.name id) @@ -69,13 +69,12 @@ let remove export_idents (rest : Lam_group.t list) : Lam_group.t list = let visited = transitive_closure initial_idents ident_free_vars in Ext_list.fold_left rest [] (fun acc x -> match x with - | Single (_, id, _) -> - if Hash_set_ident.mem visited id then x :: acc else acc + | Single (_, id, _) -> if Hash_ident.mem visited id then x :: acc else acc | Nop _ -> x :: acc | Recursive bindings -> ( let b = Ext_list.fold_right bindings [] (fun ((id, _) as v) acc -> - if Hash_set_ident.mem visited id then v :: acc else acc) + if Hash_ident.mem visited id then v :: acc else acc) in match b with | [] -> acc diff --git a/compiler/ext/hash_set_ident.ml b/compiler/ext/hash_set_ident.ml deleted file mode 100644 index da3e15e230..0000000000 --- a/compiler/ext/hash_set_ident.ml +++ /dev/null @@ -1,31 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -include Hashtbl.Make (struct - type t = Ident.t - - let equal = Ext_ident.equal - let hash key = - Ext_platform_primitives.hash_string_int key.Ident.name key.Ident.stamp -end) diff --git a/compiler/ext/hash_set_ident.mli b/compiler/ext/hash_set_ident.mli deleted file mode 100644 index f30278fbcb..0000000000 --- a/compiler/ext/hash_set_ident.mli +++ /dev/null @@ -1,25 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -include Hashtbl.S with type key = Ident.t diff --git a/compiler/ext/misc.ml b/compiler/ext/misc.ml index 72956e69d0..94f7cb5547 100644 --- a/compiler/ext/misc.ml +++ b/compiler/ext/misc.ml @@ -61,21 +61,36 @@ let may_map = Stdlib.Option.map (* File functions *) -let find_in_path_uncap path name = +(* In each directory of [path], try [name] as written before its uncapitalized + form: on a case-insensitive file system both match, and the result is shown + in error messages and used in generated import paths. [f] gets each + candidate and returns the first result found. *) +let find_map_in_path_uncap path name f = let uname = String.uncapitalize_ascii name in let rec try_dir = function - | [] -> raise Not_found - | dir :: rem -> - let fullname = Filename.concat dir name - and ufullname = Filename.concat dir uname in - if Sys.file_exists (Compiler_request_state.resolve_path fullname) then - fullname - else if Sys.file_exists (Compiler_request_state.resolve_path ufullname) - then ufullname - else try_dir rem + | [] -> None + | dir :: rem -> ( + match f (Filename.concat dir name) with + | Some _ as found -> found + | None when uname = name -> try_dir rem + | None -> ( + match f (Filename.concat dir uname) with + | Some _ as found -> found + | None -> try_dir rem)) in try_dir path +let find_in_path_uncap_opt path name = + find_map_in_path_uncap path name (fun fullname -> + if Sys.file_exists (Compiler_request_state.resolve_path fullname) then + Some fullname + else None) + +let find_in_path_uncap path name = + match find_in_path_uncap_opt path name with + | Some fullname -> fullname + | None -> raise Not_found + let remove_file filename = let filename = Compiler_request_state.resolve_path filename in try if Sys.file_exists filename then Sys.remove filename diff --git a/compiler/ext/misc.mli b/compiler/ext/misc.mli index ed9a599983..8c59aeb3fb 100644 --- a/compiler/ext/misc.mli +++ b/compiler/ext/misc.mli @@ -37,10 +37,18 @@ val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a while executing [f]. The previous contents of the references is restored even if [f] raises an exception. *) +val find_map_in_path_uncap : + string list -> string -> (string -> 'a option) -> 'a option +(* [find_map_in_path_uncap path name f] applies [f] to the candidates for + name in each directory of path, name as written and then its + uncapitalized form, i.e. /path/Foo.ml before /path/foo.ml, and returns + the first result. *) + +val find_in_path_uncap_opt : string list -> string -> string option +(* The first candidate of [find_map_in_path_uncap] that exists. *) + val find_in_path_uncap : string list -> string -> string -(* Search the path for name, then for its uncapitalized form, i.e. - if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml - to match, preferring the former. *) +(* Like [find_in_path_uncap_opt]; raises [Not_found]. *) val remove_file : string -> unit (* Delete the given file if it exists. Never raise an error. *) diff --git a/tests/analysis_tests/tests/src/CompletionExpressions.res b/tests/analysis_tests/tests/src/CompletionExpressions.res index a61796e5e5..a5a745faa9 100644 --- a/tests/analysis_tests/tests/src/CompletionExpressions.res +++ b/tests/analysis_tests/tests/src/CompletionExpressions.res @@ -263,7 +263,7 @@ let arr = ["hello"] // arr->Belt.Array.map() // ^com -type exoticPolyvariant = [#"some exotic" | #dollar$ | #"_"] +type exoticPolyvariant = [#"some exotic" | #dollar$ | #"_" | #644 | #""] let takesExotic = (e: exoticPolyvariant) => { ignore(e) diff --git a/tests/analysis_tests/tests/src/expected/CompletionExpressions.res.txt b/tests/analysis_tests/tests/src/expected/CompletionExpressions.res.txt index 7889521e2b..830ad20f31 100644 --- a/tests/analysis_tests/tests/src/expected/CompletionExpressions.res.txt +++ b/tests/analysis_tests/tests/src/expected/CompletionExpressions.res.txt @@ -1326,11 +1326,23 @@ ContextPath CArgument Value[takesExotic]($0) ContextPath Value[takesExotic] Path takesExotic [ + { + "detail": "#\"\"", + "documentation": { + "kind": "markdown", + "value": "```rescript\n#\"\"\n```\n\n```rescript\n[#\"\" | #644 | #\"_\" | #dollar$ | #\"some exotic\"]\n```" + }, + "insertText": "#\"\"", + "insertTextFormat": 2, + "kind": 4, + "label": "#\"\"", + "tags": [] + }, { "detail": "#\"some exotic\"", "documentation": { "kind": "markdown", - "value": "```rescript\n#\"some exotic\"\n```\n\n```rescript\n[#\"_\" | #dollar$ | #\"some exotic\"]\n```" + "value": "```rescript\n#\"some exotic\"\n```\n\n```rescript\n[#\"\" | #644 | #\"_\" | #dollar$ | #\"some exotic\"]\n```" }, "insertText": "#\"some exotic\"", "insertTextFormat": 2, @@ -1342,7 +1354,7 @@ Path takesExotic "detail": "#\"_\"", "documentation": { "kind": "markdown", - "value": "```rescript\n#\"_\"\n```\n\n```rescript\n[#\"_\" | #dollar$ | #\"some exotic\"]\n```" + "value": "```rescript\n#\"_\"\n```\n\n```rescript\n[#\"\" | #644 | #\"_\" | #dollar$ | #\"some exotic\"]\n```" }, "insertText": "#\"_\"", "insertTextFormat": 2, @@ -1354,13 +1366,25 @@ Path takesExotic "detail": "#dollar$", "documentation": { "kind": "markdown", - "value": "```rescript\n#dollar$\n```\n\n```rescript\n[#\"_\" | #dollar$ | #\"some exotic\"]\n```" + "value": "```rescript\n#dollar$\n```\n\n```rescript\n[#\"\" | #644 | #\"_\" | #dollar$ | #\"some exotic\"]\n```" }, "insertText": "#dollar$", "insertTextFormat": 2, "kind": 4, "label": "#dollar$", "tags": [] + }, + { + "detail": "#644", + "documentation": { + "kind": "markdown", + "value": "```rescript\n#644\n```\n\n```rescript\n[#\"\" | #644 | #\"_\" | #dollar$ | #\"some exotic\"]\n```" + }, + "insertText": "#644", + "insertTextFormat": 2, + "kind": 4, + "label": "#644", + "tags": [] } ]