ADD memoization for shorthand builders

ndwarshuis · Aug 9, 2024 · 61e0574 · 61e0574
1 parent 2910436
commit 61e0574
Show file tree

Hide file tree

Showing 2 changed files with 233 additions and 131 deletions.
diff --git a/bench/org-ml-benchmarks.el b/bench/org-ml-benchmarks.el
@@ -95,8 +95,14 @@
    (org-ml-update-headlines* 'all
      (org-ml-set-property :tags '("A" "B" "C") it))))
 
+;; TODO a better test for this would be to put a logbook underneath the
+;; planning ts since in that case we need to also parse the logbook
 (org-ml-defbench "schedule headline" 1000
-  "* headline"
+  (list "* headline")
+        ;; ":LOGGING:"
+        ;; "- Note taken on [2024-08-07 Wed 20:07] \\"
+        ;; "thingy"
+        ;; ":END:")
   (let ((org-adapt-indentation nil)
         (next t))
     (while next
@@ -105,12 +111,10 @@
 
   (let ((pl '(:scheduled (2000 1 1))))
     (org-ml-wrap-impure
-     (org-ml-update-headlines* 'all
-       (org-ml-headline-set-planning pl it)))))
+     (org-ml-update-supercontents* nil 'all
+       (org-ml-supercontents-set-planning pl it)))))
 
-;; TODO a better test for this would be to put a logbook underneath the
-;; planning ts since in that case we need to also parse the logbook
-(org-ml-defbench "schedule headline (supercontents)" 1000
+(org-ml-defbench "schedule headline (memoized)" 1000
   (list "* headline")
         ;; ":LOGGING:"
         ;; "- Note taken on [2024-08-07 Wed 20:07] \\"
@@ -123,9 +127,10 @@
       (setq next (outline-next-heading))))
 
   (let ((pl '(:scheduled (2000 1 1))))
-    (org-ml-wrap-impure
-     (org-ml-update-supercontents* nil 'all
-       (org-ml-supercontents-set-planning pl it)))))
+    (let ((org-ml-memoize-shorthand-builders t))
+      (org-ml-wrap-impure
+       (org-ml-update-supercontents* nil 'all
+         (org-ml-supercontents-set-planning pl it))))))
 
 (org-ml-defbench "reschedule headline" 1000
   (list "* headline"
@@ -142,14 +147,15 @@
       (setq next (outline-next-heading))))
 
   (org-ml-wrap-impure
-   (org-ml-update-headlines* 'all
-     (org-ml-headline-map-planning*
-       (->> (plist-get it :scheduled)
-            (org-ml-timelist-shift 1 'day)
-            (list :scheduled))
-       it))))
+   (org-ml-update-supercontents* nil 'all
+     (org-ml-supercontents-set-planning
+      (list :scheduled
+            (org-ml-timelist-shift
+             1 'day
+             (plist-get (org-ml-supercontents-get-planning it) :scheduled)))
+      it))))
 
