Changeset 13185 for trunk/abcl/src/org
- Timestamp:
- 01/26/11 08:39:54 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13184 r13185 166 166 (writers ()) 167 167 (other-options ()) 168 168 (non-std-options ())) 169 169 (do ((olist (cdr spec) (cddr olist))) 170 170 ((null olist)) … … 175 175 "duplicate slot option :INITFORM for slot named ~S" 176 176 name)) 177 (setq initfunction 178 `(function (lambda () ,(cadr olist)))) 179 (setq initform `',(cadr olist))) 177 (setq initfunction t) 178 (setq initform (cadr olist))) 180 179 (:initarg 181 180 (push-on-end (cadr olist) initargs)) … … 211 210 (push-on-end `(setf ,(cadr olist)) writers)) 212 211 (t 213 212 (push-on-end `(quote ,(car olist)) non-std-options) 214 213 (push-on-end (cadr olist) non-std-options)))) 215 214 `(list 216 215 :name ',name 217 216 ,@(when initfunction 218 `(:initform ,initform 219 :initfunction ,initfunction)) 217 `(:initform ',initform 218 :initfunction ,(if (eq allocation :class) 219 ;; CLHS specifies the initform for a 220 ;; class allocation level slot needs 221 ;; to be evaluated in the dynamic 222 ;; extent of the DEFCLASS form 223 (let ((var (gensym))) 224 `(let ((,var ,initform)) 225 (lambda () ,var))) 226 `(lambda () ,initform)))) 220 227 ,@(when initargs `(:initargs ',initargs)) 221 228 ,@(when readers `(:readers ',readers)) … … 1313 1320 (setf object (cadr object))) 1314 1321 (intern-eql-specializer object))) 1315 1322 ((and (consp specializer) 1316 1323 (eq (car specializer) 'java:jclass)) 1317 1324 (let ((jclass (eval specializer))) 1318 1325 (java::ensure-java-class jclass))) 1319 1326 (t 1320 1327 (error "Unknown specializer: ~S" specializer))))
Note: See TracChangeset
for help on using the changeset viewer.