Remove even more code that has become obsolete through the new version of INVOKE-BY-NAME.

darcs-hash:06fc98c5e106ac3fc0fd07ac5cc226ea431d265d

4 files changed, 1 insertions, 111 deletions

diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp
index 7922c4f..7d973b7 100644
--- a/Lisp/constant-data.lisp
+++ b/Lisp/constant-data.lisp
@@ -55,28 +55,6 @@
     (complex  . #\j)))
 
 
-(defparameter *objcl-data-map*
-  '((id       . id-val)
-    (class    . class-val)
-    (exc      . exc-val)
-    (sel      . sel-val)
-    (chr      . char-val)
-    (uchr     . char-val)
-    (sht      . short-val)
-    (usht     . short-val)
-    (int      . int-val)
-    (uint     . int-val)
-    (lng      . long-val)
-    (ulng     . long-val)
-    (lng-lng  . long-long-val)
-    (ulng-lng . long-long-val)
-    (flt      . float-val)
-    (dbl      . double-val)
-    (bool     . bool-val)
-    (ptr      . ptr-val)
-    (charptr  . charptr-val)))
-
-
 (defparameter *objcl-type-map*
   '((id       . id)
     (class    . objc-class)
@@ -97,6 +75,7 @@
     (ptr      . c-pointer)
     (charptr  . string)))
 
+
 (defparameter *objcl-c-type-map*
   '((id       . :pointer)
     (class    . :pointer)
@@ -125,26 +104,10 @@
                       (typep value type))
                   *objcl-type-map*)))
 
-(declaim (ftype (function (symbol) symbol) lisp-type->type-name))
-(defun lisp-type->type-name (lisp-type)
-  (cdr (rassoc lisp-type *objcl-type-map*)))
-
-(declaim (ftype (function (symbol) symbol) type-name->lisp-type))
-(defun type-name->lisp-type (type-name)
-  (cdr (assoc type-name *objcl-type-map*)))
-
-(declaim (ftype (function (symbol) symbol) type-name->slot-name))
-(defun type-name->slot-name (type-name)
-  (cdr (assoc type-name *objcl-data-map*)))
-
 (declaim (ftype (function (symbol) string) type-name->type-id))
 (defun type-name->type-id (type-name)
   (string (cdr (assoc type-name *objcl-api-type-names*))))
 
-(declaim (ftype (function (string) symbol) type-id->type-name))
-(defun type-id->type-name (type-id)
-  (car (rassoc (char type-id 0) *objcl-api-type-names*)))
-
 (declaim (ftype (function (symbol) symbol) type-name->c-type))
 (defun type-name->c-type (type-name)
   (cdr (assoc type-name *objcl-c-type-map*)))
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 7515d3a..11ac9fe 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -188,11 +188,3 @@ an __exception__, you can simply send it the `self' message.
   (pointer-eq (pointer-to obj1) (pointer-to obj2)))
 (defmethod objcl-eql (obj1 obj2)
   (eql obj1 obj2))
-
-
-(defun dealloc-obj-data (obj-data)
-  (with-foreign-slots ((type data) obj-data obj-data)
-    (when (and (pointerp type)
-               (not (null-pointer-p type)))
-      (foreign-string-free type)))
-  (foreign-free obj-data))
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 33bc460..aa9c436 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -374,61 +374,6 @@ If *selector-designator* is a __selector__, it is simply returned.
                 designator)))))
 
 
-(declaim (ftype (function (*)
-                          (values foreign-pointer &rest nil))
-                lisp->obj-data))
-(defun lisp->obj-data (value)
-  (let ((obj-data (foreign-alloc 'obj-data))
-        (type-name (lisp-value->type-name value)))
-    (with-foreign-slots ((type data) obj-data obj-data)
-      (setf (foreign-slot-value data
-                                'obj-data-union
-                                (type-name->slot-name type-name))
-            (typecase value
-              (symbol (selector value))
-              ((or id objc-class selector exception)
-               (pointer-to value))
-              (string (foreign-string-alloc value))
-              (otherwise value)))
-      (setf type
-            (foreign-string-alloc (type-name->type-id type-name))))
-    obj-data))
-
-
-(declaim (ftype (function (foreign-pointer)
-                          (values (or number string symbol selector id
-                                      objc-class boolean foreign-pointer)
-                                  &rest nil))
-                obj-data->lisp))
-(defun obj-data->lisp (obj-data)
-  (with-foreign-slots ((type data) obj-data obj-data)
-    (let* ((type-name (type-id->type-name (if (stringp type)
-                                              type
-                                              (foreign-string-to-lisp type))))
-           (lisp-type (type-name->lisp-type type-name))
-           (value     (if (eq 'void type-name)
-                          (values)
-                          (foreign-slot-value data
-                                              'obj-data-union
-                                              (type-name->slot-name type-name)))))
-      (case lisp-type
-        ((id objc-class selector exception)
-         (make-instance lisp-type :pointer value) )
-        ((string) (foreign-string-to-lisp value))
-        (otherwise value)))))
-
-
-(declaim (ftype (function (foreign-pointer) (values string &rest nil))
-                foreign-string-to-lisp/dealloc))
-(defun foreign-string-to-lisp/dealloc (foreign-string)
-  "Convert a (possibly freshly allocated) C string into a Lisp string
-and free the C string afterwards."
-
-  (unwind-protect
-       (foreign-string-to-lisp foreign-string)
-    (foreign-string-free foreign-string)))
-
-
 (defun parse-typespec (typestring &optional (start 0))
   "Parse a typestring like \"@0:4{_NSRange=II}8\" into something like (ID ()).
 
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index a2a21f2..94f1bb2 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -470,10 +470,6 @@ Returns: *result* --- the return value of the method invocation.
 
 
 ;;; (@* "Helper functions")
-(defun arglist->objc-arglist (arglist)
-  (arglist-intersperse-types (mapcar #'lisp->obj-data arglist)))
-
-
 (defun dealloc-objc-arglist (objc-arglist)
   (do ((objc-arglist objc-arglist (cddr objc-arglist)))
       ((null objc-arglist))
@@ -481,12 +477,6 @@ Returns: *result* --- the return value of the method invocation.
     (dealloc-obj-data (second objc-arglist))))
 
 
-(defun arglist-intersperse-types (arglist)
-  (mapcan #'(lambda (arg)
-              (list :pointer arg))
-          arglist))
-
-
 (defun constructor-name-p (method-name)
   (flet ((method-name-starts-with (prefix)
            (and (>= (length method-name) (length prefix))