diff --git a/README.org b/README.org index b2693f6..07d9bbe 100644 --- a/README.org +++ b/README.org @@ -236,6 +236,9 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to *Changed* + ~(regexp)~ selector accepts multiple regexps to test. +*Internal* ++ Optimizations for some query selectors, e.g. =regexp= and =todo=. These can provide a significant improvement for some queries. See benchmarks in [[file:notes.org][notes.org]]. + ** 0.1 First tagged release. diff --git a/notes.org b/notes.org index 20c767e..66af1a3 100644 --- a/notes.org +++ b/notes.org @@ -48,7 +48,7 @@ This would be useful for having a menu of saved queries as Org links, or even bo ** TODO [#A] Store query for refreshing ql-agenda buffer -** UNDERWAY [#B] Dual matching with regexp and predicates +** DONE [#B] Dual matching with regexp and predicates :PROPERTIES: :ID: 39972bb5-fdd0-4754-93ba-c85796a67ccf :END: @@ -69,6 +69,83 @@ Only entries that contain the word =lisp= can be matches, and searching each ent This would require processing the predicate to pull out matchers that can be done as buffer-wide regexps, e.g. =regexp=, =heading-regexp=, =todo=, and possibly =tags=. Org has some regexp-building functions that might make this fairly easy, and then we could probably use ~rx~ to make an optimized version of the regexp. It would also require some refactoring to the searching that would go directly to regexp matches when possible, rather than checking every entry with the predicate. +[2019-07-16 Tue 11:14] Made new branch =preamble-re-new= based on current =master=. Seems to work well. Here's some code for testing and comparing performance (~bench-multi-lets~ is from [[https://github.com/alphapapa/emacs-package-dev-handbook#bench-multi-lets][here]]). + +[2019-07-16 Tue 11:56] Going to merge to =master= as 0.2, so marking this as done, even though there's a bit more that can be done from here. + +*** Benchmark code + +#+BEGIN_SRC elisp + (cl-defmacro org-ql-preamble-bench (&key query (file "tests/data.org") (times 10)) + `(bench-multi-lets :times ,times :ensure-equal t + :lets (("preamble" ((org-ql-use-preamble t))) + ("no preamble" ((org-ql-use-preamble nil)))) + :forms ((,(prin1-to-string query) (org-ql-query ,file + ',query + :action (lambda () (org-get-heading t t))))))) +#+END_SRC + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :query (regexp "Emacs") :times 100) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (regexp "Emacs") | 1.22 | 0.141767 | 0 | 0 | +| no preamble: (regexp "Emacs") | slowest | 0.172398 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (regexp "Emacs") :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (regexp "Emacs") | 1.59 | 2.011043 | 0 | 0 | +| no preamble: (regexp "Emacs") | slowest | 3.206370 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo)) :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (and (regexp "Emacs") (todo)) | 1.59 | 2.211503 | 0 | 0 | +| no preamble: (and (regexp "Emacs") (todo)) | slowest | 3.512741 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo) (scheduled)) :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (and (regexp "Emacs") (todo) (scheduled)) | 1.69 | 2.042456 | 0 | 0 | +| no preamble: (and (regexp "Emacs") (todo) (scheduled)) | slowest | 3.453756 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (todo "WAITING") :times 2) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (todo "WAITING") | 15.60 | 0.070684 | 0 | 0 | +| no preamble: (todo "WAITING") | slowest | 1.102722 | 0 | 0 | + +Wow, that's a huge improvement! + +** TODO Normalize queries + +[2019-07-16 Tue 11:49] This serves two purposes: + +1. Equivalent queries will return the same results from the cache. +2. The selectors that can be converted to the fastest preamble regexps will be sorted first, so the fastest preamble will be used. Although this may not always be straightforward. For example, in a file with only a few =TODO= items, the ~(todo "TODO")~ selector would convert to a preamble that would quickly search through the file. But if there were a thousand =TODO= items, it wouldn't be as much of a benefit, and a ~(regexp "something")~ selector's preamble might be much faster, depending on how many times =something= appears in the file. + +So the second purpose might actually be a drawback, because it would prevent users from optimizing their queries with knowledge of their data. Maybe there should be an option to not normalize queries, so advanced users can order their selectors manually. + ** TODO [#A] Publish to MELPA ** TODO Add more sorters? diff --git a/org-ql.el b/org-ql.el index 36c3742..dd0a4b5 100644 --- a/org-ql.el +++ b/org-ql.el @@ -127,91 +127,93 @@ SORT is either nil, in which case items are not sorted; or one or a list of defined `org-ql' sorting methods: `date', `deadline', `scheduled', `todo', and `priority'." (declare (indent defun)) - (let* ((sources (pcase buffers-or-files - (`nil (list (current-buffer))) - ((pred listp) buffers-or-files) - (_ ; Buffer or string - (list buffers-or-files)))) - (predicate (byte-compile `(lambda () - ;; This is either really elegant or really ugly. Well, also - ;; possibly somewhere in-between. At the least, we should do - ;; this in a more flexible, abstracted way, but this will do - ;; for now. Most importantly, it works! - (let (from to on) - ;; TODO: DRY these macrolets. - (cl-macrolet ((clocked (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' - ;; function, not another `clocked'. - `(org-ql--predicate-clocked :from ,from :to ,to)) - (ts (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts :from ,from :to ,to)) - (ts-active (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-active :from ,from :to ,to)) - (ts-inactive (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-inactive :from ,from :to ,to))) - (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda - (= #'=) - (< #'<) - (> #'>) - (<= #'<=) - (>= #'>=)) - ,query)))))) - (action (byte-compile action)) - ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. - ;; (org-use-tag-inheritance t) - ;; (org-trust-scanner-tags t) - (org-ql--today (org-today)) - (items (->> sources - ;; List buffers - (--map (cl-etypecase it - (buffer it) - (string (or (find-buffer-visiting it) - (when (file-readable-p it) - ;; It feels unintuitive that `find-file-noselect' returns - ;; a buffer if the filename doesn't exist. - (find-file-noselect it)) - (user-error "Can't open file: %s" it))))) - ;; Filter buffers (i.e. select items) - (--map (with-current-buffer it - (unless (derived-mode-p 'org-mode) - (user-error "Not an Org buffer: %s" (buffer-name))) - (org-ql--select-cached :query query :predicate predicate :action action :narrow narrow))) - ;; Flatten items - (-flatten-n 1)))) + (-let* ((sources (pcase buffers-or-files + (`nil (list (current-buffer))) + ((pred listp) buffers-or-files) + (_ ; Buffer or string + (list buffers-or-files)))) + ((query preamble-re) (org-ql--query-preamble query)) + (predicate (byte-compile `(lambda () + ;; This is either really elegant or really ugly. Well, also + ;; possibly somewhere in-between. At the least, we should do + ;; this in a more flexible, abstracted way, but this will do + ;; for now. Most importantly, it works! + (let (from to on) + ;; TODO: DRY these macrolets. + (cl-macrolet ((clocked (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' + ;; function, not another `clocked'. + `(org-ql--predicate-clocked :from ,from :to ,to)) + (ts (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts :from ,from :to ,to)) + (ts-active (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts-active :from ,from :to ,to)) + (ts-inactive (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts-inactive :from ,from :to ,to))) + (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda + (= #'=) + (< #'<) + (> #'>) + (<= #'<=) + (>= #'>=)) + ,query)))))) + (action (byte-compile action)) + ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. + ;; (org-use-tag-inheritance t) + ;; (org-trust-scanner-tags t) + (org-ql--today (org-today)) + (items (->> sources + ;; List buffers + (--map (cl-etypecase it + (buffer it) + (string (or (find-buffer-visiting it) + (when (file-readable-p it) + ;; It feels unintuitive that `find-file-noselect' returns + ;; a buffer if the filename doesn't exist. + (find-file-noselect it)) + (user-error "Can't open file: %s" it))))) + ;; Filter buffers (i.e. select items) + (--map (with-current-buffer it + (unless (derived-mode-p 'org-mode) + (user-error "Not an Org buffer: %s" (buffer-name))) + (org-ql--select-cached :query query :preamble-re preamble-re + :predicate predicate :action action :narrow narrow))) + ;; Flatten items + (-flatten-n 1)))) ;; Sort items (pcase sort (`nil items) @@ -226,6 +228,51 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (define-hash-table-test 'org-ql-hash-test #'equal (lambda (args) (sxhash-equal (prin1-to-string args)))) +(defvar org-ql-use-preamble t + ;; FIXME: Move or delete this defvar. + "Use query preambles to speed up searches. +May be disabled for debugging, benchmarks, etc.") + +(defun org-ql--query-preamble (query) + "Return (QUERY PREAMBLE) for QUERY. +When QUERY has a clause with a corresponding preamble, and it's +appropriate to use one (i.e. the clause is not in an `or'), +replace the clause with a preamble." + (if org-ql-use-preamble + (let (org-ql-preamble) + (cl-labels ((rec (element) + (or (when org-ql-preamble + ;; Only one preamble is allowed + element) + (pcase element + (`(or _) element) + (`(regexp . ,regexps) + (let* ((regexp (rx-to-string `(or ,@regexps)))) + (setq org-ql-preamble regexp) + ;; Return nil + nil)) + (`(todo . ,(and todo-keywords (guard todo-keywords))) + (let* ((regexps (--map (list 'regexp + (format org-heading-keyword-regexp-format it)) + todo-keywords)) + (regexp (rx-to-string `(or ,@regexps)))) + (setq org-ql-preamble regexp) + ;; Return nil + nil)) + (`(and . ,rest) + (let ((clauses (mapcar #'rec rest))) + `(and ,@(-non-nil clauses)))) + (_ element))))) + (setq query (pcase (mapcar #'rec (list query)) + ((or `(nil) + `((nil)) + `((and)) + `((or))) + t) + (query (-flatten-n 1 query)))) + (list query org-ql-preamble))) + (list query nil))) + (defun org-ql--select-cached (&rest args) "Return results for ARGS and current buffer using cache." ;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a @@ -252,7 +299,7 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (t (puthash args (or new-result 'org-ql-nil) query-cache))) new-result)))) -(cl-defun org-ql--select (&key predicate action narrow &allow-other-keys) +(cl-defun org-ql--select (&key preamble-re predicate action narrow &allow-other-keys) "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE. If NARROW is non-nil, buffer will not be widened." ;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet' @@ -279,9 +326,15 @@ If NARROW is non-nil, buffer will not be widened." (goto-char (point-min)) (when (org-before-first-heading-p) (outline-next-heading)) - (cl-loop when (funcall predicate) - collect (funcall action) - while (outline-next-heading))))) + (cond (preamble-re (cl-loop when (and (when (re-search-forward preamble-re nil t) + (outline-back-to-heading 'invisible-ok) + t) + (funcall predicate)) + collect (funcall action) + while (outline-next-heading))) + (t (cl-loop when (funcall predicate) + collect (funcall action) + while (outline-next-heading))))))) (--each orig-fns ;; Restore original function mappings. (fset (plist-get it :name) (plist-get it :fn))))))