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

Add interface contract meth. names to class struct

Browse Source
This commit is contained in:
Asumu Takikawa 2012-04-24 17:04:11 -04:00 committed by Stevie Strickland
parent 6f4ad1de25
commit a7e03aee2c
1 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,6 +4,7 @@
racket/contract/base racket/contract/base
racket/contract/combinator racket/contract/combinator
(only-in racket/contract/private/arrow making-a-method method-contract?) (only-in racket/contract/private/arrow making-a-method method-contract?)
(only-in racket/list remove-duplicates)
racket/stxparam racket/stxparam
racket/unsafe/ops racket/unsafe/ops
"serialize-structs.rkt" "serialize-structs.rkt"
@ -1859,6 +1860,7 @@
method-width ; total number of methods method-width ; total number of methods
method-ht ; maps public names to vector positions method-ht ; maps public names to vector positions
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
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)
@ -2159,7 +2161,7 @@
i i
(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 method-width method-ht method-names (interfaces->contracted-methods (list i))
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
@ -2485,6 +2487,15 @@
((class-fixup c) o o2)))))))) ((class-fixup c) o o2))))))))
c)))))))))))) c))))))))))))
;; (listof interface?) -> (listof symbol?)
;; traverse the interfaces and figure out contracted methods
(define (interfaces->contracted-methods loi)
(define immediate-methods
(map (λ (ifc) (hash-keys (interface-contracts ifc))) loi))
(define super-methods
(map (λ (ifc) (interfaces->contracted-methods (interface-supers ifc))) loi))
(remove-duplicates (apply append (append immediate-methods super-methods)) eq?))
(define (check-still-unique name syms what) (define (check-still-unique name syms what)
(let ([ht (make-hasheq)]) (let ([ht (make-hasheq)])
(for-each (lambda (s) (for-each (lambda (s)
@ -2698,6 +2709,7 @@
method-width method-width
method-ht method-ht
(class-method-ids cls) (class-method-ids cls)
(class-method-ictcs cls)
methods methods
super-methods super-methods
@ -3532,7 +3544,7 @@
object<%> object<%>
void ; never inspectable void ; never inspectable
0 (make-hasheq) null 0 (make-hasheq) null null
(vector) (vector) (vector) (vector) (vector) (vector) (vector) (vector) (vector) (vector)
(vector) (vector) (vector) (vector) (vector) (vector)
@ -4463,6 +4475,7 @@
method-width method-width
method-ht method-ht
(class-method-ids cls) (class-method-ids cls)
(class-method-ictcs cls)
meths meths
(class-super-methods cls) (class-super-methods cls)