Simplify the Objective-C layer, make the newest additions compatible with the Apple runtime.

darcs-hash:c6ec225e9ccf78e267f1a4985971ec9ac3239bc8

5 files changed, 60 insertions, 126 deletions

diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 072eb30..9849392 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -42,20 +42,20 @@
 (defcfun ("objcl_find_class" %objcl-find-class) :pointer
   (class-name :string))
 
-(defcfun ("objcl_class_name" %objcl-class-name) :pointer
-  (class obj-data))
+(defcfun ("objcl_class_name" %objcl-class-name) :string
+  (class :pointer))
 
 (defcfun ("objcl_find_selector" %objcl-find-selector) :pointer
   (selector-name :string))
 
-(defcfun ("objcl_selector_name" %objcl-selector-name) :pointer
-  (selector obj-data))
+(defcfun ("objcl_selector_name" %objcl-selector-name) :string
+  (selector :pointer))
 
 (defcfun ("objcl_get_method_implementation"
           %objcl-get-method-implementation)
     :pointer
-  (object obj-data)
-  (selector obj-data))
+  (object :pointer)
+  (selector :pointer))
 
 (defcfun ("objcl_object_is_class" %objcl-object-is-class) :boolean
   (obj :pointer))
@@ -198,49 +198,43 @@ conventional case for namespace identifiers in Objective C."
 (declaim (ftype (function (string) (or null objc-class))
                 find-objc-class-by-name))
 (defun find-objc-class-by-name (class-name)
-  (with-obj-data-values ((obj-data (%objcl-find-class class-name)))
-    (if (null-pointer-p (foreign-slot-value
-                         (foreign-slot-value obj-data 'obj-data 'data)
-                         'obj-data-union
-                         'class-val))
+  (let ((class-ptr (%objcl-find-class class-name)))
+    (if (cffi:null-pointer-p class-ptr)
         nil
-        (the objc-class (obj-data->lisp obj-data)))))
+        #-openmcl (make-instance 'objc-class :pointer class-ptr)
+        #+openmcl (change-class (make-instance 'c-pointer-wrapper
+                                   :pointer value)
+                                'objc-class))))
 
 
 (declaim (ftype (function (string) (or null selector))
                 find-selector-by-name))
 (defun find-selector-by-name (selector-name)
-  (with-obj-data-values ((obj-data (%objcl-find-selector selector-name)))
-    (if (null-pointer-p (foreign-slot-value
-                         (foreign-slot-value obj-data 'obj-data 'data)
-                         'obj-data-union
-                         'sel-val))
+  (let ((selector-ptr (%objcl-find-selector selector-name)))
+    (if (cffi:null-pointer-p selector-ptr)
         nil
-        (the selector (obj-data->lisp obj-data)))))
+        (make-instance 'selector :pointer selector-ptr))))
 
 
 (declaim (ftype (function ((or objc-class id exception)) string)
                 objcl-class-name))
 (defun objcl-class-name (class)
   (declare (type (or objc-class id exception) class))
-  (with-foreign-conversion ((obj-data class))
-    (foreign-string-to-lisp/dealloc (%objcl-class-name obj-data))))
+  (%objcl-class-name (pointer-to class)))
 
 
 (declaim (ftype (function (selector) string) selector-name))
 (defun selector-name (selector)
   (declare (type selector selector))
-  (with-foreign-conversion ((obj-data selector))
-    (foreign-string-to-lisp/dealloc (%objcl-selector-name obj-data))))
+  (%objcl-selector-name (pointer-to selector)))
 
 
 (declaim (ftype (function ((or id objc-class exception) selector) *)
                 get-method-implementation))
 (defun get-method-implementation (object selector)
   (declare (type selector selector))
-  (with-foreign-conversion ((sel-obj-data selector)
-                            (obj-obj-data object))
-    (%objcl-get-method-implementation obj-obj-data sel-obj-data)))
+  (%objcl-get-method-implementation (pointer-to object)
+                                    (pointer-to selector)))
 
 
 (declaim (ftype (function ((or selector string list)) (or null selector))
@@ -425,13 +419,7 @@ If *selector-designator* is a __selector__, it is simply returned.
                                               (type-name->slot-name type-name)))))
       (case lisp-type
         ((id objc-class selector exception)
-         #-openmcl (make-instance lisp-type :pointer value)
-         #+openmcl (if (eq 'objc-class lisp-type)
-                       ;; God help me.
-                       (change-class (make-instance 'c-pointer-wrapper
-                                        :pointer value)
-                                     lisp-type)
-                       (make-instance lisp-type :pointer value)))
+         (make-instance lisp-type :pointer value) )
         ((string) (foreign-string-to-lisp value))
         (otherwise value)))))
 
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index edbdc17..6176553 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -4,7 +4,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (boundp '+nil+)
     (defconstant +nil+
-                 (make-instance 'id :pointer (objcl-get-nil)))))
+      (make-instance 'id :pointer (objcl-get-nil)))))
 
 
 ;;; (@* "Method invocation")
@@ -154,7 +154,8 @@ Returns: *result* --- the return value of the method invocation.
 
 
 (defmacro unsafe-primitive-invoke (receiver method-name return-type &rest args)
-  (let ((real-return-type (if (member return-type '(id objc-class exception))
+  (let ((real-return-type (if (member return-type '(id objc-class exception
+                                                    selector))
                               :pointer
                               return-type))
         (real-receiver (gensym))
@@ -175,13 +176,10 @@ Returns: *result* --- the return value of the method invocation.
                                            (list :pointer (pointer-to ,real-selector))
                                            objc-arglist
                                            (list ,real-return-type)))))
-                 ,(if (member return-type '(id objc-class exception))
+                 ,(if (member return-type '(id objc-class exception selector))
                       `(let (,@(when (constructor-name-p (selector-name selector))
                                  `((*skip-retaining* t))))
-                         (make-instance ',(case return-type
-                                            ((id) 'id)
-                                            ((objc-class) 'objc-class)
-                                            ((exception) 'exception))
+                         (make-instance return-type
                             :pointer return-value))
                       `return-value))
              (dealloc-objc-arglist objc-arglist)))))))
@@ -277,8 +275,7 @@ Returns: *result* --- the return value of the method invocation.
                                                 return-c-type)))
                      (if (cffi:null-pointer-p pointer)
                          nil
-                         (make-instance return-type
-                            :pointer pointer))))
+                         (make-instance return-type :pointer pointer))))
                   ((:void) (values))
                   (otherwise (cffi:mem-ref return-value-cell
                                            return-c-type)))))))))))
diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp
index a81b61c..b44c05d 100644
--- a/Lisp/utilities.lisp
+++ b/Lisp/utilities.lisp
@@ -6,8 +6,9 @@
 
 
 (defun truep (b)
-  (not (or (zerop b)
-           (null b))))
+  (or (eq b t)
+      (and (numberp b)
+           (not (zerop b)))))
 
 
 (defun id-eql (x y)
@@ -16,17 +17,17 @@
 
 (defun id-equal (x y)
   (truep (if (typep x '(or id objc-class exception))
-             (invoke x :is-equal y)
+             (primitive-invoke x :is-equal :boolean y)
              (progn
                (assert (typep y '(or id objc-class exception)))
-               (invoke y :is-equal x)))))
+               (primitive-invoke y :is-equal :boolean x)))))
 
 
 (defun objc-typep (x class-designator)
-  (objc-eql (invoke x 'class)
+  (objc-eql (object-get-class x)
             (etypecase x
               (class x)
-              (id (invoke x 'class))
+              (id (object-get-class x))
               ((or string symbol) (find-objc-class class-designator t)))))
 
 
diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index 9c673f7..a912748 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -57,10 +57,10 @@ objcl_invoke_with_types (int argc,
                          void *return_value,
                          void **argv);
 
-OBJCL_OBJ_DATA
+Class
 objcl_find_class (const char *class_name);
 
-OBJCL_OBJ_DATA
+SEL
 objcl_find_selector (const char *selector_name);
 
 /* Return a null-terminated list of type information strings.
@@ -71,14 +71,14 @@ objcl_query_arglist_info (void *receiver,
 
 
 const char *
-objcl_class_name (OBJCL_OBJ_DATA class);
+objcl_class_name (Class class);
 
 const char *
-objcl_selector_name (OBJCL_OBJ_DATA class);
+objcl_selector_name (SEL selector);
 
 IMP
-objcl_get_method_implementation (OBJCL_OBJ_DATA object,
-                                 OBJCL_OBJ_DATA selector);
+objcl_get_method_implementation (id object,
+                                 SEL selector);
 
 BOOL
 objcl_object_is_class (id obj);
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index 1a17a44..eaffb8c 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -336,61 +336,27 @@ objcl_invoke_with_types (int argc,
 #endif
 
 
-OBJCL_OBJ_DATA
+Class
 objcl_find_class (const char *class_name)
 {
-  Class class =
-    NSClassFromString ([NSString stringWithUTF8String: class_name]);
-  OBJCL_OBJ_DATA result = malloc (sizeof (struct objcl_object));
-  const char *const typespec = @encode (Class);
-
-  result->type = malloc (strlen (typespec) + 1);
-  strcpy (result->type, typespec);
-  result->data.class_val = class;
-
-  return result;
+  return NSClassFromString ([NSString stringWithUTF8String: class_name]);
 }
 
 
-OBJCL_OBJ_DATA
+SEL
 objcl_find_selector (const char *class_name)
 {
-  SEL selector =
-    NSSelectorFromString ([NSString stringWithUTF8String: class_name]);
-  OBJCL_OBJ_DATA result = malloc (sizeof (struct objcl_object));
-  const char *const typespec = @encode (SEL);
-
-  result->type = malloc (strlen (typespec) + 1);
-  strcpy (result->type, typespec);
-  result->data.sel_val = selector;
-
-  return result;
+  return NSSelectorFromString ([NSString stringWithUTF8String: class_name]);
 }
 
 
 const char *
-objcl_class_name (OBJCL_OBJ_DATA class)
+objcl_class_name (Class class)
 {
   const char *ns_name;
   char *name;
-  Class cls = NULL;
 
-  switch (class->type[0])
-    {
-    case '#':
-      cls = class->data.class_val;
-      break;
-    case '@':
-      cls = class->data.id_val;
-      break;
-    case 'E':
-      cls = (id) class->data.exc_val;
-      break;
-    default:
-      return NULL;
-    }
-
-  ns_name = [(NSStringFromClass (cls)) UTF8String];
+  ns_name = [(NSStringFromClass (class)) UTF8String];
   name = malloc (strlen (ns_name) + 1);
   strcpy (name, ns_name);
 
@@ -399,16 +365,12 @@ objcl_class_name (OBJCL_OBJ_DATA class)
 
 
 const char *
-objcl_selector_name (OBJCL_OBJ_DATA selector)
+objcl_selector_name (SEL selector)
 {
   const char *ns_name;
   char *name;
 
-  if (strcmp (selector->type, @encode (SEL)) != 0)
-    return NULL;
-
-  ns_name = [(NSStringFromSelector (selector->data.sel_val))
-              UTF8String];
+  ns_name = [(NSStringFromSelector (selector)) UTF8String];
   name = malloc (strlen (ns_name) + 1);
   strcpy (name, ns_name);
 
@@ -417,34 +379,20 @@ objcl_selector_name (OBJCL_OBJ_DATA selector)
 
 
 IMP
-objcl_get_method_implementation (OBJCL_OBJ_DATA object,
-                                 OBJCL_OBJ_DATA selector)
+objcl_get_method_implementation (id object,
+                                 SEL selector)
 {
-  id obj;
-
-  if (strcmp (selector->type, @encode (SEL)) != 0)
-    return NULL;
-
-  switch (object->type[0])
+#ifdef __NEXT_RUNTIME__
+  if (objcl_object_is_class (object))
     {
-    case '#':
-      obj = object->data.class_val;
-      break;
-    case '@':
-      obj = object->data.id_val;
-      break;
-    case 'E':
-      obj = (id) object->data.exc_val;
-      break;
-    default:
-      return NULL;
+      return class_getClassMethod (object, selector)->method_imp;
+    }
+  else
+    {
+      return class_getInstanceMethod ([object class], selector)->method_imp;
     }
-
-#ifdef __NEXT_RUNTIME__
-  return class_getInstanceMethod ([obj class],
-                                  selector->data.sel_val)->method_imp;
 #else
-  return objc_msg_lookup (obj, selector->data.sel_val);
+  return objc_msg_lookup (object, selector);
 #endif
 }
 
@@ -453,7 +401,7 @@ BOOL
 objcl_object_is_class (id obj)
 {
 #ifdef __NEXT_RUNTIME__
-  return [obj class] == obj
+  return [obj class] == obj;
 #else
   /* return CLS_ISCLASS (obj); */
   return object_is_class (obj);
@@ -466,7 +414,7 @@ objcl_object_is_meta_class (id obj)
 {
 #ifdef __NEXT_RUNTIME__
   /* FIXME: What to do here? */
-  return [[obj class] metaClass] == obj;
+  return objcl_object_get_meta_class (obj) == obj;
 #else
   /* return CLS_ISMETA (ptr); */
   if (objcl_object_is_class (obj))
@@ -494,7 +442,7 @@ objcl_object_get_meta_class (id obj)
 {
 #ifdef __NEXT_RUNTIME__
   /* FIXME: What to do here? */
-  return [[obj class] metaClass];
+  return objc_getMetaClass ([(NSStringFromClass ([obj class])) UTF8String]);
 #else
   if (objcl_object_is_class (obj))
     return class_get_meta_class (obj);