branch: elpa/flamegraph
commit e8c5ccabf3b6ba403c49d25c422c3620bb7ac4c3
Author: Dmitry Gutov <[email protected]>
Commit: Dmitry Gutov <[email protected]>
Nest the Calls tree by source reachability
Drive the describe-buffer "Calls" tree from the same source-attributed
walk as the snippet: a callee is expanded inline only when one of its own
calls is found in the defun's source (through transparent skip-through
frames), so the tree stops where attribution runs out instead of
unfolding a function's entire internal subtree.
flamegraph--collect-nested-call-sites now fills a REACHED table the tree
consults; the threshold gates snippet highlights only, never the tree.
---
flamegraph.el | 104 ++++++++++++++++++++++++++++-------------------
test/flamegraph-tests.el | 57 +++++++++++++++++++-------
2 files changed, 105 insertions(+), 56 deletions(-)
diff --git a/flamegraph.el b/flamegraph.el
index 95d3186add..cf66934195 100644
--- a/flamegraph.el
+++ b/flamegraph.el
@@ -674,7 +674,7 @@ symbol boundaries in the target buffer's syntax."
(and (stringp name) (not (string-empty-p name))
(not (string-match-p "[][[:space:]();,]" name))))
-(defun flamegraph--collect-nested-call-sites (node beg end)
+(defun flamegraph--collect-nested-call-sites (node beg end &optional reached)
"Walk NODE's call subtree against the buffer region [BEG END].
For each child whose display name matches `\\=\\_<NAME\\=\\_>' in the
current region, record the match as a highlight region (unless its
@@ -689,49 +689,66 @@ in completely unrelated forms (a literal `(if …)'
elsewhere), or
may not exist at all (`dolist' → `while'/`let'). Only real function
matches narrow, which is what preserves structural attribution.
-Callees below `flamegraph-call-site-threshold' of NODE's count are
-dropped along with their subtree. Each region is (POS-BEG POS-END
-WEIGHT), WEIGHT being the callee's share of NODE's count, for heat
-styling."
+Each region is (POS-BEG POS-END WEIGHT), WEIGHT being the callee's share
+of NODE's count, for heat styling. Callees below
+`flamegraph-call-site-threshold' are omitted from the regions, but still
+traversed.
+
+If REACHED (a hash table) is non-nil, mark in it every node whose callees
+should be shown nested in the \"Calls\" tree: a node is reached when it
+has a child found in the source (directly, or through transparent
+skip-through frames). This is independent of the threshold, so the Calls
+tree may show cold callees the snippet omits — but it stops, like the
+snippet, where source attribution runs out (a function whose own body is
+not in this defun)."
(let ((total (max 1 (profiler-calltree-count node)))
regions)
(cl-labels
+ ;; Walk N's children against REGION; return non-nil if any of them
+ ;; is found in source (so N's callees are worth showing nested).
((walk (n region)
- (dolist (k (profiler-calltree-children n))
- (let* ((entry (profiler-calltree-entry k))
- (name (flamegraph--frame-display-name entry))
- (skip (flamegraph--skip-through-p entry))
- (weight (/ (float (profiler-calltree-count k)) total)))
- (cond
- (skip
- ;; Special form — transparent descend, no narrowing.
- (walk k region))
- ((< weight flamegraph-call-site-threshold)
- ;; Too cold to be worth showing — drop it and its subtree.
- nil)
- ((flamegraph--callee-name-acceptable-p name)
- ;; Real function — search in the current region.
- ;; Each match is highlighted and narrows the search
- ;; for this child's own children.
- (save-excursion
- (goto-char (car region))
- (let ((re (concat "\\_<" (regexp-quote name) "\\_>")))
- (while (re-search-forward re (cdr region) t)
- (let ((mb (match-beginning 0))
- (me (match-end 0)))
- (push (list mb me weight) regions)
- (when-let* ((sub (flamegraph--enclosing-form-region
- mb)))
- (walk k sub))))))))))))
+ (let ((reachable nil))
+ (dolist (k (profiler-calltree-children n))
+ (let* ((entry (profiler-calltree-entry k))
+ (name (flamegraph--frame-display-name entry))
+ (weight (/ (float (profiler-calltree-count k)) total)))
+ (cond
+ ((flamegraph--skip-through-p entry)
+ ;; Special form — transparent descend, no narrowing.
+ (when (walk k region)
+ (when reached (puthash k t reached))
+ (setq reachable t)))
+ ((flamegraph--callee-name-acceptable-p name)
+ ;; Real function — search in the current region. Each
+ ;; match is highlighted and narrows the search for this
+ ;; child's own children.
+ (save-excursion
+ (goto-char (car region))
+ (let ((re (concat "\\_<" (regexp-quote name) "\\_>"))
+ (found nil))
+ (while (re-search-forward re (cdr region) t)
+ (setq found t)
+ (let ((mb (match-beginning 0))
+ (me (match-end 0)))
+ (when (>= weight flamegraph-call-site-threshold)
+ (push (list mb me weight) regions))
+ (when-let* ((sub (flamegraph--enclosing-form-region
+ mb)))
+ (when (and (walk k sub) reached)
+ (puthash k t reached)))))
+ (when found (setq reachable t))))))))
+ reachable)))
(walk node (cons beg end)))
(nreverse regions)))
-(defun flamegraph--insert-call-tree (node total ref depth directory)
- "Insert NODE's children as a tree, expanding a skip-through child
-inline so the path to its real callees is visible. TOTAL is the grand
-total for the call graph; REF is the count of the originally-described
-frame, used so the printed percentages add up under that frame. DEPTH
-controls the indentation."
+(defun flamegraph--insert-call-tree (node total ref depth directory reached)
+ "Insert NODE's children as a tree, nesting those found in the source.
+REACHED is the hash table populated by `flamegraph--collect-nested-call-sites':
+a child is expanded inline (its own callees shown indented) only when it
+is a key there, so the tree follows the same source-attributed nesting as
+the snippet. TOTAL is the grand total for the call graph; REF is the
+count of the originally-described frame, used so the printed percentages
+add up under that frame. DEPTH controls the indentation."
(let ((kids (sort (copy-sequence (profiler-calltree-children node))
(lambda (a b) (> (profiler-calltree-count a)
(profiler-calltree-count b))))))
@@ -743,8 +760,9 @@ controls the indentation."
(insert (format " (%s)\n"
(flamegraph--percent
(profiler-calltree-count k) ref)))
- (when (flamegraph--skip-through-p (profiler-calltree-entry k))
- (flamegraph--insert-call-tree k total ref (1+ depth) directory)))))
+ (when (gethash k reached)
+ (flamegraph--insert-call-tree k total ref (1+ depth) directory
+ reached)))))
(defun flamegraph--describe-button (node total directory)
"Insert a button that describes NODE, passing TOTAL and DIRECTORY along."
@@ -774,7 +792,8 @@ frames, with Help-style back/forward navigation."
(lambda (a b) (> (profiler-calltree-count a)
(profiler-calltree-count b)))))
(self (- count (apply #'+ 0 (mapcar #'profiler-calltree-count kids))))
- (parent (profiler-calltree-parent node)))
+ (parent (profiler-calltree-parent node))
+ (reached (make-hash-table :test 'eq)))
(with-help-window (help-buffer)
(with-current-buffer standard-output
(if (and (symbolp entry) (fboundp entry))
@@ -797,7 +816,7 @@ frames, with Help-style back/forward navigation."
path (cdr loc)
(lambda (b e)
(flamegraph--collect-nested-call-sites
- node b e)))))
+ node b e reached)))))
(insert "\n\n" snippet)))
(insert (format "\n\nSamples %s (%s of total) self %s (%s)\n"
(profiler-format-number count)
@@ -810,7 +829,8 @@ frames, with Help-style back/forward navigation."
(insert "\n"))
(when kids
(insert "\nCalls\n")
- (flamegraph--insert-call-tree node total count 0 directory))))))
+ (flamegraph--insert-call-tree node total count 0 directory
+ reached))))))
(defun flamegraph-redraw ()
"Redraw the flame graph, e.g. to pick up a new window width."
diff --git a/test/flamegraph-tests.el b/test/flamegraph-tests.el
index ae3800d6f8..600f0230ef 100644
--- a/test/flamegraph-tests.el
+++ b/test/flamegraph-tests.el
@@ -193,6 +193,30 @@ callees outside it must still be found."
outer (point-min) (point-max))))
(should (equal (flamegraph-test--region-texts regions) '("foo"))))))
+(ert-deftest flamegraph-test-walker-reached-tracks-source-nesting ()
+ "REACHED marks a node iff a nested call of it is found in the source.
+`wrap' is found and its child `inner' is found inside it -> reached;
+`leaf' is found but its child is not in source -> not reached."
+ (flamegraph-test--with-elisp-source
+ "(defun outer ()
+ (wrap (inner))
+ (leaf))"
+ (let* ((inner (profiler-make-calltree :entry 'inner :count 10))
+ (wrap (profiler-make-calltree :entry 'wrap :count 10
+ :children (list inner)))
+ (hidden (profiler-make-calltree :entry 'not-in-source :count 5))
+ (leaf (profiler-make-calltree :entry 'leaf :count 5
+ :children (list hidden)))
+ (outer (profiler-make-calltree :entry 'outer :count 20
+ :children (list wrap leaf)))
+ (reached (make-hash-table :test 'eq))
+ (regions (flamegraph--collect-nested-call-sites
+ outer (point-min) (point-max) reached)))
+ (should (equal (flamegraph-test--region-texts regions)
+ '("wrap" "inner" "leaf")))
+ (should (gethash wrap reached))
+ (should-not (gethash leaf reached)))))
+
(ert-deftest flamegraph-test-walker-below-threshold-dropped ()
"Callees below `flamegraph-call-site-threshold' are dropped with subtree.
hot at 50% is kept; cold at 1% (and its child) are not."
@@ -270,12 +294,15 @@ foo at 100% of outer is hot; bar at 10% is warm."
;;; Calls-tree rendering — `flamegraph--insert-call-tree'
-(defun flamegraph-test--render-call-tree (node ref)
+(defun flamegraph-test--render-call-tree (node ref &optional reached-nodes)
"Render NODE's call tree (REF samples for percent scaling) and return
-the resulting string."
- (with-temp-buffer
- (flamegraph--insert-call-tree node ref ref 0 nil)
- (buffer-string)))
+the resulting string. REACHED-NODES are the calltrees to mark as
+expandable (their children shown nested)."
+ (let ((reached (make-hash-table :test 'eq)))
+ (dolist (n reached-nodes) (puthash n t reached))
+ (with-temp-buffer
+ (flamegraph--insert-call-tree node ref ref 0 nil reached)
+ (buffer-string))))
(defun flamegraph-test--line-with (str lines)
"Return the first LINES element containing STR as a whole symbol."
@@ -300,15 +327,16 @@ the resulting string."
(should bar-pos)
(should (< baz-pos bar-pos)))))
-(ert-deftest flamegraph-test-call-tree-skip-through-expanded-indented ()
- "Skip-through children render their sub-children indented underneath."
+(ert-deftest flamegraph-test-call-tree-reached-expanded-indented ()
+ "A reached child renders its sub-children indented underneath; an
+unreached sibling does not, and stays at the top depth."
(let* ((real-child (profiler-make-calltree :entry 'real-fn :count 80))
(if-node (profiler-make-calltree :entry 'if :count 80
:children (list real-child)))
(other (profiler-make-calltree :entry 'other-fn :count 20))
(root (profiler-make-calltree :entry 'root :count 100
:children (list if-node other))))
- (let* ((out (flamegraph-test--render-call-tree root 100))
+ (let* ((out (flamegraph-test--render-call-tree root 100 (list if-node)))
(lines (split-string out "\n" t))
(if-line (flamegraph-test--line-with "if" lines))
(rf-line (flamegraph-test--line-with "real-fn" lines))
@@ -316,20 +344,21 @@ the resulting string."
(should if-line)
(should rf-line)
(should other-line)
- ;; real-fn is indented deeper than its skip-through parent.
+ ;; real-fn is indented deeper than its reached parent.
(should (> (flamegraph-test--indent rf-line)
(flamegraph-test--indent if-line)))
- ;; The non-skip sibling sits at the same depth as `if'.
+ ;; The unreached sibling sits at the same depth as `if'.
(should (= (flamegraph-test--indent if-line)
(flamegraph-test--indent other-line))))))
-(ert-deftest flamegraph-test-call-tree-non-skip-not-expanded ()
- "A non-skip child's own descendants are NOT inlined into the tree."
+(ert-deftest flamegraph-test-call-tree-unreached-not-expanded ()
+ "A child not in REACHED is a leaf: its own descendants are not inlined."
(let* ((grand (profiler-make-calltree :entry 'grand :count 50))
(kid (profiler-make-calltree :entry 'kid :count 50
:children (list grand)))
(root (profiler-make-calltree :entry 'root :count 100
:children (list kid))))
+ ;; kid is not passed as reached.
(let* ((out (flamegraph-test--render-call-tree root 100))
(lines (split-string out "\n" t)))
(should (flamegraph-test--line-with "kid" lines))
@@ -344,7 +373,7 @@ not their immediate parent — so all percents add up under
that frame."
:children (list fn)))
(root (profiler-make-calltree :entry 'root :count 1000
:children (list if-node))))
- (let* ((out (flamegraph-test--render-call-tree root 1000))
+ (let* ((out (flamegraph-test--render-call-tree root 1000 (list if-node)))
(fn-line (flamegraph-test--line-with
"fn" (split-string out "\n" t))))
(should fn-line)
@@ -357,7 +386,7 @@ not their immediate parent — so all percents add up under
that frame."
(foo (profiler-make-calltree :entry 'foo :count 1
:children (list bar))))
(with-temp-buffer
- (flamegraph--insert-call-tree foo 1 1 0 nil)
+ (flamegraph--insert-call-tree foo 1 1 0 nil (make-hash-table :test 'eq))
(goto-char (point-min))
(let ((b (next-button (point))))
(should b)
