diff options
| -rw-r--r-- | dev/doc/changes.txt | 6 | ||||
| -rw-r--r-- | test-suite/output/SearchPattern.out | 2 | ||||
| -rw-r--r-- | toplevel/search.ml | 55 | ||||
| -rw-r--r-- | toplevel/search.mli | 11 | ||||
| -rw-r--r-- | toplevel/vernacentries.ml | 41 |
5 files changed, 61 insertions, 54 deletions
diff --git a/dev/doc/changes.txt b/dev/doc/changes.txt index 6dd7cb9707..79a0c6312a 100644 --- a/dev/doc/changes.txt +++ b/dev/doc/changes.txt @@ -256,6 +256,12 @@ define_evar_* mostly used internally in the unification engine. - `Tacexpr.TacDynamic(Loc.dummy_loc, Pretyping.constr_in c)` --> `Tacinterp.Value.of_constr c` +** Search API ** + +The main search functions now take a function iterating over the +results. This allows for clients to use streaming or more economic +printing. + ========================================= = CHANGES BETWEEN COQ V8.4 AND COQ V8.5 = ========================================= diff --git a/test-suite/output/SearchPattern.out b/test-suite/output/SearchPattern.out index 1eb7eca8f1..f3c12effca 100644 --- a/test-suite/output/SearchPattern.out +++ b/test-suite/output/SearchPattern.out @@ -40,7 +40,6 @@ Nat.land: nat -> nat -> nat Nat.lor: nat -> nat -> nat Nat.ldiff: nat -> nat -> nat Nat.lxor: nat -> nat -> nat - S: nat -> nat Nat.succ: nat -> nat Nat.pred: nat -> nat @@ -74,7 +73,6 @@ le_n: forall n : nat, n <= n pair: forall A B : Type, A -> B -> A * B conj: forall A B : Prop, A -> B -> A /\ B Nat.divmod: nat -> nat -> nat -> nat -> nat * nat - h: n <> newdef n h: n <> newdef n h: P n diff --git a/toplevel/search.ml b/toplevel/search.ml index 921308f78a..ff3c7a4f42 100644 --- a/toplevel/search.ml +++ b/toplevel/search.ml @@ -29,17 +29,6 @@ query, separated by a newline. This type of output is useful for editors (like emacs), to generate a list of completion candidates without having to parse thorugh the types of all symbols. *) -let search_output_name_only = ref false - -let _ = - declare_bool_option - { optsync = true; - optdepr = false; - optname = "output-name-only search"; - optkey = ["Search";"Output";"Name";"Only"]; - optread = (fun () -> !search_output_name_only); - optwrite = (:=) search_output_name_only } - type glob_search_about_item = | GlobSearchSubPattern of constr_pattern | GlobSearchString of string @@ -118,18 +107,6 @@ let generic_search glnumopt fn = | Some glnum -> iter_hypothesis glnum fn); iter_declarations fn -(** Standard display *) -let plain_display accu ref env c = - let pr = pr_global ref in - if !search_output_name_only then - accu := pr :: !accu - else begin - let pc = pr_lconstr_env env Evd.empty c in - accu := hov 2 (pr ++ str":" ++ spc () ++ pc) :: !accu - end - -let format_display l = prlist_with_sep fnl (fun x -> x) (List.rev l) - (** Filters *) (** This function tries to see whether the conclusion matches a pattern. *) @@ -181,8 +158,7 @@ let search_about_filter query gr env typ = match query with (** SearchPattern *) -let search_pattern gopt pat mods = - let ans = ref [] in +let search_pattern gopt pat mods pr_search = let blacklist_filter = blacklist_filter_aux () in let filter ref env typ = module_filter mods ref env typ && @@ -190,10 +166,9 @@ let search_pattern gopt pat mods = blacklist_filter ref env typ in let iter ref env typ = - if filter ref env typ then plain_display ans ref env typ + if filter ref env typ then pr_search ref env typ in - let () = generic_search gopt iter in - format_display !ans + generic_search gopt iter (** SearchRewrite *) @@ -205,10 +180,9 @@ let rewrite_pat1 pat = let rewrite_pat2 pat = PApp (PRef eq, [| PMeta None; PMeta None; pat |]) -let search_rewrite gopt pat mods = +let search_rewrite gopt pat mods pr_search = let pat1 = rewrite_pat1 pat in let pat2 = rewrite_pat2 pat in - let ans = ref [] in let blacklist_filter = blacklist_filter_aux () in let filter ref env typ = module_filter mods ref env typ && @@ -217,15 +191,13 @@ let search_rewrite gopt pat mods = blacklist_filter ref env typ in let iter ref env typ = - if filter ref env typ then plain_display ans ref env typ + if filter ref env typ then pr_search ref env typ in - let () = generic_search gopt iter in - format_display !ans + generic_search gopt iter (** Search *) -let search_by_head gopt pat mods = - let ans = ref [] in +let search_by_head gopt pat mods pr_search = let blacklist_filter = blacklist_filter_aux () in let filter ref env typ = module_filter mods ref env typ && @@ -233,15 +205,13 @@ let search_by_head gopt pat mods = blacklist_filter ref env typ in let iter ref env typ = - if filter ref env typ then plain_display ans ref env typ + if filter ref env typ then pr_search ref env typ in - let () = generic_search gopt iter in - format_display !ans + generic_search gopt iter (** SearchAbout *) -let search_about gopt items mods = - let ans = ref [] in +let search_about gopt items mods pr_search = let blacklist_filter = blacklist_filter_aux () in let filter ref env typ = let eqb b1 b2 = if b1 then b2 else not b2 in @@ -251,10 +221,9 @@ let search_about gopt items mods = blacklist_filter ref env typ in let iter ref env typ = - if filter ref env typ then plain_display ans ref env typ + if filter ref env typ then pr_search ref env typ in - let () = generic_search gopt iter in - format_display !ans + generic_search gopt iter type search_constraint = | Name_Pattern of Str.regexp diff --git a/toplevel/search.mli b/toplevel/search.mli index 9f209a17e7..ba3d48efcc 100644 --- a/toplevel/search.mli +++ b/toplevel/search.mli @@ -39,11 +39,14 @@ val search_about_filter : glob_search_about_item -> filter_function goal and the global environment for things matching [pattern] and satisfying module exclude/include clauses of [modinout]. *) -val search_by_head : int option -> constr_pattern -> DirPath.t list * bool -> std_ppcmds -val search_rewrite : int option -> constr_pattern -> DirPath.t list * bool -> std_ppcmds -val search_pattern : int option -> constr_pattern -> DirPath.t list * bool -> std_ppcmds +val search_by_head : int option -> constr_pattern -> DirPath.t list * bool + -> display_function -> unit +val search_rewrite : int option -> constr_pattern -> DirPath.t list * bool + -> display_function -> unit +val search_pattern : int option -> constr_pattern -> DirPath.t list * bool + -> display_function -> unit val search_about : int option -> (bool * glob_search_about_item) list - -> DirPath.t list * bool -> std_ppcmds + -> DirPath.t list * bool -> display_function -> unit type search_constraint = (** Whether the name satisfies a regexp (uses Ocaml Str syntax) *) diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index df83f76851..f69bac437e 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1665,6 +1665,28 @@ let interp_search_about_item env = errorlabstrm "interp_search_about_item" (str "Unable to interp \"" ++ str s ++ str "\" either as a reference or as an identifier component") +(* 05f22a5d6d5b8e3e80f1a37321708ce401834430 introduced the + `search_output_name_only` option to avoid excessive printing when + searching. + + The motivation was to make search usable for IDE completion, + however, it is still too slow due to the non-indexed nature of the + underlying search mechanism. + + In the future we should deprecate the option and provide a fast, + indexed name-searching interface. +*) +let search_output_name_only = ref false + +let _ = + declare_bool_option + { optsync = true; + optdepr = false; + optname = "output-name-only search"; + optkey = ["Search";"Output";"Name";"Only"]; + optread = (fun () -> !search_output_name_only); + optwrite = (:=) search_output_name_only } + let vernac_search s gopt r = let r = interp_search_restriction r in let env,gopt = @@ -1676,16 +1698,25 @@ let vernac_search s gopt r = | Some g -> snd (Pfedit.get_goal_context g) , Some g in let get_pattern c = snd (intern_constr_pattern env c) in - let open Feedback in + let pr_search ref env c = + let pr = pr_global ref in + let pp = if !search_output_name_only + then pr + else begin + let pc = pr_lconstr_env env Evd.empty c in + hov 2 (pr ++ str":" ++ spc () ++ pc) + end + in Feedback.msg_notice pp + in match s with | SearchPattern c -> - msg_notice (Search.search_pattern gopt (get_pattern c) r) + Search.search_pattern gopt (get_pattern c) r pr_search | SearchRewrite c -> - msg_notice (Search.search_rewrite gopt (get_pattern c) r) + Search.search_rewrite gopt (get_pattern c) r pr_search | SearchHead c -> - msg_notice (Search.search_by_head gopt (get_pattern c) r) + Search.search_by_head gopt (get_pattern c) r pr_search | SearchAbout sl -> - msg_notice (Search.search_about gopt (List.map (on_snd (interp_search_about_item env)) sl) r) + Search.search_about gopt (List.map (on_snd (interp_search_about_item env)) sl) r pr_search let vernac_locate = let open Feedback in function | LocateAny (AN qid) -> msg_notice (print_located_qualid qid) |