From 3fe4bcb60cdd6bd333a1aa10c6ed95e23029a608 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 23 Sep 2023 15:31:07 +0200 Subject: [PATCH] Extract subsumed goals when extracting goal to predicate Extend 'sweeprolog-extract-region-to-predicate' with the ability to replace other goals in the current buffer that are subsumed by the extracted goal with calls to the predicate this command creates. 'sweeprolog-extract-region-to-predicate' now does this when it is called with a prefix argument. Also make 'sweeprolog-insert-term-dwim' propagate the prefix argument to functions in 'sweeprolog-insert-term-functions'. * sweeprolog.el (sweeprolog-insert-term-dwim): Add ARG argument and pass it to functions listed... (sweeprolog-insert-term-functions): ...here. Adjust docstring. (sweeprolog-maybe-insert-next-clause) (sweeprolog-maybe-define-predicate) (sweeprolog-maybe-extract-region-to-predicate): Adjust accordingly. (sweeprolog-default-new-predicate-location): Go to end of line in case there's a comment on the last line of the current predicate definition. (sweeprolog-query-replace-term-include-match-function): New variable. (sweeprolog-query-replace-term): Use it. (sweeprolog-extract-region-to-predicate): Add ALL argument. When non-nil, suggest replacing all goals in the buffer that are subsumbed by the extracted goal with calls to the newly defined predicate. --- sweep.texi | 27 +++++++-- sweeprolog.el | 160 +++++++++++++++++++++++++++++++------------------- 2 files changed, 119 insertions(+), 68 deletions(-) diff --git a/sweep.texi b/sweep.texi index 453638e..c8e24c6 100644 --- a/sweep.texi +++ b/sweep.texi @@ -2149,16 +2149,23 @@ inserting a Prolog term based on the current context. To determine which term to insert and exactly where, the command @code{sweeprolog-insert-term-dwim} calls the functions in the list -held by the variable @code{sweeprolog-insert-term-functions} one after -the other until one of the functions signal success by returning -non-@code{nil}. +@code{sweeprolog-insert-term-functions} one after the other until one +of them succeeds. The functions on this list are called @dfn{term +insertion functions}, each insertion function takes two +arguments---the position where you invoke +@code{sweeprolog-insert-term-dwim} and the prefix argument you give +it, if any---and returns non-@code{nil} after performing its specific +insertion if it is applicable in the current context. -By default, @code{sweeprolog-insert-term-dwim} tries the following -insertion functions, in order: +By default, @code{sweeprolog-insert-term-functions} contains the +following insertion functions: @defun sweeprolog-maybe-extract-region-to-predicate If the region is active and selects a goal, extract the selected goal -into a separate predicate. @xref{Extract Goal}. +into a separate predicate. With a prefix argument, also suggest +replacing other goals in the buffer that the selected goal subsumes +with invocations of the new predicate that this function creates. +@xref{Extract Goal}. @end defun @defun sweeprolog-maybe-insert-next-clause @@ -2718,6 +2725,14 @@ directly to any key in Sweep Prolog mode; instead, you can invoke it by typing @kbd{M-@key{RET}} (@code{sweeprolog-insert-term-dwim}) when the region is active. @xref{Insert Term DWIM}. +If you invoke @code{sweeprolog-extract-region-to-predicate} with a +prefix argument---either directly or via +@code{sweeprolog-insert-term-dwim} by typing @kbd{C-u M-@key{RET}} +with an active region---then after extracting the selected goal to a +new predicate, this command searches the current buffer for other +goals that the selected goal subsumes, and suggests replacing them +with invocations of the newly defined predicate. @xref{Term Replace}. + With Context Menu mode enabled, you can also invoke this command by right-clicking on an active region and selecting @samp{Extract to New Predicate}. diff --git a/sweeprolog.el b/sweeprolog.el index 6ead965..d70d225 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -59,13 +59,9 @@ '(sweeprolog-maybe-extract-region-to-predicate sweeprolog-maybe-insert-next-clause sweeprolog-maybe-define-predicate) - "Hook of functions that insert a Prolog term in a certain context. + "List of functions that insert a Prolog term in a certain context. -Each hook function is called with four arguments describing the -current context. The first argument, POINT, is the buffer -position in which insertion should take place. The rest of the -arguments, KIND, BEG and END, describe the previous non-comment -Prolog token as returned from `sweeprolog-last-token-boundaries'.") +See `sweeprolog-insert-term-dwim' for more details.") (defvar sweeprolog-mode-syntax-table (let ((table (make-syntax-table))) @@ -3845,24 +3841,29 @@ of the prefix argument." (goto-char point) (sweeprolog-forward-hole))) -(defun sweeprolog-maybe-insert-next-clause (point kind beg end) - (when-let ((current-predicate (and (eq kind 'operator) - (string= "." (buffer-substring-no-properties beg end)) - (sweeprolog-definition-at-point point)))) - (let ((functor (nth 1 current-predicate)) - (arity (nth 2 current-predicate)) - (neck (nth 4 current-predicate)) - (module (nth 5 current-predicate))) - (goto-char end) - (end-of-line) - (sweeprolog-insert-clause functor - arity - neck - module) - t))) +(defun sweeprolog-maybe-insert-next-clause (point _arg) + (let* ((bounds (sweeprolog-last-token-boundaries point)) + (kind (car bounds)) + (beg (cadr bounds)) + (end (caddr bounds))) + (when-let ((current-predicate (and (eq kind 'operator) + (string= "." (buffer-substring-no-properties beg end)) + (sweeprolog-definition-at-point point)))) + (let ((functor (nth 1 current-predicate)) + (arity (nth 2 current-predicate)) + (neck (nth 4 current-predicate)) + (module (nth 5 current-predicate))) + (goto-char end) + (end-of-line) + (sweeprolog-insert-clause functor + arity + neck + module) + t)))) (defun sweeprolog-default-new-predicate-location (&rest _) - (sweeprolog-end-of-predicate-at-point)) + (sweeprolog-end-of-predicate-at-point) + (end-of-line)) (defun sweeprolog-new-predicate-location-above-current (&rest _) (sweeprolog-beginning-of-predicate-at-point) @@ -3870,7 +3871,7 @@ of the prefix argument." (point-min)))) (while (re-search-backward (rx bol "%" (or "%" "!")) last t)))) -(defun sweeprolog-maybe-define-predicate (point _kind _beg _end) +(defun sweeprolog-maybe-define-predicate (point _arg) (let ((functor nil) (arity nil) (neck ":-")) @@ -3901,22 +3902,19 @@ of the prefix argument." neck) t))) -(defun sweeprolog-insert-term-dwim (&optional point) +(defun sweeprolog-insert-term-dwim (&optional point arg) "Insert an appropriate Prolog term at POINT. -This command calls the functions in -`sweeprolog-insert-term-functions' one after the other until one -of them signal success by returning non-nil." - (interactive "d" sweeprolog-mode) +Call the functions in `sweeprolog-insert-term-functions' one +after the other, with two arguments POINT and ARG, until one of +them returns non-nil. + +Interactively, POINT is point and ARG is the prefix argument." + (interactive "d\nP" sweeprolog-mode) (setq point (or point (point))) - (let* ((bounds (sweeprolog-last-token-boundaries)) - (kind (car bounds)) - (beg (cadr bounds)) - (end (caddr bounds))) - (unless (run-hook-with-args-until-success - 'sweeprolog-insert-term-functions - point kind beg end) - (user-error "No term insertion function applies here")))) + (unless (run-hook-with-args-until-success + 'sweeprolog-insert-term-functions point arg) + (user-error "No term insertion function applies here"))) (defun sweeprolog-at-beginning-of-top-term-p () (and (looking-at-p (rx bol graph)) @@ -5857,6 +5855,17 @@ prompt for CLASS as well. A negative prefix argument (message "No matching term found.")) (mapc #'delete-overlay overlays)))) +(defvar sweeprolog-query-replace-term-include-match-function #'always + "Function used to filter matching terms for `sweeprolog-query-replace-term'. + +This function is called with one argument, a list (BEG END REP), +describing a term matching the current execution of +`sweeprolog-query-replace-term'. BEG and END are the buffer +positions of the beginning and end of the matching term, and REP +is the replacement string for that match. If this function +returns nil, the corresponding match is filtered out and +`sweeprolog-query-replace-term' does not suggest replacing it.") + ;;;###autoload (defun sweeprolog-query-replace-term (template replacement &optional condition class) "Replace some terms after point matching TEMPLATE with REPLACEMENT. @@ -5923,7 +5932,9 @@ prompt for CLASS as well." (overlay-put overlay 'face 'sweeprolog-query-replace-term-match) (overlay-put overlay 'sweeprolog-term-replacement rep) overlay)) - items)) + (seq-filter + sweeprolog-query-replace-term-include-match-function + items))) (count 0) (last nil) (try nil)) @@ -7099,12 +7110,17 @@ This function is used as a `add-log-current-defun-function' in ;;;; Extract goals to separate predicates -(defun sweeprolog-extract-region-to-predicate (beg end new) +(defun sweeprolog-extract-region-to-predicate (beg end new &optional all) "Extract the Prolog goal from BEG to END into a new predicate, NEW. -BEG and END are buffer positions; interactively, these are the -beginning and end of the current region. NEW is a string used as -the functor of the new predicate; interactively, this command +BEG and END are buffer positions, and NEW is a string used as the +functor of the new predicate. If the optional argument ALL is +non-nil, after extracting the selected goal, search for other +occurrences of this goal in the current buffer and suggest +replacing them with calls to the newly defined predicate. + +Interactively, BEG and END are the beginning and end of the +current region, ALL is the prefix argument, and this command prompts for NEW in the minibuffer. This command defines the new predicate with arguments based on @@ -7113,9 +7129,11 @@ clause. The user option `sweeprolog-new-predicate-location-function' says where in the buffer to insert the newly created predicate." - (interactive "r\nsNew predicate functor: " sweeprolog-mode) + (interactive "r\nsNew predicate functor: \np" sweeprolog-mode) ;; TODO - check that NEW isn't already used (let* ((name (sweeprolog-format-string-as-atom new)) + (head nil) + (neck nil) (body (buffer-substring-no-properties beg end)) (vars (condition-case error (sweeprolog--query-once "sweep" "sweep_term_variable_names" @@ -7128,8 +7146,8 @@ where in the buffer to insert the newly created predicate." "scope would change as a result of this " "operation. Continue?")))) (message "Canceled.") + (goto-char beg) (combine-after-change-calls - (goto-char beg) (delete-region beg end) (insert name) (let* ((clause-beg (save-excursion @@ -7144,33 +7162,51 @@ where in the buffer to insert the newly created predicate." (buffer-substring-no-properties clause-beg clause-end)) (prolog-exception (sweeprolog-local-variables-collection)))) - (neck (or (nth 4 (sweeprolog-definition-at-point)) ":-")) - (args (seq-intersection vars clause-vars #'string=))) - (when args - (insert "(" (mapconcat #'identity args ", ") ")")) + (args (seq-intersection vars clause-vars #'string=)) + (args-string (when args + (concat "(" + (mapconcat #'identity args ", ") + ")")))) + (setq head (concat name args-string) + neck (or (nth 4 (sweeprolog-definition-at-point)) ":-")) + (when args-string (insert args-string)) (funcall sweeprolog-new-predicate-location-function name (length args) neck) - (let ((def-beg (1+ (point)))) - (insert (concat "\n" - name - (when args - (concat "(" (mapconcat #'identity args ", ") ")")) - " " - neck - "\n" - body - ".\n")) + (let ((def-beg (1+ (point))) + (clause (concat "\n" + head + " " + neck + "\n" + body + ".\n"))) + (insert clause) (indent-region-line-by-line def-beg (point)) - (goto-char def-beg) - (sweeprolog-analyze-buffer))))))) - -(defun sweeprolog-maybe-extract-region-to-predicate (&rest _) + (goto-char def-beg)))) + (when all + (let ((body-beg + (+ 2 (point) + (length head) + (length neck) + sweeprolog-indent-offset))) + (save-excursion + (goto-char (point-min)) + (let ((sweeprolog-query-replace-term-include-match-function + (pcase-lambda (`(,beg . ,_)) + (not (= beg body-beg))))) + (deactivate-mark) + (sweeprolog-query-replace-term + body head "true" '(goal)))))) + (sweeprolog-analyze-buffer)))) + +(defun sweeprolog-maybe-extract-region-to-predicate (_point arg) (when (and (use-region-p) (sweeprolog-context-callable-p (use-region-beginning))) (sweeprolog-extract-region-to-predicate (use-region-beginning) (use-region-end) - (read-string "Extract region to new predicate: ")) + (read-string "Extract region to new predicate: ") + arg) t)) ;;;; Bug Reports -- 2.39.2