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

Corrected bugs in inner class instantiation

Browse Source 
svn: r6429
This commit is contained in:
Kathy Gray 2007-05-31 16:47:38 +00:00
parent f11e5aeb41
commit fcaa2fb5b5
2 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/profj/check.ss
View File

@ -2294,9 +2294,13 @@
(if inner-lookup?
(inner-rec-record inner-lookup?)
(get-record (send type-recs get-class-record type c-class) type-recs)))
(methods (get-method-records #;(id-string (name-id name))
(car (class-record-name class-record))
(methods (get-method-records (if inner-lookup?
(id-string (name-id name))
(car (class-record-name class-record)))
class-record type-recs)))
(unless (equal? (car (class-record-name class-record))
(id-string (name-id name)))
(set-id-string! (name-id name) (car (class-record-name class-record))))
(unless (or (equal? (car (class-record-name class-record)) (ref-type-class/iface type)))
(set-id-string! (name-id name) (car (class-record-name class-record)))
(set-class-alloc-class-inner?! exp #t))

13
collects/profj/types.ss
View File

@ -261,10 +261,15 @@
;name->type: name (U (list string) #f) src symbol type-records -> type
(define (name->type n container-class src level type-recs)
(let ((name (id-string (name-id n)))
(path (map id-string (name-path n))))
(type-exists? name path container-class src level type-recs)
(make-ref-type name (if (null? path) (send type-recs lookup-path name (lambda () null)) path))))
(let* ((name (id-string (name-id n)))
(path (map id-string (name-path n)))
(rec (get-record (type-exists? name path container-class src level type-recs) type-recs)))
(if (class-record? rec)
(make-ref-type (car (class-record-name rec))
(cdr (class-record-name rec)))
(make-ref-type name (if (null? path)
(send type-recs lookup-path name (lambda () null)) path)))))
;; type-exists: string (list string) (U (list string) #f) src symbol type-records -> (U record procedure)
(define (type-exists? name path container-class src level type-recs)