Parcourir la source

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.
Ihor Radchenko il y a 3 ans
Parent
commit
edddc7d149
1 fichiers modifiés avec 91 ajouts et 74 suppressions
  1. 91 74
      lisp/org-element.el

+ 91 - 74
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)))))))