diff options
| -rw-r--r-- | Lisp/constant-data.lisp | 39 | ||||
| -rw-r--r-- | Lisp/data-types.lisp | 8 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 55 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 10 |
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)) |