diff options
| -rw-r--r-- | Lisp/constant-data.lisp | 6 | ||||
| -rw-r--r-- | Lisp/defpackage.lisp | 2 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 20 | ||||
| -rw-r--r-- | Lisp/type-conversion.lisp | 10 |
4 files changed, 34 insertions, 4 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp index 575d46e..29169de 100644 --- a/Lisp/constant-data.lisp +++ b/Lisp/constant-data.lisp @@ -102,22 +102,28 @@ ;;;; (@* "Constant accessors") +(declaim (ftype (function (*) symbol) lisp-value->type-name)) (defun lisp-value->type-name (value) (car (rassoc-if #'(lambda (type) (typep value 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/defpackage.lisp b/Lisp/defpackage.lisp index 17ccf76..c6d65a0 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -26,3 +26,5 @@ ;; Metaclasses #:objective-c-class)) + +#-(or cmu sbcl) (declaim (declaration values)) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index a713c8e..bc84a44 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -87,6 +87,8 @@ objects or classes, let alone send messages to them. (selector obj-data)) +(declaim (ftype (function ((or string symbol)) (or null objc-class)) + find-objc-class-by-name)) (defun find-objc-class (class-name &optional errorp) "Retrieve an Objective C class by name. @@ -141,7 +143,7 @@ expect it to be converted to **uppercase** by default, which is the conventional case for namespace identifiers in Objective C." (let ((class - (typecase class-name + (etypecase class-name (string (find-objc-class-by-name class-name)) (symbol (find-objc-class-by-name (symbol->objc-class-name class-name)))))) @@ -151,6 +153,8 @@ conventional case for namespace identifiers in Objective C." nil)))) +(declaim (ftype (function (string) (or null objc-class)) + find-objc-class-by-name)) (defun find-objc-class-by-name (class-name) (with-foreign-objects ((obj-data (%objcl-find-class class-name))) (if (null-pointer-p (foreign-slot-value @@ -158,9 +162,11 @@ conventional case for namespace identifiers in Objective C." 'obj-data-union 'class-val)) nil - (obj-data->lisp obj-data)))) + (the objc-class (obj-data->lisp obj-data))))) +(declaim (ftype (function (string) (or null selector)) + find-selector-by-name)) (defun find-selector-by-name (selector-name) (with-foreign-objects ((obj-data (%objcl-find-selector selector-name))) (if (null-pointer-p (foreign-slot-value @@ -168,21 +174,25 @@ conventional case for namespace identifiers in Objective C." 'obj-data-union 'sel-val)) nil - (obj-data->lisp obj-data)))) + (the selector (obj-data->lisp obj-data))))) +(declaim (ftype (function (objc-class) 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)))) +(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)))) +(declaim (ftype (function ((or selector string list)) selector) + selector)) (defun selector (designator) "Convert an object into a selector. @@ -223,7 +233,7 @@ If *selector-designator* is a __selector__, it is simply returned. (selector '(:string-with-c-string :encoding)) ;=> #<SELECTOR `stringWithCString:encoding:'>" - (ctypecase designator + (etypecase designator (selector designator) (symbol (selector (list designator))) ((or string list) @@ -232,6 +242,8 @@ If *selector-designator* is a __selector__, it is simply returned. designator))))) +(declaim (ftype (function ((or selector string list)) (or null selector)) + find-selector)) (defun find-selector (selector-name) "Retrieve a method selector by name. diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp index 9e8e94f..858538b 100644 --- a/Lisp/type-conversion.lisp +++ b/Lisp/type-conversion.lisp @@ -2,6 +2,9 @@ ;;; (@* "Low-level Data Conversion") +(declaim (ftype (function (*) + (values foreign-pointer &rest nil)) + obj-data->lisp)) (defun lisp->obj-data (value) (let ((obj-data (foreign-alloc 'obj-data)) (type-name (lisp-value->type-name value))) @@ -20,6 +23,11 @@ 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 (foreign-string-to-lisp type))) @@ -59,6 +67,8 @@ bindings)))) +(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." |