src/contextl-hacks.lisp

   1 (in-package :contextl)
   2
   3 ;;; HACK: We are ending up with classes named NIL in the superclass list.
   4 ;;; These cannot be given the special object superclass when re-initializing
   5 ;;; is it will be in the subclasses superclasses AFTER this class, causing
   6 ;;; a confict.
   7 ;;; Since we don't care about these classes (?) this might work (?)
   8
   9 (defmethod initialize-instance :around
  10   ((class special-class) &rest initargs
  11    &key direct-superclasses)
  12   (declare (dynamic-extent initargs))
  13   (if (or
  14        ;; HACK begins
  15        (not (ignore-errors (class-name class)))
  16        ;; ENDHACK
  17           (loop for superclass in direct-superclasses
  18             thereis (ignore-errors (subtypep superclass 'special-object))))
  19     (call-next-method)
  20     (progn  (apply #'call-next-method class
  21            :direct-superclasses
  22            (append direct-superclasses
  23                    (list (find-class 'special-object)))
  24            initargs))))
  25
  26 (defmethod reinitialize-instance :around
  27   ((class special-class) &rest initargs
  28    &key (direct-superclasses () direct-superclasses-p))
  29   (declare (dynamic-extent initargs))
  30   (if direct-superclasses-p
  31       (if (or  ; Here comes the hack
  32            (not (class-name class))
  33                ;endhack
  34            (loop for superclass in direct-superclasses
  35               thereis (ignore-errors (subtypep superclass 'special-object))))
  36       (call-next-method)
  37       (apply #'call-next-method class
  38              :direct-superclasses
  39              (append direct-superclasses
  40                      (list
  41                       (find-class 'special-object)))
  42              initargs)))
  43      (call-next-method))