From 417c8a983372ef5df38d823ee6f31fe822fb1d2c Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 26 Aug 2011 12:18:15 -0400
Subject: [PATCH] Intern based on sequence numbers for values that have them.

20% speedup on the empty program.  Closes PR 10734.

original commit: 598d81671a5531e41ec25e4e0cec790b4ed3345f
---
 collects/typed-scheme/rep/filter-rep.rkt |  4 ++--
 collects/typed-scheme/rep/object-rep.rkt |  2 +-
 collects/typed-scheme/rep/rep-utils.rkt  |  4 ++--
 collects/typed-scheme/rep/type-rep.rkt   | 15 +++++++--------
 4 files changed, 12 insertions(+), 13 deletions(-)

diff --git a/collects/typed-scheme/rep/filter-rep.rkt b/collects/typed-scheme/rep/filter-rep.rkt
index 726e2458..f25334dd 100644
--- a/collects/typed-scheme/rep/filter-rep.rkt
+++ b/collects/typed-scheme/rep/filter-rep.rkt
@@ -21,13 +21,13 @@
 (def-filter Top () [#:fold-rhs #:base])
 
 (def-filter TypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
-  [#:intern (list t p (hash-name v))]
+  [#:intern (list (Rep-seq t) (map Rep-seq p) (hash-name v))]
   [#:frees (combine-frees (map free-vars* (cons t p)))
            (combine-frees (map free-idxs* (cons t p)))]
   [#:fold-rhs (*TypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
 
 (def-filter NotTypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
-  [#:intern (list t p (hash-name v))]
+  [#:intern (list (Rep-seq t) (map Rep-seq p) (hash-name v))]
   [#:frees (combine-frees (map free-vars* (cons t p)))
            (combine-frees (map free-idxs* (cons t p)))]
   [#:fold-rhs (*NotTypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
diff --git a/collects/typed-scheme/rep/object-rep.rkt b/collects/typed-scheme/rep/object-rep.rkt
index c8f1f317..a48085fb 100644
--- a/collects/typed-scheme/rep/object-rep.rkt
+++ b/collects/typed-scheme/rep/object-rep.rkt
@@ -14,7 +14,7 @@
 (def-object Empty () [#:fold-rhs #:base])
 
 (def-object Path ([p (listof PathElem?)] [v name-ref/c])
-  [#:intern (list p (hash-name v))]
+  [#:intern (list (map Rep-seq p) (hash-name v))]
   [#:frees (combine-frees (map free-vars* p)) (combine-frees (map free-idxs* p))]
   [#:fold-rhs (*Path (map pathelem-rec-id p) v)])
 
diff --git a/collects/typed-scheme/rep/rep-utils.rkt b/collects/typed-scheme/rep/rep-utils.rkt
index 77dffbd2..3a365f93 100644
--- a/collects/typed-scheme/rep/rep-utils.rkt
+++ b/collects/typed-scheme/rep/rep-utils.rkt
@@ -123,8 +123,8 @@
                           #:defaults
                           ([intern? (syntax-parse #'flds.fields
                                       [() #'#f]
-                                      [(f) #'f]
-                                      [(fields ...) #'(list fields ...)])]))
+                                      [(f) #'(if (Rep? f) (Rep-seq f) f)]
+                                      [(fields ...) #'(list (if (Rep? fields) (Rep-seq fields) fields) ...)])]))
                ;; expression that when given a "get free-variables"
                ;; function, combines the results in the expected pashion.
                (~optional [#:frees frees:frees-pat]
diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt
index 9e5eb16a..ba4a51da 100644
--- a/collects/typed-scheme/rep/type-rep.rkt
+++ b/collects/typed-scheme/rep/type-rep.rkt
@@ -57,7 +57,7 @@
 ;; rands is a list of types
 ;; stx is the syntax of the pair of parens
 (def-type App ([rator Type/c] [rands (listof Type/c)] [stx (or/c #f syntax?)])
-  [#:intern (list rator rands)]
+  [#:intern (cons (Rep-seq rator) (map Rep-seq rands))]
   [#:frees (λ (f) (combine-frees (map f (cons rator rands))))]
   [#:fold-rhs (*App (type-rec-id rator)
                     (map type-rec-id rands)
@@ -237,7 +237,9 @@
                [rest (or/c #f Type/c)]
                [drest (or/c #f (cons/c Type/c (or/c natural-number/c symbol?)))]
                [kws (listof Keyword?)])
-  [#:intern (list dom rng rest drest kws)]
+  [#:intern (list (map Rep-seq dom) (Rep-seq rng) (and rest (Rep-seq rest))
+                  (and drest (cons (Rep-seq (car drest)) (cdr drest)))
+                  (map Rep-seq kws))]
   [#:frees (combine-frees
             (append (map (compose flip-variances free-vars*)
                          (append (if rest (list rest) null)
@@ -303,7 +305,7 @@
                   [pred-id identifier?]
                   [cert procedure?]
                   [maker-id identifier?])
-  [#:intern (list name parent flds proc)]
+  [#:intern (list name (and parent (Rep-seq parent)) (map Rep-seq flds) (and proc (Rep-seq proc)))]
   [#:frees (λ (f) (combine-frees (map f (append (if proc (list proc) null)
                                                 (if parent (list parent) null)
                                                 flds))))]
@@ -370,12 +372,9 @@
 (def-type Hashtable ([key Type/c] [value Type/c]) [#:key 'hash]
   [#:frees (λ (f) (combine-frees (list (make-invariant (f key)) (make-invariant (f value)))))])
 
-;; parent : Type
-;; pred : Identifier
-;; cert : Certifier
-(def-type Refinement (parent pred cert)
+(def-type Refinement ([parent Type/c] [pred identifier?] [cert certifier?])
   [#:key (Type-key parent)]
-  [#:intern (list parent (hash-id pred))]
+  [#:intern (list (Rep-seq parent) (hash-id pred))]
   [#:fold-rhs (*Refinement (type-rec-id parent) pred cert)]
   [#:frees (λ (f) (f parent))])