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

avoid chains of derived-from-... names (due to previous attempt at fixing the string vs. symbol problem)

Browse Source 
svn: r5444
This commit is contained in:
Matthew Flatt 2007-01-24 02:37:01 +00:00
parent c0c04fb2fc
commit 272980489c
1 changed files with 7 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mzlib/private/class-internal.ss
View File

@ -1718,7 +1718,7 @@
(and s (and s
(not (eq? super object%)) (not (eq? super object%))
(if (symbol? s) (if (symbol? s)
(string->symbol (format "derived-from-~a" s)) (format "derived-from-~a" s)
s))))] s))))]
;; Combine method lists ;; Combine method lists
[public-names (append pubment-names public-final-names public-normal-names)] [public-names (append pubment-names public-final-names public-normal-names)]
@ -3133,6 +3133,11 @@
(values #f #t) (values #f #t)
(loop (vector-ref (class-supers c) (sub1 (class-pos c))) #t)))))) (loop (vector-ref (class-supers c) (sub1 (class-pos c))) #t))))))
(define (to-sym s)
(if (string? s)
(string->symbol s)
s))
(define (class-info c) (define (class-info c)
(unless (class? c) (unless (class? c)
(raise-type-error 'class-info "class" c)) (raise-type-error 'class-info "class" c))
@ -3141,7 +3146,7 @@
(let loop ([next super][skipped? #f]) (let loop ([next super][skipped? #f])
(if (or (not next) (if (or (not next)
(struct? ((class-insp-mk next)))) (struct? ((class-insp-mk next))))
(values (class-name c) (values (to-sym (class-name c))
(- (class-field-width c) (class-field-width super)) (- (class-field-width c) (class-field-width super))
(apply list-immutable (filter interned? (class-field-ids c))) (apply list-immutable (filter interned? (class-field-ids c)))
(class-field-ref c) (class-field-ref c)