summaryrefslogtreecommitdiff
path: root/Lisp/libobjcl.lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-06 21:23:01 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-06 21:23:01 +0100
commit3f06b3a67a1d2ca8ef3eafffb4d67bd8b0ae47e8 (patch)
treeb994e87e4e100ae977790a931496ffa7ab370d08 /Lisp/libobjcl.lisp
parent3ffee49d000d27f9af5e74fef540ab345ead4332 (diff)
Assign a fake metaclass as a metaclass to the root metaclass.
darcs-hash:e594ffa7fa03edfdbfd4f44708c2a1863c96a2af
Diffstat (limited to 'Lisp/libobjcl.lisp')
-rw-r--r--Lisp/libobjcl.lisp57
1 files changed, 28 insertions, 29 deletions
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)))))))