diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/constant-data.lisp | 6 | ||||
| -rw-r--r-- | Lisp/data-types.lisp | 37 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 10 | ||||
| -rw-r--r-- | Lisp/memory-management.lisp | 6 | ||||
| -rw-r--r-- | Lisp/type-conversion.lisp | 4 |
5 files changed, 36 insertions, 27 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp index eebe3e9..575d46e 100644 --- a/Lisp/constant-data.lisp +++ b/Lisp/constant-data.lisp @@ -61,10 +61,10 @@ (defparameter *objcl-type-map* - '((id . objc-id) + '((id . id) (class . objc-class) - (sel . objc-selector) - (exc . objc-exception) + (sel . selector) + (exc . exception) (chr . character) (int . integer) (uint . integer) diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 7bb4d5f..6181a3b 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -45,12 +45,12 @@ :initform nil))) -(defclass objc-selector (c-pointer-wrapper) ()) -(defclass objc-id (c-pointer-wrapper) ()) -(defclass objc-class (c-pointer-wrapper) ()) +(defclass selector (c-pointer-wrapper) ()) +(defclass id (c-pointer-wrapper) ()) +(defclass objc-class (c-pointer-wrapper) ()) -(define-condition objc-exception (error) +(define-condition exception (error) ((pointer :type c-pointer :accessor pointer-to :initarg :pointer)) @@ -81,21 +81,30 @@ (foreign-free obj-data)) -(defmethod print-object ((object objc-id) stream) +(defmethod print-object ((object id) stream) (print-unreadable-object (object stream) (format stream "~A `~A' {~X}" - (objcl-class-name - (invoke-by-name object "class")) - (invoke-by-name - (invoke-by-name object "description") - "UTF8String") + (objcl-class-name (invoke-by-name object "class")) + (invoke-by-name (invoke-by-name object "description") + "UTF8String") (invoke-by-name object "hash")))) -(defmethod print-object ((object objc-class) stream) - (print-unreadable-object (object stream) - (format stream "OBJC-CLASS ~A" - (objcl-class-name object)))) +(defmethod print-object ((class objc-class) stream) + (print-unreadable-object (class stream) + (format stream "~S ~A {~X}" + 'objc-class + (objcl-class-name class) + (invoke-by-name class "hash")))) + + +(defmethod print-object ((exception exception) stream) + (print-unreadable-object (exception stream) + (format stream "~S ~A {~X}" + 'exception + (invoke-by-name (invoke-by-name exception "name") + "UTF8String") + (invoke-by-name exception "hash")))) ;;;; (@* "Convenience types") diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 12a880c..e4b64f0 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -170,20 +170,20 @@ conventional case for namespace identifiers in Objective C." (defun objcl-class-name (class) - (declare (type (or objc-class objc-id objc-exception) class)) + (declare (type (or objc-class id exception) class)) (let ((obj-data (foreign-alloc 'obj-data))) (with-foreign-slots ((type data) obj-data obj-data) (setf (foreign-slot-value data 'obj-data-union (etypecase class (objc-class 'class-val) - (objc-id 'id-val) - (objc-exception 'exc-val))) + (id 'id-val) + (exception 'exc-val))) (pointer-to class)) (setf type (foreign-string-alloc (etypecase class (objc-class "#") - (objc-id "@") - (objc-exception "E"))))) + (id "@") + (exception "E"))))) (prog1 (%objcl-class-name obj-data) (dealloc-obj-data obj-data)))) diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp index 8331932..1a3055b 100644 --- a/Lisp/memory-management.lisp +++ b/Lisp/memory-management.lisp @@ -11,16 +11,16 @@ ;; (i.e. those whose name starts with `alloc' or `new'). Upon ;; Lisp-side finalization of an object, wie `release' it. (eval-when (:load-toplevel) - (dolist (type '(objc-id objc-class objc-exception)) + (dolist (type '(id objc-class exception)) (funcall (compile nil `(lambda () (defmethod make-instance ((class (eql ',type)) &rest initargs &key) (let* ((hash-table ,(ecase type - ((objc-id) '*id-objects*) + ((id) '*id-objects*) ((objc-class) '*class-objects*) - ((objc-exception) '*exception-objects*))) + ((exception) '*exception-objects*))) (hash-key (pointer-address (getf initargs :pointer))) (obj (weak-gethash hash-key hash-table nil))) (typecase obj diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp index 6869ff9..8839b3b 100644 --- a/Lisp/type-conversion.lisp +++ b/Lisp/type-conversion.lisp @@ -10,7 +10,7 @@ 'obj-data-union (type-name->slot-name type-name)) (typecase value - ((or objc-id objc-class objc-selector objc-exception) + ((or id objc-class selector exception) (pointer-to value)) (string (foreign-string-alloc value)) (otherwise value))) @@ -29,7 +29,7 @@ 'obj-data-union (type-name->slot-name type-name))))) (case lisp-type - ((objc-id objc-class objc-selector objc-exception) + ((id objc-class selector exception) (make-instance lisp-type :pointer value)) ((string) (foreign-string-to-lisp value)) (otherwise value)))))
\ No newline at end of file |