Intern based on sequence numbers for values that have them.

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

original commit: 598d81671a5531e41ec25e4e0cec790b4ed3345f
This commit is contained in:
Sam Tobin-Hochstadt 2011-08-26 12:18:15 -04:00
parent 4068b47296
commit 417c8a9833
4 changed files with 12 additions and 13 deletions

View File

@ -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)])

View File

@ -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)])

View File

@ -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]

View File

@ -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))])