Add: Query coalescing for AND clauses

A later commit will update and add tests.

org-ql.el

@@ -694,6 +694,56 @@ returns nil."
 ;; partially typed queries in the Helm commands.
 (define-error 'org-ql-invalid-query "Invalid Org QL query" 'user-error)
 
+(defun org-ql--coalesce-ands (query)
+  "Return QUERY having coalesced any AND'ed clauses' predicates.
+Multiple calls to the same predicate within an `and' expression
+are coalesced into a single call to the predicate.
+
+Note that this is a relatively simple function which does not
+comprehensively coalesce every call that could be.  For example,
+if QUERY contained four calls to the `src' predicate with two
+unique language arguments, only the calls for one language would
+be coalesced."
+  ;; TODO: Use a per-predicate alist-getting function that accounts
+  ;; for arguments which must be unique...maybe...someday...
+
+  ;; NOTE: This implentation can sometimes reorder sub-expressions,
+  ;; like:
+  ;;
+  ;;   (and (src :regexps ("foo") :lang "elisp") (src :regexps ("bar")))
+  ;;
+  ;; becomes:
+  ;;
+  ;;   (and (src :regexps ("bar")) (src :regexps ("foo") :lang "elisp"))
+  ;;
+  ;; because the first one could be coalescable, but the second one
+  ;; can't be coalesced with it since they don't specify the same
+  ;; language.  That could be fixed, but it's probably not worth it.
+  (cl-labels ((rec (sexp)
+                   (pcase sexp
+                     (`(,(and boolean (or 'or 'not)) . ,sexps)
+                      `(,boolean ,@(mapcar #'rec sexps)))
+                     (`(and . ,sexps)
+                      (anded sexps))
+                     (_ sexp)))
+              (anded (sexps)
+                     (let (anded-predicates new-sexp)
+                       (dolist (sexp sexps)
+                         (pcase sexp
+                           (`(,(or 'or 'not) . ,_)
+                            (push (rec sexp) new-sexp))
+                           (`(,predicate . ,args)
+                            (pcase-exhaustive (plist-get (alist-get predicate org-ql-predicates) :coalesce-multiple-calls)
+                              (`nil (push sexp new-sexp))
+                              (`t (setf (alist-get predicate anded-predicates)
+                                        (append (alist-get predicate anded-predicates) args)))
+                              ((and fn (pred functionp))
+                               (if-let (new-args (funcall fn (alist-get predicate anded-predicates) args))
+                                   (setf (alist-get predicate anded-predicates) new-args)
+                                 (push sexp new-sexp)))))))
+                       (delq nil `(and ,@(nreverse new-sexp) ,@(nreverse anded-predicates))))))
+    (rec query)))
+
 (defun org-ql--sanity-check-form (form)
   "Signal error if any forms in FORM do not have preconditions met.
 Or, when possible, fix the problem."
@@ -967,7 +1017,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
                               (setf query new-query)
                               (when (eq (cl-incf count) limit)
                                 (error "Query normalization limit exceeded: QUERY:%S" query)))
-                         finally return new-query)))))))
+                         finally return (org-ql--coalesce-ands new-query))))))))
 
 (defun org-ql--define-query-preamble-fn (predicates)
   "Define function `org-ql--query-preamble' for PREDICATES.
@@ -1037,7 +1087,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
     ;; function still works.  But to avoid the warning, we byte-compile it afterward.
     (byte-compile 'org-ql--query-preamble)))
 
-(cl-defmacro org-ql-defpred (name args docstring &key body preambles normalizers)
+(cl-defmacro org-ql-defpred (name args docstring &key body preambles normalizers coalesce-multiple-calls)
   "Define an `org-ql' selector predicate named `org-ql--predicate-NAME'.
 NAME may be a symbol or a list of symbols: if a list, the first
 is used as NAME and the rest are aliases.  A function is only
@@ -1091,6 +1141,22 @@ to variables bound in the pattern:
               query expression with no work to do, which improves
               performance.
 
+When COALESCE-MULTIPLE-CALLS is t, multiple calls to this
+predicate within a query clause may be combined into a single
+call to this predicate (so it is expected that this predicate
+treats multiple arguments as being boolean AND'ed together).
+
+This value may also be a function called to do coalescing of two
+predicate expressions.  It is called with two arguments: the list
+of already-coalesced arguments to an expression, and the list of
+arguments to the call being coalesced (note that a query's
+arguments are normalized before the query is coalesced).  If it
+returns nil, the expression is not coalesced; otherwise, it
+should return a new list of arguments coalescing the given
+arguments, with new arguments being first.  (This is useful,
+e.g. when a predicate takes keyword arguments, which means that
+multiple calls to it can't be simply appended.)
+
 For convenience, within the `pcase' patterns, the symbol
 `predicate-names' is a special form which is replaced with a
 pattern matching any of the predicate's name and aliases.  For
@@ -1107,6 +1173,8 @@ It would be expanded to:
 
   ((`(,(or 'heading 'h) . ,args)
   `(heading ,@args)))"
+  ;; FIXME: Update defpred tutorial to include :coalesce-multiple-calls.
+
   ;; NOTE: The debug form works, completely!  For example, use `edebug-defun'
   ;; on the `heading' predicate, then evaluate this form:
   ;; (let* ((query '(heading "HEADING"))
@@ -1116,7 +1184,8 @@ It would be expanded to:
   ;;         :normalized normalized
   ;;         :preamble preamble))
   (declare (debug ([&or symbolp listp] listp stringp
-                   &rest [&or [":body" def-body]
+                   &rest [&or [":coalesce-multiple-calls" form]
+                              [":body" def-body]
                               [":normalizers" (&rest (sexp def-body))]
                               [":preambles" (&rest (sexp def-body))]]))
            (indent defun))
@@ -1137,7 +1206,8 @@ It would be expanded to:
        ;; SOMEDAY: Use `map-elt' here, after map 2.1 can be automatically installed in CI sandbox...
        (setf (alist-get ',predicate-name org-ql-predicates)
              `(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,(\, docstring) :args ,',args
-                     :normalizers ,',normalizers :preambles ,',preambles))
+                     :normalizers ,',normalizers :preambles ,',preambles
+                     :coalesce-multiple-calls ,,coalesce-multiple-calls))
        (unless org-ql-defpred-defer
          ;; Reversing preserves the order in which predicates were defined.
          (org-ql--define-normalize-query-fn (reverse org-ql-predicates))
@@ -1320,6 +1390,7 @@ Org effort string, like \"5\" or \"0:05\"."
 (org-ql-defpred (heading h) (&rest strings)
   "Return non-nil if current entry's heading matches all STRINGS.
 Matching is done case-insensitively."
+  :coalesce-multiple-calls t
   :normalizers ((`(,predicate-names . ,args)
                  ;; "h" alias.
                  `(heading ,@args)))
@@ -1346,6 +1417,7 @@ Matching is done case-insensitively."
 (org-ql-defpred (heading-regexp h*) (&rest regexps)
   "Return non-nil if current entry's heading matches all REGEXPS (regexp strings).
 Matching is done case-insensitively."
+  :coalesce-multiple-calls t
   :normalizers ((`(,predicate-names . ,args)
                  ;; "h" alias.
                  `(heading-regexp ,@args)))
@@ -1498,6 +1570,7 @@ the following queries:
   (olp \"Food\" \"Fruits\")
   (olp \"Fruits\" \"Grapes\")
   (olp \"Food\" \"Grapes\")"
+  :coalesce-multiple-calls t
   :normalizers ((`(,predicate-names . ,strings)
                  ;; Regexp quote headings.
                  `(org-ql--predicate-outline-path ,@(mapcar #'regexp-quote strings))))
@@ -1652,6 +1725,7 @@ priority B)."
 
 (org-ql-defpred (regexp r) (&rest regexps)
   "Return non-nil if current entry matches all of REGEXPS (regexp strings)."
+  :coalesce-multiple-calls t
   :normalizers ((`(,predicate-names . ,args)
                  `(regexp ,@args)))
   ;; MAYBE: Separate case-sensitive (Regexp) predicate.
@@ -1674,6 +1748,15 @@ priority B)."
   "Return non-nil if current entry contains an Org source block matching all of REGEXPS.
 If keyword argument LANG is non-nil, the block must be in that
 language."
+  :coalesce-multiple-calls (lambda (coalesced-args current-args)
+                             (when (or (not coalesced-args)
+                                       (equal (plist-get current-args :lang)
+                                              (plist-get coalesced-args :lang)))
+                               (setf (plist-get coalesced-args :regexps)
+                                     (append (plist-get coalesced-args :regexps)
+                                             (plist-get current-args :regexps))
+                                     (plist-get coalesced-args :lang) (plist-get current-args :lang))
+                               coalesced-args))
   :normalizers ((`(,predicate-names . ,args)
                  ;; Rewrite to use keyword args.
                  (cond ((cl-every #'stringp args)
@@ -1739,6 +1822,7 @@ Tests both inherited and local tags."
 (org-ql-defpred (tags-all tags&) (&rest tags)
   "Return non-nil if current heading has all of TAGS (a list of strings).
 Tests both inherited and local tags."
+  :coalesce-multiple-calls t
   ;; MAYBE: -all versions for inherited and local.
   :normalizers ((`(,predicate-names . ,tags)
                  `(and ,@(--map `(tags ,it) tags))))