From 3f06b3a67a1d2ca8ef3eafffb4d67bd8b0ae47e8 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Wed, 6 Feb 2008 21:23:01 +0100 Subject: Assign a fake metaclass as a metaclass to the root metaclass. darcs-hash:e594ffa7fa03edfdbfd4f44708c2a1863c96a2af --- Lisp/libobjcl.lisp | 57 +++++++++++++++++++++++++++--------------------------- 1 file changed, 28 insertions(+), 29 deletions(-) (limited to 'Lisp/libobjcl.lisp') diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 536938e..07f88ac 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -296,37 +296,36 @@ conventional case for namespace identifiers in Objective-C." (find-objc-meta-class (%objcl-class-name (pointer-to non-meta-superclass))) - (find-class 'objective-c-class)))) + (find-class 'objective-c-class))) + ;; If there is no superclass, we are the root metaclass. + ;; As we cannot assign ourselves as our own metaclass + ;; (which is a pity, because it would be the correct thing + ;; to do), we generate a fake metaclass for ourselves that + ;; is almost the same as ourselves except for its own + ;; metaclass, which is OBJECTIVE-C-META-CLASS. (As we are + ;; probably +NS-OBJECT, this fake metaclass will be called + ;; ++NS-OBJECT.) + ;; + ;; If the superclass is the root metaclass, we take it as + ;; our metaclass, because the root metaclass is the + ;; metaclass of all metaclasses. + ;; + ;; Otherwise, we use the metaclass of the superclass as + ;; our own, which will always get us the root metaclass. + (metaclass + (if non-meta-superclass + (if (typep (class-of superclass) + 'objective-c-meta-class) + superclass + (class-of superclass)) + (c2mop:ensure-class + (objc-fake-meta-class-name->symbol class-name-string) + :metaclass 'objective-c-meta-class + :pointer class-ptr + :direct-superclasses (list superclass))))) (or (find-class class-name nil) (c2mop:ensure-class class-name - ;; If there is no superclass, we are - ;; the root metaclass. As we cannot - ;; assign ourselves as our own - ;; metaclass (which is a pity, because - ;; it would be the correct thing to - ;; do), we use OBJECTIVE-C-META-CLASS - ;; as our metaclass and regrettably - ;; miss out on some features. (Sorry, - ;; you can't get at +NS-OBJECT's - ;; slots.) - ;; - ;; If the superclass is the root - ;; metaclass, we take it as our - ;; metaclass, because the root - ;; metaclass is the metaclass of all - ;; metaclasses. - ;; - ;; Otherwise, we use the metaclass of - ;; the superclass as our own, which - ;; will always get us the root - ;; metaclass. - :metaclass (if non-meta-superclass - (if (eq (class-name - (class-of superclass)) - 'objective-c-meta-class) - superclass - (class-of superclass)) - 'objective-c-meta-class) + :metaclass metaclass :pointer class-ptr :direct-superclasses (list superclass))))))) -- cgit v1.2.3