diff options
Diffstat (limited to 'Lisp/method-invocation.lisp')
-rw-r--r-- | Lisp/method-invocation.lisp | 141 |
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))) |