-(org-ml-defbench "reschedule headline (supercontents)" 1000
+(org-ml-defbench "reschedule headline (memoized)" 1000
   (list "* headline"
         "SCHEDULED: <2020-01-01 Wed>")
   (let ((org-adapt-indentation nil)
@@ -164,13 +170,14 @@
       (setq next (outline-next-heading))))
 
   (org-ml-wrap-impure
-   (org-ml-update-supercontents* nil 'all
-     (org-ml-supercontents-set-planning
-      (list :scheduled
-            (org-ml-timelist-shift
-             1 'day
-             (plist-get (org-ml-supercontents-get-planning it) :scheduled)))
-      it))))
+   (let ((org-ml-memoize-shorthand-builders t))
+     (org-ml-update-supercontents* nil 'all
+       (org-ml-supercontents-set-planning
+        (list :scheduled
+              (org-ml-timelist-shift
+               1 'day
+               (plist-get (org-ml-supercontents-get-planning it) :scheduled)))
+        it)))))
 
 (org-ml-defbench "set headline effort" 1000
   "* headline"
@@ -181,10 +188,10 @@
       (setq next (outline-next-heading))))
 
   (org-ml-wrap-impure
-   (org-ml-update-headlines* 'all
-     (org-ml-headline-set-node-property "Effort" "0:05" it))))
+   (org-ml-update-supercontents* nil 'all
+     (org-ml-supercontents-set-node-properties '(("Effort" "0:05")) it))))
 
-(org-ml-defbench "set headline effort (supercontents)" 1000
+(org-ml-defbench "set headline effort (memoized)" 1000
   "* headline"
   (let ((org-adapt-indentation nil)
         (next t))
@@ -193,23 +200,9 @@
       (setq next (outline-next-heading))))
 
   (org-ml-wrap-impure
-   (org-ml-update-supercontents* nil 'all
-     (org-ml-supercontents-set-node-properties '(("Effort" "0:05")) it))))
-
-(org-ml-defbench "set checkboxes" 1000
-  (list "* headline [0/0]"
-        "- [ ] one"
-        "- [ ] two")
-  (let ((org-adapt-indentation nil)
-        (next t))
-    (while next
-      (org-toggle-checkbox)
-      (setq next (outline-next-heading))))
-
-  (let ((org-ml-memoize-match-patterns 'compiled))
-    (org-ml-update-headlines* 'all
-      (org-ml->> (org-ml-match-map '(section plain-list item) #'org-ml-item-toggle-checkbox it)
-        (org-ml-headline-update-item-statistics)))))
+   (let ((org-ml-memoize-shorthand-builders t))
+     (org-ml-update-supercontents* nil 'all
+       (org-ml-supercontents-set-node-properties '(("Effort" "0:05")) it)))))
 
 (org-ml-defbench "insert headline text" 2500
   "* headline"
@@ -221,12 +214,13 @@
         (insert "\nsome text"))
       (setq next (outline-next-heading))))
 
-  (let ((para (org-ml-build-paragraph! "some text")))
-    (org-ml-update-headlines* 'all
-      (org-ml-wrap-impure
-       (org-ml-headline-set-section (list para) it)))))
+  (org-ml-wrap-impure
+   (org-ml-update-supercontents* nil 'all
+     (-> (org-ml-build-paragraph! "some text")
+         (list)
+         (org-ml-supercontents-set-contents it)))))
 
-(org-ml-defbench "insert headline text (supercontents)" 2500
+(org-ml-defbench "insert headline text (memoized)" 2500
   "* headline"
   (let ((org-adapt-indentation nil)
         (next t))
@@ -236,10 +230,27 @@
         (insert "\nsome text"))
       (setq next (outline-next-heading))))
 
-  (let ((para (org-ml-build-paragraph! "some text")))
-    (org-ml-wrap-impure
+  (org-ml-wrap-impure
+   (let ((org-ml-memoize-shorthand-builders t))
      (org-ml-update-supercontents* nil 'all
-       (org-ml-supercontents-set-contents (list para) it)))))
+       (-> (org-ml-build-paragraph! "some text")
+           (list)
+           (org-ml-supercontents-set-contents it))))))
+
+(org-ml-defbench "set checkboxes" 1000
+  (list "* headline [0/0]"
+        "- [ ] one"
+        "- [ ] two")
+  (let ((org-adapt-indentation nil)
+        (next t))
+    (while next
+      (org-toggle-checkbox)
+      (setq next (outline-next-heading))))
+
+  (let ((org-ml-memoize-match-patterns 'compiled))
+    (org-ml-update-headlines* 'all
+      (org-ml->> (org-ml-match-map '(section plain-list item) #'org-ml-item-toggle-checkbox it)
+        (org-ml-headline-update-item-statistics)))))
 
 (org-ml-defbench "set headline effort/TODO/scheduled" 1000
   "* headline"
@@ -254,10 +265,11 @@
       (setq next (outline-next-heading))))
 
   (let ((pl '(:scheduled (2000 1 1))))
-    (org-ml-update-headlines* 'all
-      (org-ml->> (org-ml-set-property :todo-keyword "TODO" it)
-        (org-ml-headline-set-node-property "Effort" "0:05")
-        (org-ml-headline-set-planning pl)))))
+    (let ((org-ml-memoize-shorthand-builders t))
+      (org-ml-update-headlines* 'all
+        (org-ml->> (org-ml-set-property :todo-keyword "TODO" it)
+          (org-ml-headline-set-node-property "Effort" "0:05")
+          (org-ml-headline-set-planning pl))))))
 
 (provide 'org-ml-benchmarks)
 ;;; org-ml-benchmarks.el ends here