original commit: 35ee9f2fa200eeabd04613ec2cc10f3d0ef69241
This commit is contained in:
Matthew Flatt 2001-04-27 01:06:43 +00:00
parent 09f2fa59d1
commit a6788d0b34
3 changed files with 10 additions and 10 deletions

View File

@ -1332,7 +1332,7 @@
(lambda (this super-init args) (lambda (this super-init args)
(unless (null? args) (unless (null? args)
(obj-error "make-object" "unused initialization arguments: ~e" args)) (obj-error 'make-object "unused initialization arguments: ~e" args))
(void)) (void))
#t)) ; no super-init #t)) ; no super-init
@ -1402,7 +1402,7 @@
(when by-pos-only? (when by-pos-only?
(unless (null? named-args) (unless (null? named-args)
(obj-error (obj-error
"make-object" 'make-object
"class has only by-position initializers, but given keyword-based arguments: ~e~a" "class has only by-position initializers, but given keyword-based arguments: ~e~a"
named-args named-args
(for-class (class-name c))))) (for-class (class-name c)))))
@ -1412,7 +1412,7 @@
(let loop ([al by-pos-args][nl (class-init-args c)]) (let loop ([al by-pos-args][nl (class-init-args c)])
(cond (cond
[(null? al) named-args] [(null? al) named-args]
[(null? nl) (obj-error "make-object" "too many initialization arguments: ~e~a" [(null? nl) (obj-error 'make-object "too many initialization arguments: ~e~a"
by-pos-args by-pos-args
(for-class (class-name c)))] (for-class (class-name c)))]
[else (cons (cons (car nl) (car al)) [else (cons (cons (car nl) (car al))
@ -1425,7 +1425,7 @@
(let loop ([l named-args]) (let loop ([l named-args])
(unless (null? (cdr l)) (unless (null? (cdr l))
(if (assq (caar l) (cdr l)) (if (assq (caar l) (cdr l))
(obj-error "make-object" "duplicate initialization argument: ~a in: ~e~a" (obj-error 'make-object "duplicate initialization argument: ~a in: ~e~a"
(caar l) (caar l)
named-args named-args
(for-class (class-name c))) (for-class (class-name c)))
@ -1436,7 +1436,7 @@
;; ----- This is the super-init function ----- ;; ----- This is the super-init function -----
(lambda (ignore-false by-pos-args new-named-args) (lambda (ignore-false by-pos-args new-named-args)
(when inited? (when inited?
(obj-error "make-object" "superclass already initialized by class initialization~a" (obj-error 'make-object "superclass already initialized by class initialization~a"
(for-class (class-name c)))) (for-class (class-name c))))
(set! inited? #t) (set! inited? #t)
(let ([named-args (if by-pos-only? (let ([named-args (if by-pos-only?
@ -1452,7 +1452,7 @@
(loop (vector-ref (class-supers c) (sub1 (class-pos c))) by-pos-args named-args))) (loop (vector-ref (class-supers c) (sub1 (class-pos c))) by-pos-args named-args)))
named-args) named-args)
(unless inited? (unless inited?
(obj-error "make-object" "superclass initialization not invoked by initialization~a" (obj-error 'make-object "superclass initialization not invoked by initialization~a"
(for-class (class-name c)))))))) (for-class (class-name c))))))))
o)) o))
@ -1463,14 +1463,14 @@
(cond (cond
[a (cdr a)] [a (cdr a)]
[default (default)] [default (default)]
[else (obj-error "make-object" "no argument for required init variable: ~a~a" name [else (obj-error 'make-object "no argument for required init variable: ~a~a" name
(if class-name (format " in class: ~a" class-name) ""))])) (if class-name (format " in class: ~a" class-name) ""))]))
;; By-position mode ;; By-position mode
(cond (cond
[(< name (length arguments)) [(< name (length arguments))
(list-ref arguments name)] (list-ref arguments name)]
[default (default)] [default (default)]
[else (obj-error "make-object" "too few initialization arguments")]))) [else (obj-error 'make-object "too few initialization arguments")])))
(define (extract-rest-args skip arguments) (define (extract-rest-args skip arguments)
(if (< skip (length arguments)) (if (< skip (length arguments))

View File

@ -205,7 +205,7 @@
(export) (export)
(define (filter v) (define (filter v)
(if (procedure? v) (if (procedure? v)
`(proc: ,(object-name v)) `(proc: ,(syntax-e (object-name v)))
v)) v))
(display (display
(map filter (list x v struct:a y make-x x? x-z both)) (map filter (list x v struct:a y make-x x? x-z both))

View File

@ -298,7 +298,7 @@
(let ([p (open-output-string)] (let ([p (open-output-string)]
[filter (lambda (v) [filter (lambda (v)
(if (procedure? v) (if (procedure? v)
`(proc: ,(object-name v)) `(proc: ,(syntax-e (object-name v)))
v))]) v))])
(invoke-unit/sig (invoke-unit/sig
(compound-unit/sig (compound-unit/sig