Changeset 616


Ignore:
Timestamp:
Mar 3, 2004, 11:27:12 PM (17 years ago)
Author:
gb
Message:

Define and use COMPUTE-CLASS-PRECEDENCE-LIST. Flush initargs caches whenever
class is finalized.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-clos.lisp

    r421 r616  
    422422  (update-class class t))
    423423
     424
     425(defmethod finalize-inheritance ((class forward-referenced-class))
     426  (error "Class ~s can't be finalized." class))
     427
    424428(defmethod class-primary-p ((class std-class))
    425429  (%class-primary-p class))
     
    482486        (sort-list slotds '< #'slotd-position)))))
    483487
    484 (defun class-has-a-forward-referenced-superclass-p (class)
    485   (or (forward-referenced-class-p class)
    486       (some #'class-has-a-forward-referenced-superclass-p
    487             (%class-direct-superclasses class))))
     488
     489
    488490
    489491(defun update-cpl (class cpl)
     
    495497
    496498
     499(defun class-has-a-forward-referenced-superclass-p (class)
     500  (or (if (forward-referenced-class-p class) class)
     501      (dolist (s (%class-direct-superclasses class))
     502        (let* ((fwdref (class-has-a-forward-referenced-superclass-p s)))
     503          (when fwdref (return fwdref))))))
     504
     505
     506(defmethod compute-class-precedence-list ((class class))
     507  (let* ((fwdref (class-has-a-forward-referenced-superclass-p class)))
     508    (when fwdref
     509      (error "~&Class ~s can't be finalized because at least one of its superclasses (~s) is a FORWARD-REFERENCED-CLASS." class fwdref)))
     510  (compute-cpl class))
     511
     512;;; Classes that can't be instantiated via MAKE-INSTANCE have no
     513;;; initargs caches.
     514(defmethod %flush-initargs-caches ((class class))
     515  )
     516
     517;;; Classes that have initargs caches should flush them when the
     518;;; class is finalized.
     519(defmethod %flush-initargs-caches ((class std-class))
     520  (setf (%class.make-instance-initargs class) nil
     521        (%class.reinit-initargs class) nil
     522        (%class.redefined-initargs class) nil
     523        (%class.changed-initargs class) nil))
    497524
    498525(defun update-class (class finalizep)
     
    512539            (class-finalized-p class)
    513540            (not (class-has-a-forward-referenced-superclass-p class)))
    514     (update-cpl class (compute-cpl  class))
     541    (update-cpl class (compute-class-precedence-list  class))
    515542    ;;; This -should- be made to work for structure classes
    516543    (update-slots class (compute-slots class))
    517544    (setf (%class-default-initargs class) (compute-default-initargs class))
     545    (%flush-initargs-caches class)
    518546    )
    519547  (unless finalizep
     
    14211449                            (apply #'update-dependent class d initargs))))
    14221450
    1423 (defmethod finalize-inheritance ((fwc forward-referenced-class))
    1424   (error "~s can't be finalized." fwc))
    14251451
    14261452(defun %allocate-gf-instance (class)
Note: See TracChangeset for help on using the changeset viewer.