From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id Zh9FCgPojF8NGAAA0tVLHw (envelope-from ) for ; Mon, 19 Oct 2020 01:12:35 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id wIOsBQPojF8LAgAAbx9fmQ (envelope-from ) for ; Mon, 19 Oct 2020 01:12:35 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id A57B59400EF for ; Mon, 19 Oct 2020 01:12:34 +0000 (UTC) Received: from localhost ([::1]:59722 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kUJiz-00062J-DN for larch@yhetil.org; Sun, 18 Oct 2020 21:12:33 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:47574) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kUJia-00062B-VH for emacs-orgmode@gnu.org; Sun, 18 Oct 2020 21:12:08 -0400 Received: from coral.adamspiers.org ([85.119.82.20]:53748) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kUJiY-00060J-NB for emacs-orgmode@gnu.org; Sun, 18 Oct 2020 21:12:08 -0400 Received: from localhost (243.103.2.81.in-addr.arpa [81.2.103.243]) by coral.adamspiers.org (Postfix) with ESMTPSA id 1CB342E3A0 for ; Mon, 19 Oct 2020 02:12:04 +0100 (BST) From: Adam Spiers To: emacs-orgmode@gnu.org Subject: [PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient Date: Mon, 19 Oct 2020 02:11:59 +0100 Message-Id: <20201019011159.4484-1-orgmode@adamspiers.org> X-Mailer: git-send-email 2.28.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=85.119.82.20; envelope-from=orgmode@adamspiers.org; helo=coral.adamspiers.org X-detected-operating-system: by eggs.gnu.org: First seen = 2020/10/18 21:00:58 X-ACL-Warn: Detected OS = Linux 2.2.x-3.x [generic] X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=fail reason="SPF not aligned (relaxed), No valid DKIM" header.from=adamspiers.org (policy=none); spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Spam-Score: 4.09 X-TUID: gtBp+zwxKPC2 [This is only lightly tested and therefore probably not quite ready for merging yet; however I'm submitting now to get feedback.] org-entries-lessp was not as efficient a multi-criteria comparator as it could have been, since it evaluated all criteria and then combined them via (eval (cons 'or ...)), thereby missing a chance for lazy evaluation via short-circuiting: if one of the earlier criteria in org-agenda-sorting-strategy-selected evaluates to non-nil, giving a definitive comparison result, there is no need to evaluate any of the later criteria. So instead iterate over the criteria one by one, and return as soon as we have a definitive result. Also remove code duplication by adopting a unified approach to ascending/descending sorting. Note that the way org-entries-lessp is invoked by org-agenda-finalize-entries is still inefficient, because the same values (e.g. timestamps, priorities, etc.) are extracted from every pair of entries in each comparison within the sort. In the future, introducing a Schwartzian transform can probably address this. However the refactoring in this commit is a step in the right direction, and it also allows other code to determine which comparison is decisive in ordering any two elements. Signed-off-by: Adam Spiers --- lisp/org-agenda.el | 103 ++++++++++++++++++++------------------------- 1 file changed, 46 insertions(+), 57 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 88bb3f90d..eadc7fedd 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7187,65 +7187,54 @@ (defsubst org-cmp-habit-p (a b) (cond ((and ha (not hb)) -1) ((and (not ha) hb) +1)))) +(defun org-entries-cmp (a b) + "Iterate through the sorting criteria in +`org-agenda-sorting-strategy-selected' until a sorter returns a +definitive comparison, then return a cons cell (RESULT . SORTER)." + (let (sorted-by + sort-result + (ss org-agenda-sorting-strategy-selected)) + (while (and ss (not sorted-by)) + (let* ((sorter (car ss)) + (sorter-name (symbol-name sorter)) + ;; If sorter symbol ends in "-down" then pass the -up version + ;; to org-entries-cmp-1 and then negate the result. + (sorter-down-p (string-match "-down\\'" sorter-name)) + (up-sorter + (if sorter-down-p + (replace-regexp-in-string "-down\\'" "-up" sorter-name) + sorter-name))) + (setq sort-result (org-entries-cmp-1 a b (intern up-sorter))) + (setq ss (cdr ss)) + (when sort-result + (setq sort-result (if sorter-down-p (- sort-result) sort-result)) + (setq sorted-by sorter)))) + (cons sort-result sorted-by))) + +(defun org-entries-cmp-1 (a b sorter) + "Compare two entries via the given sorter." + (pcase sorter + ('timestamp-up (org-cmp-ts a b "")) + ('scheduled-up (org-cmp-ts a b "scheduled")) + ('deadline-up (org-cmp-ts a b "deadline")) + ('tsia-up (org-cmp-ts a b "timestamp_ia")) + ('ts-up (org-cmp-ts a b "timestamp")) + ('time-up (org-cmp-time a b)) + ('stats-up (org-cmp-values a b 'org-stats)) + ('priority-up (org-cmp-values a b 'priority)) + ('effort-up (org-cmp-effort a b)) + ('category-up (org-cmp-category a b)) + ('category-keep (if (org-cmp-category a b) +1 nil)) ;; FIXME: check this + ('tag-up (org-cmp-tag a b)) + ('todo-state-up (org-cmp-todo-state a b)) + ('habit-up (org-cmp-habit-p a b)) + ('alpha-up (org-cmp-alpha a b)) + ('user-defined-up (funcall org-agenda-cmp-user-defined a b)))) + (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." - ;; The following variables will be used when the form is evaluated. - ;; So even though the compiler complains, keep them. - (let* ((ss org-agenda-sorting-strategy-selected) - (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) - (org-cmp-ts a b ""))) - (timestamp-down (if timestamp-up (- timestamp-up) nil)) - (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) - (org-cmp-ts a b "scheduled"))) - (scheduled-down (if scheduled-up (- scheduled-up) nil)) - (deadline-up (and (org-em 'deadline-up 'deadline-down ss) - (org-cmp-ts a b "deadline"))) - (deadline-down (if deadline-up (- deadline-up) nil)) - (tsia-up (and (org-em 'tsia-up 'tsia-down ss) - (org-cmp-ts a b "timestamp_ia"))) - (tsia-down (if tsia-up (- tsia-up) nil)) - (ts-up (and (org-em 'ts-up 'ts-down ss) - (org-cmp-ts a b "timestamp"))) - (ts-down (if ts-up (- ts-up) nil)) - (time-up (and (org-em 'time-up 'time-down ss) - (org-cmp-time a b))) - (time-down (if time-up (- time-up) nil)) - (stats-up (and (org-em 'stats-up 'stats-down ss) - (org-cmp-values a b 'org-stats))) - (stats-down (if stats-up (- stats-up) nil)) - (priority-up (and (org-em 'priority-up 'priority-down ss) - (org-cmp-values a b 'priority))) - (priority-down (if priority-up (- priority-up) nil)) - (effort-up (and (org-em 'effort-up 'effort-down ss) - (org-cmp-effort a b))) - (effort-down (if effort-up (- effort-up) nil)) - (category-up (and (or (org-em 'category-up 'category-down ss) - (memq 'category-keep ss)) - (org-cmp-category a b))) - (category-down (if category-up (- category-up) nil)) - (category-keep (if category-up +1 nil)) - (tag-up (and (org-em 'tag-up 'tag-down ss) - (org-cmp-tag a b))) - (tag-down (if tag-up (- tag-up) nil)) - (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) - (org-cmp-todo-state a b))) - (todo-state-down (if todo-state-up (- todo-state-up) nil)) - (habit-up (and (org-em 'habit-up 'habit-down ss) - (org-cmp-habit-p a b))) - (habit-down (if habit-up (- habit-up) nil)) - (alpha-up (and (org-em 'alpha-up 'alpha-down ss) - (org-cmp-alpha a b))) - (alpha-down (if alpha-up (- alpha-up) nil)) - (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) - user-defined-up user-defined-down) - (when (and need-user-cmp org-agenda-cmp-user-defined - (functionp org-agenda-cmp-user-defined)) - (setq user-defined-up - (funcall org-agenda-cmp-user-defined a b) - user-defined-down (if user-defined-up (- user-defined-up) nil))) - (cdr (assoc - (eval (cons 'or org-agenda-sorting-strategy-selected)) - '((-1 . t) (1 . nil) (nil . nil)))))) + (let ((sort-result (car (org-entries-cmp a b)))) + (cdr (assoc sort-result '((-1 . t) (1 . nil) (nil . nil)))))) ;;; Agenda restriction lock -- 2.28.0