/[cmucl]/src/pcl/std-class.lisp
ViewVC logotype

Diff of /src/pcl/std-class.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9.2.5 by pw, Fri Aug 4 10:34:59 2000 UTC revision 1.9.2.6 by pw, Sat Mar 23 18:51:21 2002 UTC
# Line 363  Line 363 
363           (unsupplied (list 1))           (unsupplied (list 1))
364           (supplied-meta   (getf initargs :metaclass unsupplied))           (supplied-meta   (getf initargs :metaclass unsupplied))
365           (supplied-supers (getf initargs :direct-superclasses unsupplied))           (supplied-supers (getf initargs :direct-superclasses unsupplied))
          (supplied-slots  (getf initargs :direct-slots unsupplied))  
366           (meta           (meta
367             (cond ((neq supplied-meta unsupplied)             (cond ((neq supplied-meta unsupplied)
368                    (find-class supplied-meta))                    (find-class supplied-meta))
# Line 383  Line 382 
382                                               :name s)))))))                                               :name s)))))))
383        (loop (unless (remf initargs :metaclass) (return)))        (loop (unless (remf initargs :metaclass) (return)))
384        (loop (unless (remf initargs :direct-superclasses) (return)))        (loop (unless (remf initargs :direct-superclasses) (return)))
       (loop (unless (remf initargs :direct-slots) (return)))  
385        (values meta        (values meta
386                (list* :direct-superclasses                (nconc
387                       (and (neq supplied-supers unsupplied)                 (when (neq supplied-supers unsupplied)
388                            (mapcar #'fix-super supplied-supers))                   (list
389                       :direct-slots                    :direct-superclasses
390                       (and (neq supplied-slots unsupplied) supplied-slots)                    (mapcar #'fix-super supplied-supers)))
391                       initargs)))))                 initargs)))))
392    
393    
394  ;;;  ;;;
# Line 413  Line 411 
411                   (direct-default-initargs nil direct-default-initargs-p)                   (direct-default-initargs nil direct-default-initargs-p)
412                   (predicate-name nil predicate-name-p))                   (predicate-name nil predicate-name-p))
413    (declare (ignore slot-names))    (declare (ignore slot-names))
414    (cond (direct-superclasses-p    (cond ((or direct-superclasses-p
415                 (null (slot-value class 'direct-superclasses)))
416           (setq direct-superclasses           (setq direct-superclasses
417                 (or direct-superclasses                 (or direct-superclasses
418                     (list (if (funcallable-standard-class-p class)                     (list (if (funcallable-standard-class-p class)
# Line 550  Line 549 
549               (defstruct-form               (defstruct-form
550                 `(progn                 `(progn
551                    ,defstruct                    ,defstruct
552                    ,@readers-init ,@writers-init                    ,@readers-init ,@writers-init)))
                   (declare-structure ',name nil nil))))  
553          (unless (structure-type-p name) (eval defstruct-form))          (unless (structure-type-p name) (eval defstruct-form))
554          (mapc #'(lambda (dslotd reader-name writer-name)          (mapc #'(lambda (dslotd reader-name writer-name)
555                    (let* ((reader (gdefinition reader-name))                    (let* ((reader (gdefinition reader-name))

Legend:
Removed from v.1.9.2.5  
changed lines
  Added in v.1.9.2.6

  ViewVC Help
Powered by ViewVC 1.1.5