Use a weak hashtable to cache concrete instances

This commit is contained in:
Asumu Takikawa 2012-05-02 23:52:48 -04:00 committed by Stevie Strickland
parent 10967a22ce
commit ba8e879703

View File

@ -1863,6 +1863,8 @@
method-ids ; reverse-ordered list of public method names method-ids ; reverse-ordered list of public method names
method-ictcs ; list of indices of methods to fix for interface ctcs method-ictcs ; list of indices of methods to fix for interface ctcs
ictc-classes ; concretized versions of this class keyed by blame
methods ; vector of methods (for external dynamic dispatch) methods ; vector of methods (for external dynamic dispatch)
super-methods ; vector of methods (for subclass super calls) super-methods ; vector of methods (for subclass super calls)
int-methods ; vector of vector of methods (for internal dynamic dispatch) int-methods ; vector of vector of methods (for internal dynamic dispatch)
@ -2163,6 +2165,7 @@
(let-values ([(struct: make- ? -ref -set) (make-struct-type 'insp #f 0 0 #f null inspector)]) (let-values ([(struct: make- ? -ref -set) (make-struct-type 'insp #f 0 0 #f null inspector)])
make-) make-)
method-width method-ht method-names (interfaces->contracted-methods (list i)) method-width method-ht method-names (interfaces->contracted-methods (list i))
(make-weak-hasheq)
methods super-methods int-methods beta-methods meth-flags methods super-methods int-methods beta-methods meth-flags
inner-projs dynamic-idxs dynamic-projs inner-projs dynamic-idxs dynamic-projs
field-width field-pub-width field-ht field-names field-width field-pub-width field-ht field-names
@ -2808,6 +2811,8 @@ An example
(class-method-ids cls) (class-method-ids cls)
null null
(make-weak-hasheq)
methods methods
super-methods super-methods
int-methods int-methods
@ -3649,6 +3654,7 @@ An example
void ; never inspectable void ; never inspectable
0 (make-hasheq) null null 0 (make-hasheq) null null
(make-weak-hasheq)
(vector) (vector) (vector) (vector) (vector) (vector) (vector) (vector) (vector) (vector)
(vector) (vector) (vector) (vector) (vector) (vector)
@ -3776,8 +3782,9 @@ An example
;; class blame -> class ;; class blame -> class
;; takes a class and concretize interface ctc methods ;; takes a class and concretize interface ctc methods
(define (fetch-concrete-class cls blame) (define (fetch-concrete-class cls blame)
(if (null? (class-method-ictcs cls)) (cond [(null? (class-method-ictcs cls)) cls]
cls [(hash-ref (class-ictc-classes cls) blame (λ () #f)) => values]
[else
;; if there are contracted methods to concretize, do so ;; if there are contracted methods to concretize, do so
(let* ([name (class-name cls)] (let* ([name (class-name cls)]
[method-width (class-method-width cls)] [method-width (class-method-width cls)]
@ -3802,6 +3809,8 @@ An example
(class-method-ids cls) (class-method-ids cls)
null null
(make-weak-hasheq)
meths meths
(class-super-methods cls) (class-super-methods cls)
(class-int-methods cls) (class-int-methods cls)
@ -3857,7 +3866,9 @@ An example
(define ictc-infos (replace-ictc-blame (cadr entry) #f blame)) (define ictc-infos (replace-ictc-blame (cadr entry) #f blame))
(define wrapped-meth (concretize-ictc-method meth ictc-infos)) (define wrapped-meth (concretize-ictc-method meth ictc-infos))
(vector-set! meths index wrapped-meth)) (vector-set! meths index wrapped-meth))
c)))
(hash-set! (class-ictc-classes cls) blame c)
c)]))
;; method info -> method ;; method info -> method
;; appropriately wraps the method with interface contracts ;; appropriately wraps the method with interface contracts
@ -4700,6 +4711,8 @@ An example
(class-method-ids cls) (class-method-ids cls)
(class-method-ictcs cls) (class-method-ictcs cls)
(class-ictc-classes cls)
meths meths
(class-super-methods cls) (class-super-methods cls)
(class-int-methods cls) (class-int-methods cls)