suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use a weak hashtable to cache concrete instances

Browse Source
This commit is contained in:
Asumu Takikawa 2012-05-02 23:52:48 -04:00 committed by Stevie Strickland
parent 10967a22ce
commit ba8e879703
1 changed files with 85 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/racket/private/class-internal.rkt
View File

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