memoize the creation of the name in the blame object

2018-05-02 18:53:48 -05:00 · 2018-05-02 18:53:48 -05:00 · 3f4cbcbfd8
commit 3f4cbcbfd8
parent 822938d9ae
1 changed files with 8 additions and 1 deletions
--- a/racket/collects/racket/contract/private/blame.rkt
+++ b/racket/collects/racket/contract/private/blame.rkt
@ -76,10 +76,17 @@
           (unless positive
             (raise-type-error 'make-blame "(not/c #f)" 3
                               source value build-name positive negative original?))
+           (define build/memo-name
+             (let* ([uniq (box #f)]
+                    [ans uniq])
+               (λ ()
+                 (when (eq? uniq ans)
+                   (set! ans (build-name)))
+                 ans)))
           (make-blame
            source
            value
-            build-name
+            build/memo-name
            (list positive)
            (and negative (list negative))
            original?