diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/data-types.lisp | 16 | ||||
| -rw-r--r-- | Lisp/defpackage.lisp | 9 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 68 | ||||
| -rw-r--r-- | Lisp/memory-management.lisp | 7 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 15 | ||||
| -rw-r--r-- | Lisp/parameters.lisp | 6 | ||||
| -rw-r--r-- | Lisp/reader-syntax.lisp | 6 |
7 files changed, 104 insertions, 23 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 707c494..847b599 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -54,11 +54,11 @@ "The Objective C runtime has issued an exception of ~ type `~A'.~&~ Reason: ~A." - (objcl-invoke-class-method - (objcl-invoke-class-method condition "name") + (invoke-by-name + (invoke-by-name condition "name") "UTF8String") - (objcl-invoke-class-method - (objcl-invoke-class-method condition "reason") + (invoke-by-name + (invoke-by-name condition "reason") "UTF8String"))))) @@ -79,11 +79,11 @@ (print-unreadable-object (object stream) (format stream "~A `~A' {~X}" (objcl-class-name - (objcl-invoke-class-method object "class")) - (objcl-invoke-class-method - (objcl-invoke-class-method object "description") + (invoke-by-name object "class")) + (invoke-by-name + (invoke-by-name object "description") "UTF8String") - (objcl-invoke-class-method object "hash")))) + (invoke-by-name object "hash")))) (defmethod print-object ((object objc-class) stream) diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index ee40d1c..3047087 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -1,3 +1,10 @@ (defpackage #:mulk.objective-cl (:nicknames #:objcl) - (:use #:cl #:cffi)) + (:use #:cl #:cffi #:split-sequence) + (:export #:initialise-runtime + #:shutdown-runtime + #:install-reader-syntax + #:invoke-by-name + #:invoke + #:find-objc-class + #:*trace-method-calls*)) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index d735773..a7171b4 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -7,8 +7,10 @@ (use-foreign-library libobjcl) -(defcfun "objcl_initialise_runtime" :void) -(defcfun "objcl_shutdown_runtime" :void) +(defcfun ("objcl_initialise_runtime" initialise-runtime) :void) + +(defcfun ("objcl_shutdown_runtime" shutdown-runtime) :void) + (defcfun ("objcl_invoke_instance_method" %objcl-invoke-instance-method) obj-data (receiver obj-data) @@ -30,7 +32,67 @@ (class obj-data)) -(defun objcl-find-class (class-name) +(defun symbol->objc-class-name (symbol) + (let ((components (split-sequence #\- (symbol-name symbol) + :remove-empty-subseqs t))) + (reduce #'(lambda (x y) (concatenate 'string x y)) + (mapcar #'(lambda (x) + (concatenate 'string + (string (char x 0)) + (string-downcase (subseq x 1)))) + (subseq components 1)) + :initial-value (concatenate 'string + (string (char (first components) 0)) + (string-upcase + (subseq (first components) 1)))))) + + +(defun find-objc-class (class-name) + "Retrieve an Objective C class by name. + +CLASS-NAME: a symbol or a string. + +Returns: an OBJC-CLASS object representing the class whose name is +CLASS-NAME. + + +If CLASS-NAME is a symbol which does not contain a hyphen, its symbol +name is converted to lower case except for the first letter, which is +left intact, and the resulting string used as if directly given as an +argument to FIND-OBJC-CLASS. + +If CLASS-NAME is a symbol which containts a hyphen, its symbol name is +split into components seperated by hyphens and each component is +converted into a string according to the following rules: + + 1. The first component is fully converted to upper case except for its + first letter, which is left intact. + + 2. Any additional components have all of their letters converted to + lower case, except for their first letters, which are left intact. + +After this, the components are concatenated in order and the resulting +string used as if directly given as an argument to FIND-OBJC-CLASS. + +Examples: + + (find-objc-class \"NSObject\") ;=> #<OBJC-CLASS NSObject> + (find-objc-class 'ns-object) ;=> #<OBJC-CLASS NSObject> + (find-objc-class 'nsobject) ;=> NIL + +Rationale: + +The first component of an Objective C class name is conventionally +thought of as a namespace identifier. It is therefore sensible to +expect it to be converted to upper case by default, which is the +conventional case for namespace identifiers in Objective C." + + (typecase class-name + (string (find-objc-class-by-name class-name)) + (symbol (find-objc-class-by-name (symbol->objc-class-name class-name))))) + + +(defun find-objc-class-by-name (class-name) (let ((obj-data (%objcl-find-class class-name))) (prog1 (if (null-pointer-p (foreign-slot-value diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp index 1c540fb..600e079 100644 --- a/Lisp/memory-management.lisp +++ b/Lisp/memory-management.lisp @@ -1,9 +1,6 @@ (in-package #:mulk.objective-cl) -(defvar *skip-finalization* nil) -(defvar *skip-retaining* nil) - (defvar *id-objects* (make-weak-value-hash-table)) (defvar *class-objects* (make-weak-value-hash-table)) (defvar *exception-objects* (make-weak-value-hash-table)) @@ -63,7 +60,7 @@ :incomplete) (let ((new-obj (call-next-method))) (unless *skip-retaining* - (objcl-invoke-class-method new-obj "retain")) + (invoke-by-name new-obj "retain")) (unless *skip-finalization* ;; We only put the new object into the hash ;; table if it is a regular wrapper object @@ -89,7 +86,7 @@ (*skip-retaining* t)) (make-instance saved-type :pointer saved-pointer)))) - (objcl-invoke-class-method temp "release")))) + (invoke-by-name temp "release")))) (trivial-garbage:finalize new-obj #'finalizer)))) new-obj)) (t obj)))) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 3cc927b..63f3e24 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -2,7 +2,15 @@ ;;; (@* "Method invocation") -(defun objcl-invoke-class-method (receiver method-name &rest args) +(defun invoke (receiver message-start &rest message-components) + "FIXME" + (flet ((message-component->string (component) + ())) + (do ((message-string ()))))) + + +(defun invoke-by-name (receiver method-name &rest args) + "FIXME" (let* ((arglist (arglist-intersperse-types (mapcar #'lisp->obj-data args))) (return-value (apply-macro '%objcl-invoke-class-method @@ -10,7 +18,8 @@ method-name (length args) arglist))) - (format t "~&Invoking [~A].~%" method-name) + (when *trace-method-calls* + (format t "~&Invoking [~A].~%" method-name)) (unwind-protect (let ((value (let ((*skip-retaining* (or *skip-retaining* @@ -23,7 +32,7 @@ #+nil -(defun objcl-invoke-class-method (receiver method-name &rest args) +(defun invoke-instance-method-by-name (receiver method-name &rest args) (let* ((arglist (arglist-intersperse-types (mapcar #'lisp->obj-data args))) (return-value (apply-macro '%objcl-invoke-instance-method diff --git a/Lisp/parameters.lisp b/Lisp/parameters.lisp new file mode 100644 index 0000000..2cb5a6d --- /dev/null +++ b/Lisp/parameters.lisp @@ -0,0 +1,6 @@ +(in-package #:mulk.objective-cl) + + +(defvar *skip-finalization* nil) +(defvar *skip-retaining* nil) +(defvar *trace-method-calls* nil) diff --git a/Lisp/reader-syntax.lisp b/Lisp/reader-syntax.lisp index 4a1491f..3ca143b 100644 --- a/Lisp/reader-syntax.lisp +++ b/Lisp/reader-syntax.lisp @@ -28,7 +28,7 @@ (let ((*readtable* (copy-readtable))) (setf class-method-p t) (setf (readtable-case *readtable*) :preserve) - `(objcl-find-class + `(find-objc-class ,(symbol-name (read stream t nil t)))) ;; Something else. (read stream t nil t))) @@ -49,9 +49,9 @@ (assert (char= #\] (read-char))) (setf args (nreverse args)) `(,(if class-method-p - 'objcl-invoke-class-method + 'invoke-by-name #+nil 'objcl-invoke-instance-method - #-nil 'objcl-invoke-class-method) + #-nil 'invoke-by-name) ,receiver ,(make-array (list (length message)) :element-type 'character |