From 11c857700e03ec0b758f729731784d0f46a6d55e Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Tue, 4 Mar 2008 12:36:06 +0100
Subject: Use INTERN-LISP-VALUE for argument conversion.

darcs-hash:2f57dd53bfa6b2aa44474232042d9578af720c22
---
 Lisp/lisp-value-wrapping.lisp | 14 ++++++++++++++
 Lisp/method-invocation.lisp   | 20 +++-----------------
 Lisp/tests.lisp               |  4 ++--
 Lisp/type-conversion.lisp     |  3 +--
 4 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/Lisp/lisp-value-wrapping.lisp b/Lisp/lisp-value-wrapping.lisp
index 8eda55c..85cf84a 100644
--- a/Lisp/lisp-value-wrapping.lisp
+++ b/Lisp/lisp-value-wrapping.lisp
@@ -39,6 +39,20 @@
   (:metaclass ns::+ns-object))
 
 
+(defcoercion id ((x list))
+  (intern-lisp-value x))
+
+(defcoercion id ((x string))
+  ;; FIXME: Implement INTERN-LISP-VALUE.
+  (primitive-invoke (find-objc-class 'ns-string)
+                    "stringWithUTF8String:"
+                    'id
+                    x))
+
+(defcoercion id ((x t))
+  (intern-lisp-value x))
+
+
 (defun intern-lisp-value (value)
   ;; We need this function in order to preserve object identity on the
   ;; Objective-C side.  As we want [(intern-lisp-value 10) self] to
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index bbbee68..50c3238 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -492,24 +492,10 @@ easier to use with __apply__.
                     'id
                     x))
 
-(defcoercion id ((x string))
-  (primitive-invoke (find-objc-class 'ns-string)
-                    "stringWithUTF8String:"
-                    'id
-                    x))
+(defcoercion id ((x null))
+  +nil+)
 
-(defcoercion id ((x list))
-  ;; Circular lists may cause this to hang.  So may lists that contain
-  ;; themselves, as well as lists that contain other data structures
-  ;; that contain themselves or this list, and so on.
-  (apply #'primitive-invoke
-         (find-objc-class 'ns-array)
-         "arrayWithObjects:"
-         'id
-         (append (mapcar #'(lambda (element)
-                             (coerce-object element 'id))
-                         x)
-                 (list +nil+))))
+;; (defcoercion id ((x {list, string, t})) ...): See lisp-value-wrapping.lisp.
 
 
 (defcoercion class ((x id))
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index ee45582..1034aee 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -429,7 +429,7 @@
                    ((x ,class-name)
                     (y :int)
                     z
-                    (a (eql t))
+                    (a (eql nil))
                     (b number)
                     &rest rest)
                  (declare (ignore z rest))
@@ -444,7 +444,7 @@
     (is (foreign-class-registered-p class))
 
     ;; Method calls.
-    (is (= 170 (invoke instance :foo 150 :bar nil :stuff t :do 100)))
+    (is (= 170 (invoke instance :foo 150 :bar nil :stuff nil :do 100)))
 
     ;; Object identity preservation.
     (is (eql instance
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
index 6eca43b..1350f5c 100644
--- a/Lisp/type-conversion.lisp
+++ b/Lisp/type-conversion.lisp
@@ -24,8 +24,7 @@
     (case (or (typespec-nominal-type typespec)
               (typespec-primary-type typespec))
       ((id objective-c-class exception selector)
-       (let ((*skip-retaining*
-              skip-retaining-p))
+       (let ((*skip-retaining* skip-retaining-p))
          (intern-pointer-wrapper (car typespec)
                                  :pointer (cffi:mem-ref foreign-value-cell
                                                         c-type))))
-- 
cgit v1.2.3