Make (DEFCLASS SELECTOR ...) work on Allegro CL.

darcs-hash:1a27f84277b0ed60eefb45499ebac15506aebd20

1 files changed, 28 insertions, 8 deletions

diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index ba98fc3..788db5b 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -31,14 +31,34 @@
 
 
 ;;;; (@* "Objective-C object wrapper classes")
-(defclass c-pointer-wrapper ()
-  ((pointer :type     c-pointer
-            :reader   pointer-to
-            :initarg  :pointer
-            :initform (cffi:null-pointer))))
-
-
-(defclass selector   (c2mop:funcallable-standard-object c-pointer-wrapper) ()
+(with-compilation-unit ()  ; needed for class finalization
+  (defclass c-pointer-wrapper ()
+       ((pointer :type     c-pointer
+                 :reader   pointer-to
+                 :initarg  :pointer
+                 :initform (cffi:null-pointer)))))
+
+
+;; The following may be needed by some implementations (namely Allegro
+;; CL), but I'm not sure.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (loop for class-name in '(c2mop:funcallable-standard-object
+                            c-pointer-wrapper)
+        for class = (find-class class-name nil)
+        when class
+          unless (c2mop:class-finalized-p class)
+            do (c2mop:finalize-inheritance class)))
+
+
+;; FIXME: I'm not confident about this, but it is needed in order to
+;; make (DEFCLASS SELECTOR ...) work.
+(defmethod c2mop:validate-superclass ((class c2mop:funcallable-standard-class)
+                                      (superclass standard-class))
+  t)
+
+
+(defclass selector (c2mop:funcallable-standard-object c-pointer-wrapper)
+     ()
   (:metaclass c2mop:funcallable-standard-class)
   (:documentation "An Objective-C method selector.