/[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.82 by rtoy, Thu Nov 30 15:49:30 2006 UTC revision 1.83 by rtoy, Sat May 24 14:41:39 2008 UTC
# Line 714  Line 714 
714    (add-direct-subclasses class direct-superclasses)    (add-direct-subclasses class direct-superclasses)
715    (setf (slot-value class 'class-precedence-list)    (setf (slot-value class 'class-precedence-list)
716          (compute-class-precedence-list class))          (compute-class-precedence-list class))
717      (setf (slot-value class 'cpl-available-p) t)
718    (setf (slot-value class 'slots) (compute-slots class))    (setf (slot-value class 'slots) (compute-slots class))
719    (let ((lclass (kernel::find-class (class-name class))))    (let ((lclass (kernel::find-class (class-name class))))
720      (setf (kernel:%class-pcl-class lclass) class)      (setf (kernel:%class-pcl-class lclass) class)
# Line 860  Line 861 
861          ;; Need to have the cpl setup before update-lisp-class-layout          ;; Need to have the cpl setup before update-lisp-class-layout
862          ;; is called on CMUCL.          ;; is called on CMUCL.
863          (setf (slot-value class 'class-precedence-list) cpl)          (setf (slot-value class 'class-precedence-list) cpl)
864            (setf (slot-value class 'cpl-available-p) t)
865          (force-cache-flushes class))          (force-cache-flushes class))
866        (setf (slot-value class 'class-precedence-list) cpl))        (progn
867            (setf (slot-value class 'class-precedence-list) cpl)
868            (setf (slot-value class 'cpl-available-p) t)))
869    (update-class-can-precede-p cpl))    (update-class-can-precede-p cpl))
870    
871  (defun update-class-can-precede-p (cpl)  (defun update-class-can-precede-p (cpl)
# Line 1655  Line 1659 
1659                                       &key direct-slots direct-superclasses)                                       &key direct-slots direct-superclasses)
1660    (declare (ignore slot-names))    (declare (ignore slot-names))
1661    (let ((kernel-class (kernel::find-class (class-name class))))    (let ((kernel-class (kernel::find-class (class-name class))))
1662      (with-slots (wrapper class-precedence-list prototype predicate-name      (with-slots (wrapper class-precedence-list cpl-available-p
1663                             prototype predicate-name
1664                           (direct-supers direct-superclasses))                           (direct-supers direct-superclasses))
1665          class          class
1666        (setf (slot-value class 'direct-slots)        (setf (slot-value class 'direct-slots)
# Line 1666  Line 1671 
1671        (setq direct-supers direct-superclasses)        (setq direct-supers direct-superclasses)
1672        (setq wrapper (kernel:%class-layout kernel-class))        (setq wrapper (kernel:%class-layout kernel-class))
1673        (setq class-precedence-list (compute-class-precedence-list class))        (setq class-precedence-list (compute-class-precedence-list class))
1674          (setq cpl-available-p t)
1675        (add-direct-subclasses class direct-superclasses)        (add-direct-subclasses class direct-superclasses)
1676        (setq predicate-name (make-class-predicate-name (class-name class)))        (setq predicate-name (make-class-predicate-name (class-name class)))
1677        (make-class-predicate class predicate-name)        (make-class-predicate class predicate-name)

Legend:
Removed from v.1.82  
changed lines
  Added in v.1.83

  ViewVC Help
Powered by ViewVC 1.1.5