diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/constant-data.lisp | 44 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 34 | ||||
| -rw-r--r-- | Lisp/objcl.lisp | 1 | ||||
| -rw-r--r-- | Lisp/type-conversion.lisp | 35 |
4 files changed, 57 insertions, 57 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp index 3d424f5..eebe3e9 100644 --- a/Lisp/constant-data.lisp +++ b/Lisp/constant-data.lisp @@ -1,28 +1,6 @@ (in-package #:mulk.objective-cl) -;;;; (@* "Constant accessors") -(defun lisp-value->type-name (value) - (car (rassoc-if #'(lambda (type) - (typep value type)) - *objcl-type-map*))) - -(defun type-name->lisp-type (type-name) - (cdr (assoc type-name *objcl-type-map*))) - -(defun type-name->slot-name (type-name) - (cdr (assoc type-name *objcl-data-map*))) - -(defun type-name->type-id (type-name) - (string (cdr (assoc type-name *objcl-api-type-names*)))) - -(defun type-id->type-name (type-id) - (car (rassoc (char type-id 0) *objcl-api-type-names*))) - -(defun type-name->c-type (type-name) - (cdr (assoc type-name *objcl-c-type-map*))) - - ;;;; (@* "The constant data") ;;; Copied from objc-api.h ;;; Probably ought to be generated by C code at initialisation time. @@ -121,3 +99,25 @@ (bool . :boolean) (ptr . :pointer) (charptr . :pointer))) + + +;;;; (@* "Constant accessors") +(defun lisp-value->type-name (value) + (car (rassoc-if #'(lambda (type) + (typep value type)) + *objcl-type-map*))) + +(defun type-name->lisp-type (type-name) + (cdr (assoc type-name *objcl-type-map*))) + +(defun type-name->slot-name (type-name) + (cdr (assoc type-name *objcl-data-map*))) + +(defun type-name->type-id (type-name) + (string (cdr (assoc type-name *objcl-api-type-names*)))) + +(defun type-id->type-name (type-id) + (car (rassoc (char type-id 0) *objcl-api-type-names*))) + +(defun type-name->c-type (type-name) + (cdr (assoc type-name *objcl-c-type-map*))) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index ebd6fca..3cc927b 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -43,40 +43,6 @@ (dealloc-obj-data return-value)))) -;;; (@* "Data conversion") -(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 - ((or objc-id objc-class objc-selector objc-exception) - (pointer-to value)) - (string (foreign-string-alloc value)) - (otherwise value))) - (setf type - (foreign-string-alloc (type-name->type-id type-name)))) - obj-data)) - - -(defun obj-data->lisp (obj-data) - (with-foreign-slots ((type data) obj-data obj-data) - (let* ((type-name (type-id->type-name (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 - ((objc-id objc-class objc-selector objc-exception) - (make-instance lisp-type :pointer value)) - ((string) (foreign-string-to-lisp value)) - (otherwise value))))) - - ;;; (@* "Helper functions") (defun arglist-intersperse-types (arglist) (mapcan #'(lambda (arg) diff --git a/Lisp/objcl.lisp b/Lisp/objcl.lisp deleted file mode 100644 index ec9b2e0..0000000 --- a/Lisp/objcl.lisp +++ /dev/null @@ -1 +0,0 @@ -(in-package #:mulk.objective-cl) diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp new file mode 100644 index 0000000..6869ff9 --- /dev/null +++ b/Lisp/type-conversion.lisp @@ -0,0 +1,35 @@ +(in-package #:mulk.objective-cl) + + +;;; (@* "Data conversion") +(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 + ((or objc-id objc-class objc-selector objc-exception) + (pointer-to value)) + (string (foreign-string-alloc value)) + (otherwise value))) + (setf type + (foreign-string-alloc (type-name->type-id type-name)))) + obj-data)) + + +(defun obj-data->lisp (obj-data) + (with-foreign-slots ((type data) obj-data obj-data) + (let* ((type-name (type-id->type-name (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 + ((objc-id objc-class objc-selector objc-exception) + (make-instance lisp-type :pointer value)) + ((string) (foreign-string-to-lisp value)) + (otherwise value)))))
\ No newline at end of file |