Browse files

better cli printing

  • Loading branch information...
1 parent 17efecd commit 31c4804830e197fb471e9cc4c7499975e78b88cc @camlspotter camlspotter committed Feb 15, 2013
Showing with 86 additions and 28 deletions.
  1. +18 −18 search.ml
  2. +4 −3 search.mli
  3. +52 −7 searchid.ml
  4. +12 −0 searchid.mli
View
36 search.ml
@@ -74,19 +74,20 @@ let string_of_sign sign =
Format.pp_print_flush ppf ();
Buffer.contents b
+(* CR jfuruse: We can get vd.val_type and print it *)
let string_of_value id =
let name =
match id with
- Longident.Lident x -> x
- | Longident.Ldot (_, x) -> x
- | _ -> "z"
+ | Longident.Lident x -> x
+ | Longident.Ldot (_, x) -> x
+ | _ -> "z"
in
let _, vd =
Env.lookup_value id !Searchid.start_env
in
- Str.replace_first (Str.regexp "=[^=]*$") "" @@
- Str.replace_first (Str.regexp "^[^:]*: *") ""
- (string_of_sign [Types.Sig_value (Ident.create name, vd)])
+ Str.replace_first (Str.regexp "=[^=]*$") "" (* remove equality of external *)
+ @@ Str.replace_first (Str.regexp "^[^:]*: *") "" (* remove "val id :" "exteranl id :" *)
+ (string_of_sign [Types.Sig_value (Ident.create name, vd)])
let ident_of_path ~default = function
Path.Pident i -> i
@@ -129,6 +130,7 @@ let string_of_type id =
strip @@ string_of_type_decl path
+(** Wrap infix/perfix operators with "(" and ")" *)
let infix s =
if Str.string_match (Str.regexp "[!$%&*+-./:<=>?@^|~]+") s 0 then
Printf.sprintf "(%s)" s
@@ -147,6 +149,7 @@ let to_result (id, kind) =
in
match kind with
Searchid.Pvalue ->
+ (* We can apply infix only against the last elem *)
{kind = Value (string_of_value id); id = List.map ~f:infix id'}
| Searchid.Ptype ->
{ t with kind = Type (string_of_type id) }
@@ -161,17 +164,14 @@ let to_result (id, kind) =
| _ ->
t
-let lift f s =
- s
- +> sure f
- +> List.map ~f:to_result
-
-let search s modules paths =
+let raw_search s modules paths =
init modules paths;
- List.rev @@
- ExtList.List.unique @@
- List.rev @@
- lift (Searchid.search_string_type ~mode:`Exact) s
- @ lift (Searchid.search_string_type ~mode:`Included) s
- @ lift Searchid.search_pattern_symbol s
+ sure (Searchid.search_string_type ~mode:`Exact) s
+ @ sure (Searchid.search_string_type ~mode:`Included) s
+ @ sure Searchid.search_pattern_symbol s
+let search s modules paths =
+ List.rev
+ @@ ExtList.List.unique
+ @@ List.rev_map ~f:to_result
+ @@ raw_search s modules paths
View
7 search.mli
@@ -1,15 +1,16 @@
type kind =
- Value of string
- | Type of string
+ Value of string (** type of the value *)
+ | Type of string (** type def. "" means abstract. *)
| Module
| ModuleType
| Class
| ClassType
| Other
type t = {
- id : string list;
+ id : string list; (** path of the object. ex. ["String"; "length"] for String.length. *)
kind : kind
}
val search : string -> string list -> string list -> t list
+val raw_search : string -> string list -> string list -> (Longident.t * Searchid.pkind) list
View
59 searchid.ml
@@ -25,6 +25,46 @@ open Env
open Btype
open Ctype
+module Stat = struct
+ (** search statistics *)
+ let type_included = ref 0
+ let type_exact = ref 0
+ let symbol = ref 0
+
+ let reset () =
+ type_included := 0;
+ type_exact := 0;
+ symbol := 0;
+ ()
+
+ type t = {
+ type_included : int;
+ type_exact : int;
+ symbol : int;
+ time : float
+ }
+
+ let format ppf t =
+ Format.fprintf ppf "%d type checks (inclusion: %d, exact: %d), %d symbol checks (%0.2f secs)"
+ (t.type_included + t.type_exact)
+ t.type_included
+ t.type_exact
+ t.symbol
+ t.time
+
+ let get f v =
+ reset ();
+ let start = Unix.gettimeofday () in
+ let res = try `Ok (f v) with e -> `Error e in
+ let end_ = Unix.gettimeofday () in
+ res, { type_included = !type_included;
+ type_exact = !type_exact;
+ symbol = !symbol;
+ time = end_ -. start
+ }
+
+end
+
(* only initial here, but replaced by Pervasives later *)
let start_env = ref initial
let module_list = ref []
@@ -214,8 +254,8 @@ let get_fields ~prefix ~sign self =
let rec search_type_in_signature t ~sign ~prefix ~mode =
let matches = match mode with
- `Included -> included t ~prefix
- | `Exact -> equal t ~prefix
+ `Included -> incr Stat.type_included; included t ~prefix
+ | `Exact -> incr Stat.type_exact; equal t ~prefix
and lid_of_id id = mklid (prefix @ [Ident.name id]) in
List2.flat_map sign ~f:
begin fun item -> match item with
@@ -349,6 +389,10 @@ let rec check_match ~pattern s =
| x::l, y::l' when x == y -> check_match ~pattern:l l'
| _ -> false
+let check_match ~pattern s =
+ incr Stat.symbol;
+ check_match ~pattern s
+
let search_pattern_symbol text =
if text = "" then [] else
let pattern = explode text in
@@ -377,12 +421,13 @@ let search_pattern_symbol text =
| _ -> []
end
| _ -> []
- with Env.Error _ ->
- Format.eprintf "Error: lookup_module %s failed@." modname;
- []
+ with
+ | Env.Error _ ->
+ Format.eprintf "Warning: lookup_module %s failed@." modname;
+ []
| Not_found ->
- Format.eprintf "Error: search_pattern_symbol raised Not_found for %s@." modname;
- []
+ Format.eprintf "Error: module %s was not found. Check modules.txt@." modname;
+ assert false
end
in
List2.flat_map l ~f:
View
12 searchid.mli
@@ -14,6 +14,18 @@
(* $Id: searchid.mli,v 1.6 2002/07/25 22:51:47 garrigue Exp $ *)
+module Stat : sig
+ (** search statistics *)
+ type t = {
+ type_included : int;
+ type_exact : int;
+ symbol : int;
+ time : float;
+ }
+ val format : Format.formatter -> t -> unit
+ val get : ('a -> 'b) -> 'a -> [> `Error of exn | `Ok of 'b ] * t
+end
+
val start_env : Env.t ref
val module_list : string list ref
val longident_of_path : Path.t ->Longident.t

0 comments on commit 31c4804

Please sign in to comment.