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:
parent
4068b47296
commit
417c8a9833
|
@ -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)])
|
||||
|
|
|
@ -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)])
|
||||
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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))])
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user