Tweak symbol sizescratch/memrep

2 files changed, 28 insertions, 7 deletions

diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index d4444ef485f..6067db10cb2 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -31,6 +31,8 @@
 (require 'subr-x)
 (eval-when-compile (require 'cl-lib))
 
+(defvar memory-report--type-size (make-hash-table))
+
 ;;;###autoload
 (defun memory-report ()
   "Generate a report of how Emacs is using memory."
@@ -68,8 +70,6 @@
     (memory-report--garbage-collect))
   (memory-report--object-size (make-hash-table :test #'eq) object))
 
-(defvar memory-report--type-size (make-hash-table))
-
 (defun memory-report--size (type)
   (or (gethash type memory-report--type-size)
       (gethash 'object memory-report--type-size)))
@@ -162,8 +162,12 @@
 (cl-defgeneric memory-report--object-size-1 (_counted _value)
   0)
 
-(cl-defmethod memory-report--object-size-1 (_ (_value symbol))
-  (memory-report--size 'symbol))
+(cl-defmethod memory-report--object-size-1 (_ (value symbol))
+  ;; Don't count global symbols -- makes sizes of lists of symbols too
+  ;; heavey.
+  (if (intern-soft value obarray)
+      0
+    (memory-report--size 'symbol)))
 
 (cl-defmethod memory-report--object-size-1 (_ (_value buffer))
   (memory-report--size 'buffer))
@@ -171,7 +175,18 @@
 (cl-defmethod memory-report--object-size-1 (counted (value string))
   (+ (memory-report--size 'string)
      (string-bytes value)
-     (memory-report--object-size counted (object-intervals value))))
+     (memory-report--interval-size counted (object-intervals value))))
+
+(defun memory-report--interval-size (counted intervals)
+  ;; We get a list back of intervals, but only count the "inner list"
+  ;; (i.e., the actual text properties), and add the size of the
+  ;; intervals themselves.
+  (+ (* (memory-report--size 'interval) (length intervals))
+     (seq-reduce #'+ (mapcar
+                      (lambda (interval)
+                        (memory-report--object-size counted (nth 2 interval)))
+                      intervals)
+                 0)))
 
 (cl-defmethod memory-report--object-size-1 (counted (value list))
   (let ((total 0)
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el
index 146800fd2e8..01bcf18423a 100644
--- a/test/lisp/emacs-lisp/memory-report-tests.el
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -37,11 +37,17 @@
   (should (equal (memory-report-object-size (cons nil nil)) 16))
   (should (equal (memory-report-object-size (cons 1 2)) 16))
 
+  (should (equal (memory-report-object-size (list 1 2)) 32))
+  (should (equal (memory-report-object-size (list 1)) 16))
+
+  (should (equal (memory-report-object-size (list 'foo)) 16))
+
+  (should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
+
   (should (equal (memory-report-object-size "") 32))
   (should (equal (memory-report-object-size "a") 33))
   (should (equal (memory-report-object-size (propertize "a" 'face 'foo))
-                 ;; Possibly?
-                 161)))
+                 81)))
 
 (provide 'memory-report-tests)