Add: Query coalescing for AND clauses

A later commit will update and add tests.

README.org

@@ -544,6 +544,9 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
 *Changed*
 +  Give more useful error message for invalid queries.
 
+*Internal*
++  Certain query predicates, when called multiple times in an ~and~ sub-expression, are optimized to a single call.
+
 ** 0.6.2
 
 *Fixed*

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))))

org-ql.info

@@ -1015,6 +1015,10 @@ File: README.info,  Node: 07-pre,  Next: 062,  Up: Changelog
    *Changed*
    • Give more useful error message for invalid queries.
 
+   *Internal*
+   • Certain query predicates, when called multiple times in an ‘and’
+     sub-expression, are optimized to a single call.
+
 
 File: README.info,  Node: 062,  Next: 061,  Prev: 07-pre,  Up: Changelog
 
@@ -1659,34 +1663,34 @@ Node: Links36258
 Node: Tips36945
 Node: Changelog37269
 Node: 07-pre38037
-Node: 06238642
+Node: 06238786
-Node: 06138950
+Node: 06139094
-Node: 0639518
+Node: 0639662
-Node: 05242572
+Node: 05242716
-Node: 05142872
+Node: 05143016
-Node: 0543295
+Node: 0543439
-Node: 04944824
+Node: 04944968
-Node: 04845104
+Node: 04845248
-Node: 04745451
+Node: 04745595
-Node: 04645860
+Node: 04646004
-Node: 04546268
+Node: 04546412
-Node: 04446629
+Node: 04446773
-Node: 04346988
+Node: 04347132
-Node: 04247191
+Node: 04247335
-Node: 04147352
+Node: 04147496
-Node: 0447599
+Node: 0447743
-Node: 03251700
+Node: 03251844
-Node: 03152103
+Node: 03152247
-Node: 0352300
+Node: 0352444
-Node: 02355600
+Node: 02355744
-Node: 02255834
+Node: 02255978
-Node: 02156114
+Node: 02156258
-Node: 0256319
+Node: 0256463
-Node: 0160397
+Node: 0160541
-Node: Notes60498
+Node: Notes60642
-Node: Comparison with Org Agenda searches60660
+Node: Comparison with Org Agenda searches60804
-Node: org-sidebar61549
+Node: org-sidebar61693
-Node: License61828
+Node: License61972
 
 End Tag Table