From: Eshel Yaron Date: Tue, 3 Jan 2023 22:22:34 +0000 (+0200) Subject: ADDED: command for finding terms subsumed by a given term X-Git-Tag: V9.1.2-sweep-0.11.0~3 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a36ba90933a26426249b2a06c531863ee540037e;p=dict.git ADDED: command for finding terms subsumed by a given term * sweep.pl (sweep_term_search/2): new predicate. * sweeprolog.el (sweeprolog-term-search-in-buffer): new function. (sweeprolog-term-search): new command. * README.org ("Term Search"): new manual section. --- diff --git a/README.org b/README.org index f27dcde..757f19e 100644 --- a/README.org +++ b/README.org @@ -1322,6 +1322,36 @@ and reported as ~flymake~ diagnostics. To inhibit ~flymake~ from diagnosing implicit autoloads, customize the user option ~sweeprolog-note-implicit-autoloads~ to nil. +** Term Search +:PROPERTIES: +:CUSTOM_ID: term-search +:DESCRIPTION: Search for Prolog terms matching with a given structure +:ALT_TITLE: Term Search +:END: + +#+FINDEX: sweeprolog-term-search +#+KINDEX: C-c C-s +#+CINDEX: term search +#+CINDEX: search term +You can search for Prolog terms matching a given search term with the +command ~M-x sweeprolog-term-search~. This command, bound by default to +~C-c C-s~ in ~sweeprolog-mode~ buffers, prompts for a Prolog term to +search for and finds terms in the current buffer that the search term +subsumes. For example, to find if-then-else constructs in the current +buffer do ~C-c C-s _ ; _ -> _ RET~. + +#+FINDEX: sweeprolog-term-search-repeat-forward +#+FINDEX: sweeprolog-term-search-repeat-backward +#+KINDEX: C-s (sweeprolog-term-search-map) +#+KINDEX: C-r (sweeprolog-term-search-map) +All matching terms in the buffer are highlighted and the cursor moves +to the beginning of the next match after point. Typing ~C-s~ +immediately after a successful search invokes the command +~sweeprolog-term-search-repeat-forward~ which moves forward to the next +match. Likewise, typing ~C-r~ after a successful term search invokes +the command ~sweeprolog-term-search-repeat-backward~ which moves +backward to the previous match. + * Prolog Help :PROPERTIES: :CUSTOM_ID: prolog-help diff --git a/sweep.pl b/sweep.pl index f859eea..e7e3c46 100644 --- a/sweep.pl +++ b/sweep.pl @@ -73,7 +73,8 @@ sweep_file_missing_dependencies/2, sweep_format_head/2, sweep_format_term/2, - sweep_current_functors/2 + sweep_current_functors/2, + sweep_term_search/2 ]). :- use_module(library(pldoc)). @@ -978,3 +979,54 @@ sweep_current_functors(A0, Col) :- atom_string(F0, F) ), Col). + +sweep_term_search([Path0|String], Res) :- + term_string(Term, String), + atom_string(Path, Path0), + setup_call_cleanup(prolog_open_source(Path, Stream), + sweep_search_stream(Stream, Term, Res), + prolog_close_source(Stream)). + +sweep_search_stream(Stream, Term, Res) :- + prolog_read_source_term(Stream, Term0, _, [subterm_positions(TermPos)]), + sweep_search_stream_(Term0, TermPos, Stream, Term, Res). + +sweep_search_stream_(end_of_file, _, _, _, []) :- + !. +sweep_search_stream_(Term0, TermPos, Stream, Term, Res) :- + findall([HS|HE], + sweep_match_term(TermPos, Term0, Term, HS, HE), + Res, + Tail), + sweep_search_stream(Stream, Term, Tail). + +sweep_match_term(Pos, Term0, Term, From, To) :- + compound(Pos), + Pos \= parentheses_term_position(_, _, _), + arg(1, Pos, From), + arg(2, Pos, To), + subsumes_term(Term, Term0). +sweep_match_term(brace_term_position(_, _, Arg), {Term0}, Term, From, To) :- + sweep_match_term(Arg, Term0, Term, From, To). +sweep_match_term(list_position(_, _, Elms, _), Term0, Term, From, To) :- + nth0(I, Elms, Elm), + nth0(I, Term0, Term1), + sweep_match_term(Elm, Term1, Term, From, To). +sweep_match_term(list_position(_, _, _, Tail), Term0, Term, From, To) :- + list_tail(Term0, Term1), + sweep_match_term(Tail, Term1, Term, From, To). +sweep_match_term(term_position(_, _, _, _, SubPos), Term0, Term, From, To) :- + nth1(I, SubPos, Sub), + arg(I, Term0, Term1), + sweep_match_term(Sub, Term1, Term, From, To). +sweep_match_term(dict_position(_, _, _, _, KeyValuePosList), Term0, Term, From, To) :- + member(key_value_position(_, _, _, _, Key, _, ValuePos), KeyValuePosList), + get_dict(Key, Term0, Term1), + sweep_match_term(ValuePos, Term1, Term, From, To). +sweep_match_term(parentheses_term_position(_, _, ContentPos), Term0, Term, From, To) :- + sweep_match_term(ContentPos, Term0, Term, From, To). +sweep_match_term(quasi_quotation_position(_, _, SyntaxTerm, SyntaxPos, _), _, Term, From, To) :- + sweep_match_term(SyntaxPos, SyntaxTerm, Term, From, To). + +list_tail([_|T0], T) :- T0 = [_|_], !, list_tail(T0, T). +list_tail([_|T], T). diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el index c27eb36..f2d4206 100644 --- a/sweeprolog-tests.el +++ b/sweeprolog-tests.el @@ -78,6 +78,28 @@ foo(Baz) :- baz. (should (not (sweeprolog-beginning-of-next-top-term))) (should (= (point) 19)))) +(ert-deftest beginning-of-next-top-term () + "Test `sweeprolog-term-search'." + (let ((temp (make-temp-file "sweeprolog-test" + nil + "pl" + " +bar(bar(bar), bar{bar:bar}, [bar,bar|bar]). +"))) + (find-file-literally temp) + (sweeprolog-mode) + (goto-char (point-min)) + (sweeprolog-term-search "bar") + (should (= (point) 10)) + (sweeprolog-term-search "bar") + (should (= (point) 24)) + (sweeprolog-term-search "bar") + (should (= (point) 31)) + (sweeprolog-term-search "bar") + (should (= (point) 35)) + (sweeprolog-term-search "bar") + (should (= (point) 39)))) + (ert-deftest beginning-of-next-top-term-header () "Test finding the beginning of the first top term." (let ((temp (make-temp-file "sweeprolog-test" diff --git a/sweeprolog.el b/sweeprolog.el index bcd444f..95427cd 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -390,6 +390,7 @@ determinism specification, and the third is a summary line." (define-key map (kbd "C-c C-l") #'sweeprolog-load-buffer) (define-key map (kbd "C-c C-m") #'sweeprolog-insert-term-with-holes) (define-key map (kbd "C-c C-o") #'sweeprolog-find-file-at-point) + (define-key map (kbd "C-c C-s") #'sweeprolog-term-search) (define-key map (kbd "C-c C-t") #'sweeprolog-top-level) (define-key map (kbd "C-c C-u") #'sweeprolog-update-dependencies) (define-key map (kbd "C-c C-`") @@ -487,6 +488,9 @@ determinism specification, and the third is a summary line." (eq major-mode 'sweeprolog-mode) ] [ "Infer Indentation Style" sweeprolog-infer-indent-style (eq major-mode 'sweeprolog-mode) ] + [ "Search Term" sweeprolog-term-search + (derived-mode-p 'sweeprolog-mode)] + "--" [ "Set Prolog Flag" sweeprolog-set-prolog-flag t ] [ "Install Prolog Package" sweeprolog-pack-install t ] "--" @@ -4625,6 +4629,125 @@ propely." #'sweeprolog-command-line-function)) +;;;; Term Search + +(defvar sweeprolog-term-search-last-term nil + "Last term searched with `sweeprolog-term-search'.") + +(defvar sweeprolog-term-search-read-term-history nil + "History list for `sweeprolog-term-search-read-term'.") + +(defvar-local sweeprolog-term-search-overlays nil + "List of `sweeprolog-term-search' overlays in the current buffer.") + +(defun sweeprolog-term-search-delete-overlays () + "Delete overlays created by `sweeprolog-term-search'." + (interactive "" sweeprolog-mode) + (mapc #'delete-overlay sweeprolog-term-search-overlays) + (setq sweeprolog-term-search-overlays nil)) + +(defun sweeprolog-term-search-repeat-forward () + "Repeat last `sweeprolog-term-search' searching forward from point." + (interactive "" sweeprolog-mode) + (sweeprolog-term-search sweeprolog-term-search-last-term)) + +(defun sweeprolog-term-search-repeat-backward () + "Repeat last `sweeprolog-term-search' searching backward from point." + (interactive "" sweeprolog-mode) + (sweeprolog-term-search sweeprolog-term-search-last-term t)) + +(defvar sweeprolog-term-search-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-m") #'sweeprolog-term-search-delete-overlays) + (define-key map (kbd "C-r") #'sweeprolog-term-search-repeat-backward) + (define-key map (kbd "C-s") #'sweeprolog-term-search-repeat-forward) + map) + "Transient keymap activated after `sweeprolog-term-search'.") + +(defun sweeprolog-term-search-in-buffer (term &optional buffer) + "Search for Prolog term TERM in buffer BUFFER. + +Return a list of (BEG . END) cons cells where BEG is the buffer +position of the beginning of a matching term and END is its +corresponding end position." + (setq buffer (or buffer (current-buffer))) + (with-current-buffer buffer + (let ((offset (point-min))) + (mapcar (lambda (match) + (cons (+ offset (car match)) + (+ offset (cdr match)))) + (sweeprolog--query-once "sweep" "sweep_term_search" + (cons buffer-file-name term)))))) + +(defun sweeprolog-term-search-read-term () + "Read a Prolog term for searching with `sweeprolog-term-search'." + (read-string "[search] ?- " nil + sweeprolog-term-search-read-term-history)) + +(defun sweeprolog-term-search-next (point overlays backward) + "Return first overlay in OVERLAYS starting after POINT. +If no overlay starts after POINT, return the first overlay. + +If BACKWARD is non-nil, return last overlay ending before POINT +instead, or the last overlay if no overlay ends before POINT." + (if backward + (let* ((match nil) + (reversed (reverse overlays)) + (first (car reversed))) + (while (and reversed (not match)) + (let ((head (car reversed)) + (tail (cdr reversed))) + (if (<= (overlay-end head) point) + (setq match head) + (setq reversed tail)))) + (or match first)) + (let ((match nil) + (first (car overlays))) + (while (and overlays (not match)) + (let ((head (car overlays)) + (tail (cdr overlays))) + (if (< point (overlay-start head)) + (setq match head) + (setq overlays tail)))) + (or match first)))) + +(defun sweeprolog-term-search (term &optional backward) + "Search forward for Prolog term TERM in the current buffer. + +If BACKWARD is non-nil, search backward instead." + (interactive (list (sweeprolog-term-search-read-term) nil) + sweeprolog-mode) + (sweeprolog-term-search-delete-overlays) + (setq sweeprolog-term-search-last-term term) + (let ((matches (sweeprolog-term-search-in-buffer term))) + (if (not matches) + (message "No matching term found.") + (setq sweeprolog-term-search-overlays + (mapcar (lambda (match) + (let* ((beg (car match)) + (end (cdr match)) + (overlay (make-overlay beg end))) + (overlay-put overlay 'face 'lazy-highlight) + (overlay-put overlay 'evaporate t) + overlay)) + matches)) + (let ((next + (sweeprolog-term-search-next + (point) sweeprolog-term-search-overlays backward))) + (overlay-put next 'face 'isearch) + (push-mark (point) t) + (goto-char (overlay-start next))) + (set-transient-map sweeprolog-term-search-map t + #'sweeprolog-term-search-delete-overlays) + (message + (substitute-command-keys + (concat + "Found " (number-to-string (length matches)) + " occurences of `" term "'. " + "\\" + "\\[sweeprolog-term-search-repeat-forward] for next match, " + "\\[sweeprolog-term-search-repeat-backward] for previous match.")))))) + ;;;; Footer (provide 'sweeprolog)