From 968a249ae36574f0f4f623363b6a7c2e27af1fc8 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 9 Jun 2022 22:54:57 -0500 Subject: [PATCH] Add: Query coalescing for AND clauses A later commit will update and add tests. --- README.org | 3 ++ org-ql.el | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++--- org-ql.info | 60 ++++++++++++++++++---------------- 3 files changed, 123 insertions(+), 32 deletions(-) diff --git a/README.org b/README.org index 2a07b87..25f3257 100644 --- a/README.org +++ b/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* diff --git a/org-ql.el b/org-ql.el index 56ab9ea..1cb78ad 100644 --- a/org-ql.el +++ b/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)))) diff --git a/org-ql.info b/org-ql.info index 5205d5c..684a19e 100644 --- a/org-ql.info +++ b/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: 06138950 -Node: 0639518 -Node: 05242572 -Node: 05142872 -Node: 0543295 -Node: 04944824 -Node: 04845104 -Node: 04745451 -Node: 04645860 -Node: 04546268 -Node: 04446629 -Node: 04346988 -Node: 04247191 -Node: 04147352 -Node: 0447599 -Node: 03251700 -Node: 03152103 -Node: 0352300 -Node: 02355600 -Node: 02255834 -Node: 02156114 -Node: 0256319 -Node: 0160397 -Node: Notes60498 -Node: Comparison with Org Agenda searches60660 -Node: org-sidebar61549 -Node: License61828 +Node: 06238786 +Node: 06139094 +Node: 0639662 +Node: 05242716 +Node: 05143016 +Node: 0543439 +Node: 04944968 +Node: 04845248 +Node: 04745595 +Node: 04646004 +Node: 04546412 +Node: 04446773 +Node: 04347132 +Node: 04247335 +Node: 04147496 +Node: 0447743 +Node: 03251844 +Node: 03152247 +Node: 0352444 +Node: 02355744 +Node: 02255978 +Node: 02156258 +Node: 0256463 +Node: 0160541 +Node: Notes60642 +Node: Comparison with Org Agenda searches60804 +Node: org-sidebar61693 +Node: License61972  End Tag Table