From 272271f36f4a7225e30d84b621e0844eebdfe097 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 14 May 2020 19:11:23 -0600
Subject: [PATCH] cs: cache `object-name` for procedures

Extracting the name from a procedure involves `string->symbol` and
possibly some string parsing. Map the code object to the result
symbol to speed up multiple requests for the same code object.
---
 racket/src/cs/rumble/object-name.ss | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/racket/src/cs/rumble/object-name.ss b/racket/src/cs/rumble/object-name.ss
index ba3004c951..4af8aa5735 100644
--- a/racket/src/cs/rumble/object-name.ss
+++ b/racket/src/cs/rumble/object-name.ss
@@ -24,6 +24,8 @@
                                                        "(or/c exact-nonnegative-integer? (procedure-arity-includes/c 1))"
                                                        v)]))))
 
+(define-thread-local procedure-names (make-weak-eq-hashtable))
+
 (define (object-name v)
   (cond
    [(object-name? v)
@@ -38,10 +40,16 @@
      [(wrapper-procedure? v)
       (extract-wrapper-procedure-name v)]
      [else
-      (let ([name (#%$code-name (#%$closure-code v))])
-        (and name
-             (let ([n (procedure-name-string->visible-name-string name)])
-               (and n (string->symbol n)))))])]
+      (let ([names procedure-names]
+            [code (#%$closure-code v)])
+        (or (eq-hashtable-ref names code #f)
+            (let ([name (#%$code-name code)])
+              (and name
+                   (let ([n (procedure-name-string->visible-name-string name)])
+                     (and n
+                          (let ([sym (string->symbol n)])
+                            (eq-hashtable-set! names code sym)
+                            sym)))))))])]
    [(impersonator? v)
     (object-name (impersonator-val v))]
    [(procedure? v)