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

.

Browse Source 
original commit: 23fab9ce0e6df951862a85c52b6439d8745eb7fa
This commit is contained in:
Matthew Flatt 2001-06-22 20:19:32 +00:00
parent f9f8fff3af
commit 1157504713
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mzlib/class.ss
View File

@ -1393,7 +1393,7 @@
(define (do-make-object class by-pos-args named-args) (define (do-make-object class by-pos-args named-args)
(unless (class? class) (unless (class? class)
(raise-type-error (quote-syntax make-object) "class" class)) (raise-type-error 'make-object "class" class))
(let ([o ((class-make-object class))]) (let ([o ((class-make-object class))])
;; Initialize it: ;; Initialize it:
(let loop ([c class][by-pos-args by-pos-args][named-args named-args][explict-named-args? #t]) (let loop ([c class][by-pos-args by-pos-args][named-args named-args][explict-named-args? #t])
@ -1417,13 +1417,13 @@
[(null? al) named-args] [(null? al) named-args]
[(null? nl) [(null? nl)
;; continue mapping with superclass init args, if allowed ;; continue mapping with superclass init args, if allowed
(let ([super (and (eq? 'normal (class-init-mode c)) (let ([super (and (eq? 'normal (class-init-mode ic))
(positive? (class-pos c)) (positive? (class-pos ic))
(vector-ref (class-supers c) (sub1 (class-pos c))))]) (vector-ref (class-supers ic) (sub1 (class-pos ic))))])
(cond (cond
[(and super (class-init-args super)) [(and super (class-init-args super))
(loop al (class-init-args super) super)] (loop al (class-init-args super) super)]
[(eq? 'list (class-init-mode c)) [(eq? 'list (class-init-mode ic))
(map (lambda (x) (cons #f x)) al)] (map (lambda (x) (cons #f x)) al)]
[else [else
(obj-error 'make-object (obj-error 'make-object