Code reorganisation.

darcs-hash:be8c8af8504b2ce63cde33a893542d3590abd703

1 files changed, 141 insertions, 0 deletions

diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 17c7cf3..83b062e 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -175,3 +175,144 @@ Returns: *result* --- the return value of the method invocation.
                              (not (lower-case-p (char method-name (length prefix))))))))))
     (or (method-name-starts-with "alloc")
         (method-name-starts-with "new"))))
+
+
+;;; (@* "High-level Data Conversion")
+(defgeneric ->id (x))
+(defgeneric ->class (x))
+(defgeneric ->integer (x))
+(defgeneric ->selector (x))
+(defgeneric ->exception (x))
+(defgeneric ->character (x))
+(defgeneric ->float (x))
+(defgeneric ->double (x))
+(defgeneric ->bool (x))
+(defgeneric ->string (x))
+(defgeneric ->pointer (x))
+
+
+(defmethod ->id ((x id))
+  x)
+
+(defmethod ->id ((x class))
+  (invoke x 'self))
+
+(defmethod ->id ((x exception))
+  (invoke x 'self))
+
+(defmethod ->id ((x integer))
+  (let ((id (invoke (find-class 'ns-number)
+                    :number-with-long x)))
+    (invoke id 'retain)
+    (invoke id 'autorelease)
+    id))
+
+(defmethod ->id ((x float))
+  (let ((id (invoke (find-class 'ns-number)
+                    :number-with-double x)))
+    (invoke id 'retain)
+    (invoke id 'autorelease)
+    id))
+
+(defmethod ->id ((x string))
+  (let ((id (invoke (find-class 'ns-string)
+                    :string-with-c-string x)))
+    (invoke id 'retain)
+    (invoke id 'autorelease)
+    id))
+
+
+(defmethod ->class ((x id))
+  (invoke x 'class))
+
+(defmethod ->class ((x exception))
+  (invoke x 'class))
+
+(defmethod ->class ((x class))
+  x)
+
+(defmethod ->class ((x string))
+  (find-objc-class x t))
+
+(defmethod ->class ((x symbol))
+  (find-objc-class x t))
+
+
+(defmethod ->integer ((x id))
+  (assert (objc-typep x 'ns-number))
+  (invoke x 'long-value))
+
+(defmethod ->integer ((x number))
+  (truncate x))
+
+(defmethod ->integer ((x null))
+  0)
+
+(defmethod ->integer ((x symbol))
+  (assert (eq 't x))
+  1)
+
+
+(defmethod ->selector ((x selector))
+  x)
+
+(defmethod ->selector ((x symbol))
+  (selector x))
+
+(defmethod ->selector ((x string))
+  (selector x))
+
+(defmethod ->selector ((x cons))
+  (selector x))
+
+
+(defmethod ->exception ((x exception))
+  x)
+
+
+(defmethod ->character ((x character))
+  x)
+
+(defmethod ->character ((x integer))
+  x)
+
+
+(defmethod ->float ((x number))
+  (float x))
+
+
+(defmethod ->double ((x number))
+  (float x))
+
+
+(defmethod ->bool ((x null))
+  x)
+
+(defmethod ->bool ((x symbol))
+  (assert (eq 't x))
+  x)
+
+(defmethod ->bool ((x integer))
+  x)
+
+
+(defmethod ->string ((x string))
+  x)
+
+(defmethod ->string ((x foreign-pointer))
+  (check-type x foreign-pointer)
+  x)
+
+
+(defmethod ->pointer ((x foreign-pointer))
+  (check-type x foreign-pointer)
+  x)
+
+(defmethod ->pointer ((x exception))
+  (pointer-to x))
+
+(defmethod ->pointer ((x c-pointer-wrapper))
+  (pointer-to x))
+
+(defmethod ->pointer ((x number))
+  (pointer-to (->id x)))