summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Lisp/method-definition.lisp7
-rw-r--r--Lisp/method-invocation.lisp143
-rw-r--r--Lisp/type-conversion-policy.lisp191
-rw-r--r--Lisp/type-conversion.lisp6
-rw-r--r--Objective-C/libobjcl.m2
-rw-r--r--objective-cl.asd7
6 files changed, 209 insertions, 147 deletions
diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp
index cd32600..7218f48 100644
--- a/Lisp/method-definition.lisp
+++ b/Lisp/method-definition.lisp
@@ -404,13 +404,12 @@ __define-objective-c-generic-function__.
,@arguments))
(format t "~&~A" (list ,@arg-symbols)))
(unwind-protect
- (,(case (typespec-primary-type return-type)
- ((:id :class :selector) 'pointer)
- (t 'progn))
+ (coerce-object
(,(generic-function-name gf)
;; Leave the second argument (the
;; selector) out.
- ,@(list* (car arguments) (cddr arguments))))
+ ,@(list* (car arguments) (cddr arguments)))
+ ',return-type)
;; FIXME: We may want to wrap signalled
;; SERIOUS-CONDITIONS in some kind of
;; Objective-C exception object and put
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index ab520df..66f7368 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -425,7 +425,7 @@ easier to use with __apply__.
;; detailed method signature type information,
;; it's the best we can do.
(setf (argref arg-c-type i)
- (pointer-to (coerce-object arg 'id))))
+ (pointer-to (coerce-object arg :id))))
(t (setf (argref arg-c-type i)
(case arg
;; Do the right thing for booleans.
@@ -481,144 +481,3 @@ easier to use with __apply__.
(>= mismatch (length prefix))))))
(or (method-name-starts-with "alloc")
(method-name-starts-with "new"))))
-
-
-;;; (@* "High-level Data Conversion")
-(defgeneric coerce-object (object type))
-
-
-(defcoercion id ((x id))
- x)
-
-(defcoercion id ((x objective-c-class))
- x)
-
-(defcoercion id ((x exception))
- x)
-
-(defcoercion id ((x integer))
- (primitive-invoke (find-objc-class 'ns-number)
- "numberWithInt:"
- 'id
- x))
-
-(defcoercion id ((x float))
- (primitive-invoke (find-objc-class 'ns-number)
- (etypecase x
- (long-float "numberWithDouble:")
- (double-float "numberWithDouble:")
- (short-float "numberWithFloat:")
- (single-float "numberWithFloat:"))
- 'id
- x))
-
-(defcoercion id ((x null))
- +nil+)
-
-;; (defcoercion id ((x {list, string, t})) ...): See lisp-value-wrapping.lisp.
-
-
-(defcoercion class ((x id))
- (object-get-class x))
-
-(defcoercion class ((x exception))
- (object-get-class x))
-
-(defcoercion class ((x objective-c-class))
- x)
-
-(defcoercion class ((x string))
- (find-objc-class x t))
-
-(defcoercion class ((x symbol))
- (find-objc-class x t))
-
-
-(defcoercion integer ((x integer))
- x)
-
-(defcoercion integer ((x id))
- (assert (objc-typep x 'ns-number))
- (invoke x 'int-value))
-
-(defcoercion integer ((x number))
- (truncate x))
-
-(defcoercion integer ((x null))
- (declare (ignore x))
- +no+)
-
-(defcoercion integer (x)
- (declare (ignore x))
- +yes+)
-
-
-(defcoercion selector ((x selector))
- x)
-
-(defcoercion selector ((x symbol))
- (selector x))
-
-(defcoercion selector ((x string))
- (selector x))
-
-(defcoercion selector ((x cons))
- (selector x))
-
-
-(defcoercion exception ((x exception))
- x)
-
-
-(defcoercion character ((x character))
- x)
-
-(defcoercion character ((x integer))
- x)
-
-
-(defcoercion float ((x number))
- (float x))
-
-
-(defcoercion double ((x number))
- (float x))
-
-
-;; Note that this refers to the Objective-C BOOL type, not the Lisp
-;; BOOLEAN type.
-(defcoercion bool ((x null))
- (declare (ignore x))
- +no+)
-
-(defcoercion bool (x)
- (declare (ignore x))
- +yes+)
-
-
-;; Note that this refers to the Lisp BOOLEAN type, not the Objective-C
-;; BOOL type.
-(defcoercion boolean ((x number))
- (not (zerop x)))
-
-
-(defcoercion string ((x string))
- x)
-
-(defcoercion string ((x foreign-pointer))
- (check-type x foreign-pointer)
- x)
-
-
-(defcoercion pointer ((x foreign-pointer))
- (check-type x foreign-pointer)
- x)
-
-(defcoercion pointer ((x exception))
- (pointer-to x))
-
-(defcoercion pointer ((x c-pointer-wrapper))
- (pointer-to x))
-
-(defcoercion pointer ((x number))
- (pointer-to (coerce-object x 'id)))
diff --git a/Lisp/type-conversion-policy.lisp b/Lisp/type-conversion-policy.lisp
new file mode 100644
index 0000000..ba1ae34
--- /dev/null
+++ b/Lisp/type-conversion-policy.lisp
@@ -0,0 +1,191 @@
+;;;; Objective-CL, an Objective-C bridge for Common Lisp.
+;;;; Copyright (C) 2007, 2008 Matthias Andreas Benkard.
+;;;;
+;;;; This program is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public License
+;;;; as published by the Free Software Foundation, either version 3 of
+;;;; the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful, but
+;;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this program. If not, see
+;;;; <http://www.gnu.org/licenses/>.
+
+(in-package #:mulk.objective-cl)
+
+
+(defmethod coerce-object (object (type list))
+ (coerce-object object (typespec-primary-type type)))
+
+
+(defcoercion :int (x)
+ (coerce-object x 'integer))
+
+(defcoercion :short (x)
+ (coerce-object x 'integer))
+
+(defcoercion :long (x)
+ (coerce-object x 'integer))
+
+(defcoercion :long-long (x)
+ (coerce-object x 'integer))
+
+(defcoercion :char (x)
+ (coerce-object x 'integer))
+
+(defcoercion :unsigned (x)
+ (coerce-object x 'integer))
+
+(defcoercion :unsigned-long (x)
+ (coerce-object x 'integer))
+
+(defcoercion :unsigned-long-long (x)
+ (coerce-object x 'integer))
+
+(defcoercion :unsigned-char (x)
+ (coerce-object x 'integer))
+
+
+
+(defcoercion :id ((x id))
+ x)
+
+(defcoercion :id ((x objective-c-class))
+ x)
+
+(defcoercion :id ((x exception))
+ x)
+
+(defcoercion :id ((x integer))
+ (primitive-invoke (find-objc-class 'ns-number)
+ "numberWithInt:"
+ 'id
+ x))
+
+(defcoercion :id ((x float))
+ (primitive-invoke (find-objc-class 'ns-number)
+ (etypecase x
+ (long-float "numberWithDouble:")
+ (double-float "numberWithDouble:")
+ (short-float "numberWithFloat:")
+ (single-float "numberWithFloat:"))
+ 'id
+ x))
+
+(defcoercion :id ((x null))
+ +nil+)
+
+;; (defcoercion id ((x {list, string, t})) ...): See lisp-value-wrapping.lisp.
+
+
+(defcoercion :class ((x id))
+ (object-get-class x))
+
+(defcoercion :class ((x exception))
+ (object-get-class x))
+
+(defcoercion :class ((x objective-c-class))
+ x)
+
+(defcoercion :class ((x string))
+ (find-objc-class x t))
+
+(defcoercion :class ((x symbol))
+ (find-objc-class x t))
+
+
+(defcoercion integer ((x integer))
+ x)
+
+(defcoercion integer ((x id))
+ (assert (objc-typep x 'ns-number))
+ (invoke x 'int-value))
+
+(defcoercion integer ((x number))
+ (truncate x))
+
+(defcoercion integer ((x null))
+ (declare (ignore x))
+ +no+)
+
+(defcoercion integer (x)
+ (declare (ignore x))
+ +yes+)
+
+
+(defcoercion :selector ((x selector))
+ x)
+
+(defcoercion :selector ((x symbol))
+ (selector x))
+
+(defcoercion :selector ((x string))
+ (selector x))
+
+(defcoercion :selector ((x cons))
+ (selector x))
+
+
+(defcoercion :exception ((x exception))
+ x)
+
+
+(defcoercion :char ((x null))
+ 0)
+
+(defcoercion :char ((x character))
+ x)
+
+(defcoercion :char ((x integer))
+ x)
+
+
+(defcoercion :float ((x number))
+ (float x))
+
+
+(defcoercion :double ((x number))
+ (float x))
+
+
+;; Note that this refers to the Objective-C BOOL type, not the Lisp
+;; BOOLEAN type.
+(defcoercion :boolean ((x null))
+ (declare (ignore x))
+ +no+)
+
+(defcoercion :boolean (x)
+ (declare (ignore x))
+ +yes+)
+
+
+;; Note that this refers to the Lisp BOOLEAN type, not the Objective-C
+;; BOOL type.
+(defcoercion boolean ((x number))
+ (not (zerop x)))
+
+
+(defcoercion :string ((x string))
+ x)
+
+(defcoercion :string ((x foreign-pointer))
+ (check-type x foreign-pointer)
+ x)
+
+
+(defcoercion :pointer ((x foreign-pointer))
+ (check-type x foreign-pointer)
+ x)
+
+(defcoercion :pointer ((x exception))
+ (pointer-to x))
+
+(defcoercion :pointer ((x c-pointer-wrapper))
+ (pointer-to x))
+
+(defcoercion :pointer ((x number))
+ (pointer-to (coerce-object x 'id)))
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
index df9b0e0..eac3687 100644
--- a/Lisp/type-conversion.lisp
+++ b/Lisp/type-conversion.lisp
@@ -40,3 +40,9 @@
(make-struct-wrapper foreign-value-cell typespec t))
((:void) (values))
(otherwise (cffi:mem-ref foreign-value-cell c-type)))))
+
+
+;; COERCE-OBJECT is the high-level facility that other parts of
+;; Objective-CL may rely on for their conversion needs. Its methods
+;; are implemented in type-conversion-policy.lisp.
+(defgeneric coerce-object (object type))
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index 54684bf..06620e2 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -386,7 +386,7 @@ objcl_get_method_implementation (id object,
Class target_class;
/* struct objc_super super_struct;
super_struct.receiver = object;
- super_struct.super_class = superclass_for_send_super;
+ super_struct.class = superclass_for_send_super;
*/
if (objcl_object_is_class (object))
diff --git a/objective-cl.asd b/objective-cl.asd
index e28e90a..82d1731 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -57,6 +57,13 @@
"type-handling"
"policy"
"data-types"))
+ (:file "type-conversion-policy" :depends-on ("defpackage"
+ "memory-management"
+ "data-types"
+ "type-handling"
+ "policy"
+ "data-types"
+ "method-invocation"))
(:file "type-handling" :depends-on ("defpackage"
"libobjcl"
"init"))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 17:21:24 +0000