46 |
(let* ((info (initialize-info class initargs)) |
(let* ((info (initialize-info class initargs)) |
47 |
(valid-p (initialize-info-valid-p info))) |
(valid-p (initialize-info-valid-p info))) |
48 |
(when (and (consp valid-p) (eq (car valid-p) :invalid)) |
(when (and (consp valid-p) (eq (car valid-p) :invalid)) |
49 |
(error "Invalid initialization argument ~S for class ~S" |
(specific-error :invalid-form "Invalid initialization argument ~S for class ~S" |
50 |
(cdr valid-p) (class-name class)))) |
(cdr valid-p) (class-name class)))) |
51 |
(let ((instance (apply #'allocate-instance class initargs))) |
(let ((instance (apply #'allocate-instance class initargs))) |
52 |
(apply #'initialize-instance instance initargs) |
(apply #'initialize-instance instance initargs) |
95 |
(info (initialize-info class initargs)) |
(info (initialize-info class initargs)) |
96 |
(valid-p (initialize-info-ri-valid-p info))) |
(valid-p (initialize-info-ri-valid-p info))) |
97 |
(when (and (consp valid-p) (eq (car valid-p) :invalid)) |
(when (and (consp valid-p) (eq (car valid-p) :invalid)) |
98 |
(error "Invalid initialization argument ~S for class ~S" |
(specific-error :invalid-form "Invalid initialization argument ~S for class ~S" |
99 |
(cdr valid-p) (class-name class)))) |
(cdr valid-p) (class-name class)))) |
100 |
(apply #'shared-initialize instance nil initargs) |
(apply #'shared-initialize instance nil initargs) |
101 |
instance) |
instance) |
134 |
|
|
135 |
(defmethod shared-initialize |
(defmethod shared-initialize |
136 |
((instance slot-object) slot-names &rest initargs) |
((instance slot-object) slot-names &rest initargs) |
137 |
|
|
138 |
(when (eq slot-names 't) |
(when (eq slot-names 't) |
139 |
|
;; FIXME this should be in the -t- and -nil- functions eventually |
140 |
|
;; loop through initargs looking for errors |
141 |
|
(doplist (initarg val) initargs) |
142 |
(return-from shared-initialize |
(return-from shared-initialize |
143 |
(call-initialize-function |
(progn |
144 |
(initialize-info-shared-initialize-t-function |
(call-initialize-function |
145 |
(initialize-info (class-of instance) initargs)) |
(initialize-info-shared-initialize-t-function |
146 |
instance initargs))) |
(initialize-info (class-of instance) initargs)) |
147 |
|
instance initargs) |
148 |
|
instance))) |
149 |
(when (eq slot-names 'nil) |
(when (eq slot-names 'nil) |
150 |
|
;; FIXME this should be in the -t- and -nil- functions eventually |
151 |
|
;; loop through initargs looking for errors |
152 |
|
(doplist (initarg val) initargs) |
153 |
(return-from shared-initialize |
(return-from shared-initialize |
154 |
(call-initialize-function |
(progn |
155 |
(initialize-info-shared-initialize-nil-function |
(call-initialize-function |
156 |
(initialize-info (class-of instance) initargs)) |
(initialize-info-shared-initialize-nil-function |
157 |
instance initargs))) |
(initialize-info (class-of instance) initargs)) |
158 |
|
instance initargs) |
159 |
|
instance))) |
160 |
;; |
;; |
161 |
;; initialize the instance's slots in a two step process |
;; initialize the instance's slots in a two step process |
162 |
;; (1) A slot for which one of the initargs in initargs can set |
;; (1) A slot for which one of the initargs in initargs can set |
251 |
(doplist (key val) initargs |
(doplist (key val) initargs |
252 |
(unless (memq key legal) |
(unless (memq key legal) |
253 |
(if error-p |
(if error-p |
254 |
(error "Invalid initialization argument ~S for class ~S" |
(specific-error :invalid-form "Invalid initialization argument ~S for class ~S" |
255 |
key |
key |
256 |
(class-name class)) |
(class-name class)) |
257 |
(return-from check-initargs-2-plist nil))))) |
(return-from check-initargs-2-plist nil))))) |
264 |
(dolist (key initkeys) |
(dolist (key initkeys) |
265 |
(unless (memq key legal) |
(unless (memq key legal) |
266 |
(if error-p |
(if error-p |
267 |
(error "Invalid initialization argument ~S for class ~S" |
(specific-error :invalid-form "Invalid initialization argument ~S for class ~S" |
268 |
key |
key |
269 |
(class-name class)) |
(class-name class)) |
270 |
(return-from check-initargs-2-list nil))))) |
(return-from check-initargs-2-list nil))))) |