branch: externals/org
commit edddc7d149b8668a830443b12db14075beb28607
Author: Ihor Radchenko <yanta...@gmail.com>
Commit: Ihor Radchenko <yanta...@gmail.com>
org-element-cache-map: Reduce memory allocation and time re-search
* lisp/org-element.el (org-element-cache-map): Move all possible
let-bindings outside the loop to avoid remory re-allocation on every
iteration. Track statistics for `re-search-forward' calls.
---
lisp/org-element.el | 165 +++++++++++++++++++++++++++++-----------------------
1 file changed, 91 insertions(+), 74 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 5c52318..26e7dec 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -7109,7 +7109,11 @@ the cache."
(setq to-pos mk)))
;; Make sure that garbage collector does not stand on the way to
;; maximum performance.
- (let ((gc-cons-threshold #x40000000))
+ (let ((gc-cons-threshold #x40000000)
+ ;; Bind variables used inside loop to avoid memory
+ ;; re-allocation on every iteration.
+ ;; See https://emacsconf.org/2021/talks/faster/
+ tmpnext-start tmpparent tmpelement)
(save-excursion
(save-restriction
(unless narrow (widen))
@@ -7138,37 +7142,38 @@ the cache."
() `(setq continue-flag t
node nil))
(element-match-at-point
- ;; Returning the first element to match around point.
- ;; For example, if point is inside headline and
- ;; granularity is restricted to headlines only, skip
- ;; over all the child elements inside the headline
- ;; and return the first parent headline.
- ;; When we are inside a cache gap, calling
- ;; `org-element-at-point' also fills the cache gap down
to
- ;; point.
- () `(progn
- ;; Parsing is one of the performance
- ;; bottlenecks. Make sure to optimise it as
- ;; much as possible.
- ;;
- ;; Avoid extra staff like timer cancels et al
- ;; and only call
`org-element--cache-sync-requests' when
- ;; there are pending requests.
- (when org-element--cache-sync-requests
- (org-element--cache-sync (current-buffer)))
- ;; Call `org-element--parse-to' directly avoiding
any
- ;; kind of `org-element-at-point' overheads.
- (if restrict-elements
- ;; Search directly instead of calling
- ;; `org-element-lineage' to avoid funcall
overheads
- ;; and making sure that we do not go all
- ;; the way to `org-data' as
`org-element-lineage'
- ;; does.
- (let ((el (org-element--parse-to (point))))
- (while (and el (not (memq (org-element-type
el) restrict-elements)))
- (setq el (org-element-property :parent
el)))
- el)
- (org-element--parse-to (point)))))
+ ;; Returning the first element to match around point.
+ ;; For example, if point is inside headline and
+ ;; granularity is restricted to headlines only, skip
+ ;; over all the child elements inside the headline
+ ;; and return the first parent headline.
+ ;; When we are inside a cache gap, calling
+ ;; `org-element-at-point' also fills the cache gap
down to
+ ;; point.
+ () `(progn
+ ;; Parsing is one of the performance
+ ;; bottlenecks. Make sure to optimise it as
+ ;; much as possible.
+ ;;
+ ;; Avoid extra staff like timer cancels et al
+ ;; and only call
`org-element--cache-sync-requests' when
+ ;; there are pending requests.
+ (when org-element--cache-sync-requests
+ (org-element--cache-sync (current-buffer)))
+ ;; Call `org-element--parse-to' directly
avoiding any
+ ;; kind of `org-element-at-point' overheads.
+ (if restrict-elements
+ ;; Search directly instead of calling
+ ;; `org-element-lineage' to avoid funcall
overheads
+ ;; and making sure that we do not go all
+ ;; the way to `org-data' as
`org-element-lineage'
+ ;; does.
+ (progn
+ (setq tmpelement (org-element--parse-to
(point)))
+ (while (and tmpelement (not (memq
(org-element-type tmpelement) restrict-elements)))
+ (setq tmpelement (org-element-property
:parent tmpelement)))
+ tmpelement)
+ (org-element--parse-to (point)))))
;; Starting from (point), search RE and move START to
;; the next valid element to be matched according to
;; restriction. Abort cache walk if no next element
@@ -7176,7 +7181,14 @@ the cache."
;; point.
(move-start-to-next-match
(re) `(save-match-data
- (if (or (not ,re) (re-search-forward (or
(car-safe ,re) ,re) nil 'move))
+ (if (or (not ,re) (if
org-element--cache-map-statistics
+ (progn
+ (setq before-time
(float-time))
+ (re-search-forward (or
(car-safe ,re) ,re) nil 'move)
+ (cl-incf re-search-time
+ (- (float-time)
+
before-time)))
+ (re-search-forward (or
(car-safe ,re) ,re) nil 'move)))
(unless (or (< (point) (or start -1))
(and data
(< (point)
(org-element-property :begin data))))
@@ -7193,26 +7205,27 @@ the cache."
;; Find expected begin position of an element after
;; DATA.
(next-element-start
- (data) `(let (next-start)
- (if (memq granularity '(headline
headline+inlinetask))
- (setq next-start (or (when (memq
(org-element-type data) '(headline org-data))
-
(org-element-property :contents-begin data))
-
(org-element-property :end data)))
- (setq next-start (or (when (memq
(org-element-type data) org-element-greater-elements)
-
(org-element-property :contents-begin data))
- (org-element-property
:end data))))
- ;; DATA end may be the last element inside
- ;; i.e. source block. Skip up to the end
- ;; of parent in such case.
- (let ((parent data))
- (catch :exit
- (when (eq next-start
(org-element-property :contents-end parent))
- (setq next-start (org-element-property
:end parent)))
- (while (setq parent (org-element-property
:parent parent))
- (if (eq next-start
(org-element-property :contents-end parent))
- (setq next-start
(org-element-property :end parent))
- (throw :exit t)))))
- next-start))
+ () `(progn
+ (setq tmpnext-start nil)
+ (if (memq granularity '(headline
headline+inlinetask))
+ (setq tmpnext-start (or (when (memq
(org-element-type data) '(headline org-data))
+
(org-element-property :contents-begin data))
+
(org-element-property :end data)))
+ (setq tmpnext-start (or (when (memq
(org-element-type data) org-element-greater-elements)
+
(org-element-property :contents-begin data))
+ (org-element-property
:end data))))
+ ;; DATA end may be the last element inside
+ ;; i.e. source block. Skip up to the end
+ ;; of parent in such case.
+ (setq tmpparent data)
+ (catch :exit
+ (when (eq tmpnext-start (org-element-property
:contents-end tmpparent))
+ (setq tmpnext-start (org-element-property
:end tmpparent)))
+ (while (setq tmpparent (org-element-property
:parent tmpparent))
+ (if (eq tmpnext-start (org-element-property
:contents-end tmpparent))
+ (setq tmpnext-start (org-element-property
:end tmpparent))
+ (throw :exit t))))
+ tmpnext-start))
;; Check if cache does not have gaps.
(cache-gapless-p
() `(eq org-element--cache-change-tic
@@ -7327,8 +7340,13 @@ the cache."
(time (float-time))
(predicate-time 0)
(pre-process-time 0)
+ (re-search-time 0)
(count-predicate-calls-match 0)
- (count-predicate-calls-fail 0))
+ (count-predicate-calls-fail 0)
+ ;; Bind variables used inside loop to avoid memory
+ ;; re-allocation on every iteration.
+ ;; See https://emacsconf.org/2021/talks/faster/
+ cache-size before-time modified-tic)
;; Skip to first element within region.
(goto-char (or start (point-min)))
(move-start-to-next-match next-element-re)
@@ -7343,13 +7361,13 @@ the cache."
(and (eq granularity 'element)
(or next-re fail-re)))
(let ((org-element-cache-map--recurse t))
- (let ((before-time (float-time)))
- (org-element-cache-map
- #'ignore
- :granularity granularity)
- (cl-incf pre-process-time
- (- (float-time)
- before-time)))
+ (setq before-time (float-time))
+ (org-element-cache-map
+ #'ignore
+ :granularity granularity)
+ (cl-incf pre-process-time
+ (- (float-time)
+ before-time))
;; Re-assign the cache root after filling the cache
;; gaps.
(setq node (cache-root)))
@@ -7390,8 +7408,9 @@ the cache."
;; DATA is at START. Match it.
;; In the process, we may alter the buffer,
;; so also keep track of the cache state.
- (let ((modified-tic org-element--cache-change-tic)
- (cache-size (cache-size)))
+ (progn
+ (setq modified-tic org-element--cache-change-tic)
+ (setq cache-size (cache-size))
;; When NEXT-RE/FAIL-RE is provided, skip to
;; next regexp match after :begin of the current
;; element.
@@ -7403,7 +7422,7 @@ the cache."
(< (org-element-property :begin data)
to-pos))
;; Calculate where next possible element
;; starts and update START if needed.
- (setq start (next-element-start data))
+ (setq start (next-element-start))
(goto-char start)
;; Move START further if possible.
(when (and next-element-re
@@ -7424,7 +7443,8 @@ the cache."
;;
;; Call FUNC. FUNC may move point.
(if org-element--cache-map-statistics
- (let ((before-time (float-time)))
+ (progn
+ (setq before-time (float-time))
(push (funcall func data) result)
(cl-incf predicate-time
(- (float-time)
@@ -7448,7 +7468,7 @@ the cache."
;; advance but simply loop to the next cache
;; element.
(when (and (cache-gapless-p)
- (eq (next-element-start data)
+ (eq (next-element-start)
start))
(setq start nil))
;; Check if the buffer has been modified.
@@ -7469,8 +7489,9 @@ the cache."
;; element past already processed
;; place.
(when (<= start (org-element-property :begin
data))
- (goto-char start)
- (goto-char (next-element-start
(element-match-at-point)))
+ (goto-char start)
+ (setq data (element-match-at-point))
+ (goto-char (next-element-start))
(move-start-to-next-match next-element-re))
(org-element-at-point to-pos)
(cache-walk-restart))
@@ -7513,7 +7534,7 @@ the cache."
(when (and org-element--cache-map-statistics
(or (not org-element--cache-map-statistics-threshold)
(> (- (float-time) time)
org-element--cache-map-statistics-threshold)))
- (message "Mapped over elements in %S. %d/%d predicate matches.
Total time: %f sec. Pre-process time: %f sec. Time running predicates: %f sec
(%f sec avg)
+ (message "Mapped over elements in %S. %d/%d predicate matches.
Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search
time: %f sec.
Calling parameters: :granularity %S :restrict-elements %S :next-re %S
:fail-re %S :from-pos %S :to-pos %S :limit-count %S :after-element %S"
(current-buffer)
count-predicate-calls-match
@@ -7522,11 +7543,7 @@ the cache."
(- (float-time) time)
pre-process-time
predicate-time
- (if (zerop (+ count-predicate-calls-match
- count-predicate-calls-fail))
- 0
- (/ predicate-time (+ count-predicate-calls-match
- count-predicate-calls-fail)))
+ re-search-time
granularity restrict-elements next-re fail-re from-pos
to-pos limit-count after-element))
;; Return result.
(nreverse result)))))))
