[Openmcl-devel] mop issue

[marco]

rm at fabula.de writes:

>> should _not_ since super is already a super class of foo which is a
>> super class of bar. adding super to bar's direct-superclasses would
>> probably work most of the time, but really isn't what i want.
>
> Why? If you append it to the list of direct-supers? Anyway, the way 
> clsql does it: look if super is already on the cpl of any of the 
> direct supers and append it to the list iff not.

simply because i don't want super to be on the list of
direct-superclasses, i only want super to be on the c-p-l.

let me rephrase the question: i'd like to write a metaclass which
ensures that all instances of the metaclass have super on their
c-p-l. should the user of defclass not put super in the
direct-superclasses, nor provide a direct-superclass which has super
on it's c-p-l, i would like super to be the first element (after the
class itself) of the c-p-l.

here's a repl session which shows what it that's confusing me:

; loading system definition from /Users/mb/lisp/systems/asdf-install.asd into
; #<Package "ASDF0">
; registering #<SYSTEM ASDF-INSTALL #x63BCE36> as ASDF-INSTALL
Welcome to OpenMCL Version (Beta: Darwin) 0.14.2-p1!
? (setf (find-class 'super nil) nil
      (find-class 'foo nil) nil
      (find-class 'bar nil) nil)

NIL
? (defclass klass (standard-class)
  ())
#<STANDARD-CLASS KLASS>
? (defmethod mopp:validate-superclass ((sub klass) (super standard-class))
  t)
#<STANDARD-METHOD VALIDATE-SUPERCLASS (KLASS STANDARD-CLASS)>
? (defmethod mopp:compute-class-precedence-list ((class klass))
  (let ((cpl (call-next-method))
        (super (find-class 'super nil)))
    (unless super
      (error "Super class has not yet been defined."))
    (unless (mopp:class-finalized-p super)
      (error "Super has not been finalized yet."))
    (if (member super cpl)
        cpl
        (append (remove-if (lambda (c)
                             (member c (mopp:class-precedence-list super)))
                           cpl)
                (mopp:class-precedence-list super)))))
#<STANDARD-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (KLASS)>
? (defclass super ()
  ())
#<STANDARD-CLASS SUPER>
? (defclass foo ()
  ()
  (:metaclass klass))
#<KLASS FOO>
? (mopp:class-precedence-list *)
(#<KLASS FOO> #<STANDARD-CLASS SUPER> #<STANDARD-CLASS STANDARD-OBJECT> #<BUILT-IN-CLASS T>)
? (defclass bar (foo)
  ()
  (:metaclass klass))

> Error in process listener(1): Inconsistent superclasses for #<KLASS BAR>
> While executing: CCL::COMPUTE-CPL
> Type :POP to abort.
Type :? for other options.
1 > :b
(F0135AB0) : 0 "CCL::COMPUTE-CPL" 692
(F0135AC0) : 1 NIL NIL
(F0135AD0) : 2 "CCL::%CALL-NEXT-METHOD" 504
(F0135AF0) : 3 "#<STANDARD-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (KLASS)>" 44
(F0135B00) : 4 NIL NIL
(F0135B10) : 5 "CCL::%%STANDARD-COMBINED-METHOD-DCODE" 368
(F0135B20) : 6 NIL NIL
(F0135B30) : 7 "CCL::UPDATE-CLASS" 200
(F0135B40) : 8 "CCL::UPDATE-CLASS" 108
(F0135B50) : 9 "#<CCL::STANDARD-KERNEL-METHOD SHARED-INITIALIZE :AFTER (CCL::SLOTS-CLASS T)>" 988
(F0135B60) : 10 "CCL::%%BEFORE-AND-AFTER-COMBINED-METHOD-DCODE" 772
(F0135B70) : 11 NIL NIL
(F0135B80) : 12 "CCL::%%STANDARD-COMBINED-METHOD-DCODE" 148
(F0135B90) : 13 NIL NIL
(F0135BA0) : 14 NIL NIL
(F0135BB0) : 15 NIL NIL
(F0135BC0) : 16 "CCL::%%STANDARD-COMBINED-METHOD-DCODE" 148
(F0135BD0) : 17 NIL NIL
(F0135BE0) : 18 "CCL::%MAKE-STD-INSTANCE" 296
(F0135BF0) : 19 NIL NIL
(F0135C00) : 20 "#<CCL::STANDARD-KERNEL-METHOD MAKE-INSTANCE (STANDARD-CLASS)>" 56
(F0135C10) : 21 "#<CCL::STANDARD-KERNEL-METHOD ENSURE-CLASS-USING-CLASS (NULL T)>" 108
(F0135C20) : 22 NIL NIL
(F0135C30) : 23 "CCL::CALL-CHECK-REGS" 72
(F0135C40) : 24 NIL NIL
(F0135C50) : 25 "CCL::TOPLEVEL-EVAL" 152
(F0135C60) : 26 "CCL::READ-LOOP" 844
(F0135CA0) : 27 "TOPLEVEL-LOOP" 44
(F0135CC0) : 28 "Anonymous Function #x60F8B36" 68
(F0135CD0) : 29 NIL NIL
(F0135CE0) : 30 "Anonymous Function #x613F64E" 592
(F0135D00) : 31 "CCL::RUN-PROCESS-INITIAL-FORM" 400
(F0135D30) : 32 NIL NIL
(F0135D40) : 33 "Anonymous Function #x6101D3E" 152
(F0135D60) : 34 "Anonymous Function #x60F491E" 172
1 > :pop

? (setf (find-class 'super nil) nil
      (find-class 'foo nil) nil
      (find-class 'bar nil) nil)

NIL
? (defclass super ()
  ())
#<STANDARD-CLASS SUPER>
? (defclass foo (super)
  ()
  (:metaclass klass))
#<KLASS FOO>
? (mopp:class-precedence-list (find-class 'foo))
(#<KLASS FOO> #<STANDARD-CLASS SUPER> #<STANDARD-CLASS STANDARD-OBJECT> #<BUILT-IN-CLASS T>)
? (defclass bar (foo)
  ()
  (:metaclass klass))
#<KLASS BAR>
? 

i can define SUPER (obviously), i can also define FOO and doing so i
find SUPER on it's c-p-l whether or not i put super in foo's
direct-superclass. the error only occurs when attempting to define BAR
and it occurs in the call to call-next-method. so i'm doing something
to foo's c-p-l which makes determinig bar's c-p-l using the standard
implementation of c-c-p-l error. if however i manually insert super in
foo's direct-superclass then the c-p-l of foo is equal to what it was
before, but i'm able to create the bar class.

on cmucl and sbcl this code works as i expect it to work, but maybe
i'm just lucky (i haven't tried on other implementations).

-- 
-Marco
Ring the bells that still can ring.
Forget your perfect offering.
There is a crack in everything.
That's how the light gets in.
     -Leonard Cohen