Permalink
Browse files

Complete unloaded modules on path

  • Loading branch information...
1 parent 7cf5930 commit 1845502fabd9d1acc8b3ba25290c25dff7eaa573 @let-def let-def committed Feb 3, 2013
Showing with 163 additions and 105 deletions.
  1. +2 −1 TODO
  2. +1 −0 browse.ml
  3. +81 −8 command.ml
  4. +3 −0 command.mli
  5. +35 −95 ocamlmerlin.ml
  6. +29 −0 utils/misc.ml
  7. +11 −0 utils/misc.mli
  8. +1 −1 vim/merlin.py
View
@@ -3,4 +3,5 @@ DONE Handle warnings properly
- Handle arguments in partial let's
- Traverse parse tree to find node nearest to a given location
DONE In [type,expression], detect constructors and just print their definition
-- List modules on load path, even not loaded ones
+DONE List modules on load path, even not loaded ones
+- Move path management to a dedicated module
View
@@ -148,3 +148,4 @@ module Typedtree =
struct
end
+
View
@@ -21,6 +21,14 @@ let invalid_arguments () = failwith "invalid arguments"
let commands : (string,t) Hashtbl.t = Hashtbl.create 11
let register cmd = Hashtbl.add commands cmd.name cmd
+(* FIXME: cleanup: move path management in a dedicated module *)
+let source_path = ref []
+let global_modules = ref (lazy [])
+
+let reset_global_modules () =
+ let paths = !Config.load_path in
+ global_modules := lazy (Misc.modules_in_path ~ext:".cmi" paths)
+
let command_tell = {
name = "tell";
@@ -179,26 +187,31 @@ let complete_in_env env prefix =
let ppf, to_string = Misc.ppf_to_string () in
let kind =
match ty with
- | `Value v -> Printtyp.value_description ident ppf v; "value"
+ | `Value v -> Printtyp.value_description ident ppf v; "Value"
| `Cons c ->
Format.pp_print_string ppf name;
Format.pp_print_string ppf " : ";
Browse.print_constructor ppf c;
- "constructor"
+ "Constructor"
| `Mod m ->
(if exact then
match mod_smallerthan 200 m with
| None -> ()
| Some _ -> Printtyp.modtype ppf m
- ); "module"
+ ); "Module"
| `Typ t ->
- Printtyp.type_declaration ident ppf t; "type"
+ Printtyp.type_declaration ident ppf t; "Type"
in
let desc, info = match kind with "module" -> "", to_string () | _ -> to_string (), "" in
`Assoc ["name", `String name ; "kind", `String kind ; "desc", `String desc ; "info", `String info]
in
+ let seen = Hashtbl.create 7 in
+ let uniq n = if Hashtbl.mem seen n
+ then false
+ else (Hashtbl.add seen n (); true)
+ in
let find ?path prefix compl =
- let valid = Misc.has_prefix prefix in
+ let valid n = Misc.has_prefix prefix n && uniq n in
(* Hack to prevent extensions namespace to leak *)
let valid name = name <> "_" && valid name in
let compl = [] in
@@ -227,7 +240,18 @@ let complete_in_env env prefix =
try
match Longident.parse prefix with
| Longident.Ldot (path,prefix) -> find ~path prefix []
- | Longident.Lident prefix -> find prefix []
+ | Longident.Lident prefix ->
+ (* Add modules on path but not loaded *)
+ let compl = find prefix [] in
+ begin match Misc.length_lessthan 20 compl with
+ | Some _ -> List.fold_left
+ begin fun compl md ->
+ if Misc.has_prefix prefix md && uniq md
+ then (`Assoc ["name", `String md ; "kind", `String "module"; "desc", `String "" ; "info", `String ""]) :: compl
+ else compl
+ end compl (Lazy.force !global_modules)
+ | None -> compl
+ end
| _ -> find prefix []
with Not_found -> []
@@ -357,6 +381,7 @@ let command_refresh = {
handler =
begin fun _ state -> function
| [] ->
+ reset_global_modules ();
Env.reset_cache ();
let types = Typer.sync state.chunks History.empty in
{ state with types }, `Bool true
@@ -439,14 +464,60 @@ let command_dump = {
end;
}
+let command_which = {
+ name = "which";
+ doc = "TODO";
+
+ handler =
+ begin fun _ state -> function
+ | [`String "path" ; `String s] ->
+ let filename =
+ try
+ Misc.find_in_path_uncap !source_path s
+ with Not_found ->
+ Misc.find_in_path_uncap !Config.load_path s
+ in
+ state, `String filename
+ | [`String "with_ext" ; `String ext] ->
+ let results = Misc.modules_in_path ~ext !source_path in
+ state, `List (List.map (fun s -> `String s) results)
+ | _ -> invalid_arguments ()
+ end;
+}
+
+let command_find = {
+ name = "find";
+ doc = "TODO";
+
+ handler =
+ begin fun _ state -> function
+ | (`String "use" :: packages) ->
+ let packages = List.map
+ (function `String pkg -> pkg | _ -> invalid_arguments ())
+ packages
+ in
+ let packages = Findlib.package_deep_ancestors [] packages in
+ let path = List.map Findlib.package_directory packages in
+ Config.load_path := Misc.list_filter_dup (path @ !Config.load_path);
+ reset_global_modules ();
+ state, `Bool true
+ | [`String "list"] ->
+ state, `List (List.rev_map (fun s -> `String s) (Fl_package_base.list_packages ()))
+ | _ -> invalid_arguments ()
+ end;
+}
+
let command_help = {
name = "help";
doc = "List known commands with synopsis and small description";
handler =
begin fun _ state -> function
| [] ->
- let helps = Hashtbl.fold (fun name { doc } cmds -> (name, `String doc) :: cmds) commands [] in
+ let helps = Hashtbl.fold
+ (fun name { doc } cmds -> (name, `String doc) :: cmds)
+ commands []
+ in
state, `Assoc helps
| _ -> invalid_arguments ()
end;
@@ -455,5 +526,7 @@ let command_help = {
let _ = List.iter register [
command_tell; command_seek; command_reset; command_refresh;
command_cd; command_type; command_complete;
- command_errors; command_dump; command_help
+ command_errors; command_dump;
+ command_which; command_find;
+ command_help;
]
View
@@ -13,3 +13,6 @@ val invalid_arguments : unit -> 'a
val commands : (string,t) Hashtbl.t
val register : t -> unit
+
+val source_path : string list ref
+val reset_global_modules : unit -> unit
View
@@ -44,9 +44,6 @@ let default_build_paths =
let set_default_path () =
Config.load_path := Lazy.force default_build_paths
-let source_path = ref []
-
-
let main_loop () =
let io = Protocol.make ~input:stdin ~output:stdout in
let input, output as io =
@@ -75,110 +72,52 @@ let main_loop () =
loop Command.initial_state
with Stream.Failure -> ()
-let command_which = Command.({
- name = "which";
- doc = "TODO";
-
- handler =
- begin fun _ state -> function
- | [`String "path" ; `String s] ->
- let filename =
- try
- Misc.find_in_path_uncap !source_path s
- with Not_found ->
- Misc.find_in_path_uncap !Config.load_path s
- in
- state, `String filename
- | [`String "with_ext" ; `String ext] ->
- let results =
- List.fold_left
- begin fun results dir ->
- try
- Array.fold_left
- begin fun results file ->
- if Filename.check_suffix file ext
- then let name = Filename.chop_extension file in
- begin
- (if String.length name > 1 then
- name.[0] <- Char.uppercase name.[0]);
- `String name :: results
- end
- else results
- end results (Sys.readdir dir)
- with Sys_error _ -> results
- end [] !source_path
- in
- state, `List results
- | _ -> invalid_arguments ()
- end;
-})
-
let command_path pathes = Command.({
name = "path";
doc = "TODO";
handler =
- begin fun _ state -> function
- | [ `String "list" ] ->
- state, `List (List.map (fun (s,_) -> `String s) pathes)
- | [ `String "list" ; `String path ] ->
- let r,_ = List.assoc path pathes in
- state, `List (List.map (fun s -> `String s) !r)
- | [ `String "add" ; `String path ; `String d ] ->
- let r,_ = List.assoc path pathes in
- let d = Misc.expand_directory Config.standard_library d in
- r := d :: !r;
- state, `Bool true
- | [ `String "remove" ; `String path; `String s ] ->
- let r,_ = List.assoc path pathes in
- let d = Misc.expand_directory Config.standard_library s in
- r := List.filter (fun d' -> d' <> d) !r;
- state, `Bool true
- | [ `String "reset" ] ->
- List.iter
- (fun (_,(r,reset)) -> r := Lazy.force reset)
- pathes;
- state, `Bool true
- | [ `String "reset" ; `String path ] ->
- let r,reset = List.assoc path pathes in
- r := Lazy.force reset;
- state, `Bool true
- | _ -> invalid_arguments ()
- end;
-})
-
-let list_filter_dup lst =
- let tbl = Hashtbl.create 17 in
- List.rev (List.fold_left (fun a b -> if Hashtbl.mem tbl b then a else (Hashtbl.add tbl b (); b :: a)) [] lst)
-
-let command_find = Command.({
- name = "find";
- doc = "TODO";
-
- handler =
- begin fun _ state -> function
- | (`String "use" :: packages) ->
- let packages = List.map
- (function `String pkg -> pkg | _ -> invalid_arguments ())
- packages
- in
- let packages = Findlib.package_deep_ancestors [] packages in
- let path = List.map Findlib.package_directory packages in
- Config.load_path := list_filter_dup (path @ !Config.load_path);
- state, `Bool true
- | [`String "list"] ->
- state, `List (List.rev_map (fun s -> `String s) (Fl_package_base.list_packages ()))
- | _ -> invalid_arguments ()
+ begin fun _ state arg->
+ match begin match arg with
+ | [ `String "list" ] ->
+ state, `List (List.map (fun (s,_) -> `String s) pathes)
+ | [ `String "list" ; `String path ] ->
+ let r,_ = List.assoc path pathes in
+ state, `List (List.map (fun s -> `String s) !r)
+ | [ `String "add" ; `String path ; `String d ] ->
+ let r,_ = List.assoc path pathes in
+ let d = Misc.expand_directory Config.standard_library d in
+ r := d :: !r;
+ state, `Bool true
+ | [ `String "remove" ; `String path; `String s ] ->
+ let r,_ = List.assoc path pathes in
+ let d = Misc.expand_directory Config.standard_library s in
+ r := List.filter (fun d' -> d' <> d) !r;
+ state, `Bool true
+ | [ `String "reset" ] ->
+ List.iter
+ (fun (_,(r,reset)) -> r := Lazy.force reset)
+ pathes;
+ state, `Bool true
+ | [ `String "reset" ; `String path ] ->
+ let r,reset = List.assoc path pathes in
+ r := Lazy.force reset;
+ state, `Bool true
+ | _ -> invalid_arguments ()
+ end with
+ | state, `Bool true as answer ->
+ reset_global_modules ();
+ answer
+ | answer -> answer
end;
})
let _ =
let command_path = command_path [
"build", (Config.load_path,default_build_paths);
- "source", (source_path, lazy [])
+ "source", (Command.source_path, lazy [])
] in
- List.iter Command.register
- [ command_which ; command_find ; command_path ]
+ Command.register command_path
(** Mimic other Caml tools, entry point *)
let print_version () =
@@ -246,6 +185,7 @@ let main () =
Arg.parse Options.list unexpected_argument "TODO";
init_path ();
set_default_path ();
+ Command.reset_global_modules ();
Findlib.init ();
main_loop ()
View
@@ -286,3 +286,32 @@ let has_prefix p =
done;
true
with Not_found -> false)
+
+ (* [modules_in_path ~ext path] lists ocaml modules corresponding to
+ * filenames with extension [ext] in given [path]es.
+ * For instance, if there is file "a.ml","a.mli","b.ml" in ".":
+ * - modules_in_path ~ext:".ml" ["."] returns ["A";"B"],
+ * - modules_in_path ~ext:".mli" ["."] returns ["A"] *)
+let modules_in_path ~ext path =
+ let seen = Hashtbl.create 7 in
+ List.fold_left
+ begin fun results dir ->
+ try
+ Array.fold_left
+ begin fun results file ->
+ if Filename.check_suffix file ext
+ then let name = Filename.chop_extension file in
+ (if Hashtbl.mem seen name
+ then results
+ else
+ (Hashtbl.add seen name (); String.capitalize name :: results))
+ else results
+ end results (Sys.readdir dir)
+ with Sys_error _ -> results
+ end [] path
+
+ (* Remove duplicates from list *)
+let list_filter_dup lst =
+ let tbl = Hashtbl.create 17 in
+ List.rev (List.fold_left (fun a b -> if Hashtbl.mem tbl b then a else (Hashtbl.add tbl b (); b :: a)) [] lst)
+
View
@@ -138,3 +138,14 @@ val length_lessthan : int -> 'a list -> int option
(* [has_prefix p s] returns true iff p is a prefix of s *)
val has_prefix : string -> string -> bool
+
+ (* [modules_in_path ~ext path] lists ocaml modules corresponding to
+ * filenames with extension [ext] in given [path]es.
+ * For instance, if there is file "a.ml","a.mli","b.ml" in ".":
+ * - modules_in_path ~ext:".ml" ["."] returns ["A";"B"],
+ * - modules_in_path ~ext:".mli" ["."] returns ["A"] *)
+val modules_in_path : ext:string -> string list -> string list
+
+ (* Remove duplicates from list *)
+val list_filter_dup : 'a list -> 'a list
+
View
@@ -247,7 +247,7 @@ def vim_complete(base, vimvar):
(prop['name'].replace("'", "''")
,prop['desc'].replace("\n"," ").replace(" "," ").replace("'", "''")
,prop['info'].replace("'", "''")
- ,prop['kind'][:1].upper().replace("'", "''")
+ ,prop['kind'][:1].replace("'", "''")
))
vim.command("call add(%s, l:tmp)" % vimvar)

0 comments on commit 1845502

Please sign in to comment.