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

svn: r7390

Browse Source
This commit is contained in:
Kathy Gray 2007-09-20 03:07:02 +00:00
parent 9cb66102ed
commit 0026912589
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/profj/build-info.ss
View File

@ -786,7 +786,10 @@
(map (lambda (n sc) (get-parent-record n sc iname level type-recs)) (map (lambda (n sc) (get-parent-record n sc iname level type-recs))
super-names super-names
(header-extends info))) (header-extends info)))
(object-methods (class-record-methods (send type-recs get-class-record object-type))) (object-methods
(filter (lambda (m)
(not (eq? 'ctor (method-record-rtype m))))
(class-record-methods (send type-recs get-class-record object-type))))
(members (def-members iface)) (members (def-members iface))
(reqs (map (lambda (name-list) (reqs (map (lambda (name-list)
(if (= (length name-list) 1) (if (= (length name-list) 1)
@ -831,9 +834,7 @@
#f #f
#t #t
(apply append (cons f (map class-record-fields super-records))) (apply append (cons f (map class-record-fields super-records)))
(if (null? super-records) (apply append (cons m (map class-record-methods super-records)))
object-methods
(apply append (cons m (map class-record-methods super-records))))
(apply append (cons i (map class-record-inners super-records))) (apply append (cons i (map class-record-inners super-records)))
(apply append (cons (map class-record-name super-records) (apply append (cons (map class-record-name super-records)
(map class-record-parents super-records))) (map class-record-parents super-records)))

7
collects/profj/to-scheme.ss
View File

@ -1418,8 +1418,11 @@
,@(create-static-fields static-field-names (members-field members)) ,@(create-static-fields static-field-names (members-field members))
,@(append (generate-wrappers (class-name) ,@(append (generate-wrappers (class-name)
"Object" "Object"
(class-record-methods (append
(send type-recs get-class-record (list (class-name)))) (class-record-methods
(send type-recs get-class-record (list (class-name))))
(class-record-methods
(send type-recs get-class-record (list "Object" "java" "lang"))))
null) null)
(generate-contract-defs (class-name))) (generate-contract-defs (class-name)))
) )