From 9794d705ec9b8835213fca1fe811f95aa9792ef2 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Mon, 3 Mar 2008 01:37:34 +0100 Subject: Add Lisp value wrapper classes MLKLispString, MLKLispArray, and MLKLispList. darcs-hash:3dc87ce841df388836310ebc486b20c7214d68e4 --- Lisp/lisp-value-wrapping.lisp | 58 ++++++++++++++++++++++++++++++++++++++++--- objective-cl.asd | 3 ++- 2 files changed, 56 insertions(+), 5 deletions(-) diff --git a/Lisp/lisp-value-wrapping.lisp b/Lisp/lisp-value-wrapping.lisp index cf8e63c..cfe1603 100644 --- a/Lisp/lisp-value-wrapping.lisp +++ b/Lisp/lisp-value-wrapping.lisp @@ -19,19 +19,69 @@ (eval-when (:compile-toplevel :load-toplevel :execute) - (find-objc-class "NSObject" t)) + (find-objc-class "NSObject" t) + (find-objc-class "NSString" t) + (find-objc-class "NSArray" t) + (find-objc-class "NSDictionary" t)) -(defclass ns::mlk-lisp-value (ns::ns-object) +(defclass lisp-value-wrapper-mixin () ((lisp-value :initarg :value :initform nil - :accessor lisp-value)) + :accessor lisp-value))) + + +;; May usefully override, among others: +;; - description +(defclass ns::mlk-lisp-value (ns::ns-object lisp-value-wrapper-mixin) + () + #+(or) (:default-constructor new) (:metaclass ns::+ns-object)) (defun make-lisp-value (value) ;; FIXME: The following won't work. Make MAKE-INSTANCE more useful... ;(make-instance 'ns::mlk-lisp-value :value value) - (let ((instance (invoke (find-class 'ns::mlk-lisp-value) 'new))) + (let ((instance (invoke (typecase value + (string (find-class 'ns::mlk-lisp-string)) + (vector (find-class 'ns::mlk-lisp-array)) + (list (find-class 'ns::mlk-lisp-list)) + (t (find-class 'ns::mlk-lisp-value))) + 'new))) (setf (lisp-value instance) value) instance)) + + +;; Must override: +;; - characterAtIndex: +;; - length +;; +;; May usefully override, among others: +;; - substringWithRange: (maybe) +;; - getCharacters:range: (for performance reasons) +;; - description +(defclass ns::mlk-lisp-string (ns::ns-string lisp-value-wrapper-mixin) + () + (:metaclass ns::+ns-object)) + + +;; Must override: +;; - objectAtIndex: +;; - count +;; +;; May usefully override, among others: +;; - description +(defclass ns::mlk-lisp-array (ns::ns-array lisp-value-wrapper-mixin) + () + (:metaclass ns::+ns-object)) + + +;; Must override: +;; - objectAtIndex: +;; - count +;; +;; May usefully override, among others: +;; - description +(defclass ns::mlk-lisp-list (ns::ns-array lisp-value-wrapper-mixin) + () + (:metaclass ns::+ns-object)) diff --git a/objective-cl.asd b/objective-cl.asd index efe3c91..2a0520c 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -96,7 +96,8 @@ (:file "lisp-value-wrapping" :depends-on ("defpackage" "libobjcl" "init" - "class-definition")) + "class-definition" + "method-invocation")) (:file "post-init" :depends-on ("defpackage" "libobjcl" "init" -- cgit v1.2.3