summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-08-14 16:03:51 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-08-14 16:03:51 +0200
commitf9408631aa030926fad625ecf4d18f08b478fc1d (patch)
tree3b7662585b47e60873c6b165c82fd20dfd560dd5 /Lisp
parent6895fb365446fb98b76e2f94d27afa0a7fa18133 (diff)
Add some type declarations to improve type safety.
darcs-hash:80f199b54225eed3b79fb36bbd49a0745e9033af
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/constant-data.lisp6
-rw-r--r--Lisp/defpackage.lisp2
-rw-r--r--Lisp/libobjcl.lisp20
-rw-r--r--Lisp/type-conversion.lisp10
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."