Add a NAME slot to class SELECTOR.

darcs-hash:c51f1608afb05ec84f8f615114cb7f9f65abf8fe

4 files changed, 89 insertions, 43 deletions

diff --git a/JOURNAL b/JOURNAL
index 81398ef..926e9ce 100644
--- a/JOURNAL
+++ b/JOURNAL
@@ -3,7 +3,7 @@
 #title Objective-CL Development Diary
 #desc News from the Objective-CL lab
 
-; Time-stamp: <2008-03-18 18:00:52 mulk>
+; Time-stamp: <2008-03-19 03:07:26 mulk>
 ; 
 ; C-c i t	insert-time-stamp
 ; C-c C-t	muse-project-publish-this-file
@@ -18,6 +18,49 @@ Context: [[http://matthias.benkard.de/objective-cl][The Objective-CL Project]].
 ----
 
 
+* 2008-03-19, 03:03:50 CET
+
+** Optimising INVOKE
+
+The benchmark:
+
+<example>
+(let ((x (invoke (find-objc-class 'ns-method-signature)
+                 :method-signature-for-selector 'new)))
+  (time (dotimes (i 100000) (invoke x :get-argument-type-at-index 0))))
+</example>
+
+Before:
+
+<example>
+Evaluation took:
+  7.727 seconds of real time
+  7.136446 seconds of user run time
+  0.080005 seconds of system run time
+  [Run times include 0.288 seconds GC run time.]
+  0 calls to %EVAL
+  0 page faults and
+  218,448,224 bytes consed.
+</example>
+
+After:
+
+</example>
+Evaluation took:
+  5.868 seconds of real time
+  5.824364 seconds of user run time
+  0.032002 seconds of system run time
+  [Run times include 0.256 seconds GC run time.]
+  0 calls to %EVAL
+  0 page faults and
+  122,487,656 bytes consed.
+</example>
+
+What I did was add a **name** slot to class **selector** so that **selector-name**
+need only access a slot now instead of calling a foreign function and
+converting the returned value to a Lisp string.
+
+
 * 2008-03-18, 15:31:30 CET
 
 ** Profiling INVOKE
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 67dcb70..e2a5358 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -81,8 +81,46 @@
   t)
 
 
+(defgeneric selector-name (selector)
+  (:documentation "Find the name of a selector.
+
+## Arguments and Values:
+
+*selector* --- an **object** of **type** __selector__.
+
+Returns: *name* --- a **string**.
+
+
+## Description:
+
+__selector-name__ returns the name of *selector*.
+
+
+## Examples:
+
+    (selector-name (selector '(:string-with-c-string :encoding)))
+     ;=> \"stringWithCString:encoding:\"
+
+
+## Note:
+
+If *x* is an **object** of **type** __selector__:
+
+    (objc-equal x (find-selector (selector-name x)))  ;=> T
+
+If *name* is the name of an existing selector:
+
+    (equal name (selector-name (find-selector name)))  ;=> T
+
+
+## See Also:
+
+  __find-selector__, __selector__"))
+
+
 (defclass selector (c2mop:funcallable-standard-object c-pointer-wrapper)
-     ()
+     ((name :accessor selector-name
+            :type string))
   (:metaclass c2mop:funcallable-standard-class)
   (:documentation "An Objective-C method selector.
 
@@ -134,6 +172,8 @@ The following calls are all equivalent:
   ;; Therefore, we handle this in a somewhat different manner for CMUCL.
   ;; See SELECTOR-FUNCTION below.
   (declare (ignore slot-names initargs))
+  (setf (slot-value selector 'name)
+        (%objcl-selector-name (pointer-to selector)))
   (c2mop:set-funcallable-instance-function
    selector
    #-cmu #'(lambda (receiver &rest args)
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index dd0b3b0..39b1e2d 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -525,46 +525,6 @@ If *name* is the name of an existing class:
   (%objcl-class-name (pointer-to class)))
 
 
-#? selector -> string
-(defun selector-name (selector)
-  "Find the name of a selector.
-
-## Arguments and Values:
-
-*selector* --- an **object** of **type** __selector__.
-
-Returns: *name* --- a **string**.
-
-
-## Description:
-
-__selector-name__ returns the name of *selector*.
-
-
-## Examples:
-
-    (selector-name (selector '(:string-with-c-string :encoding)))
-     ;=> \"stringWithCString:encoding:\"
-
-
-## Note:
-
-If *x* is an **object** of **type** __selector__:
-
-    (objc-equal x (find-selector (selector-name x)))  ;=> T
-
-If *name* is the name of an existing selector:
-
-    (equal name (selector-name (find-selector name)))  ;=> T
-
-
-## See Also:
-
-  __find-selector__, __selector__"
-  (declare (type selector selector))
-  (%objcl-selector-name (pointer-to selector)))
-
-
 #? (or id objective-c-class exception) selector -> t
 (defun get-method-implementation (object selector)
   (declare (type selector selector))
@@ -771,6 +731,8 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
   (%objcl-object-is-meta-class (pointer obj)))
 
 (defun object-get-class (obj)
+  ;; OPTIMISE: Both find-objc-class-by-name and %objcl-class-name are
+  ;; slow and mostly unneeded.
   (find-objc-class-by-name
    (%objcl-class-name (%objcl-object-get-class (pointer obj)))))
 
diff --git a/objective-cl.asd b/objective-cl.asd
index 4e72ec0..64dcbfb 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -60,7 +60,8 @@
                  (:file "performance-hacks"  :depends-on ("defpackage"))
                  (:file "policy"             :depends-on ("defpackage"
                                                           "parameters"
-                                                          "libobjcl"))
+                                                          "libobjcl"
+                                                          "data-types"))
                  (:file "libobjcl"           :depends-on ("defpackage"
                                                           "internal-reader-syntax"
                                                           "constant-data"