diff options
| -rw-r--r-- | JOURNAL | 31 | ||||
| -rw-r--r-- | Lisp/compiler-macros.lisp | 12 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 118 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 3 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 25 |
5 files changed, 170 insertions, 19 deletions
@@ -1,5 +1,36 @@ -*- mode: muse -*- +* 2007-10-10, 12:02:38 CEST + +I've cleaned the Objective-C code up by making the NeXT and GNU +runtime-specific code converge a bit. This also makes FIND-SELECTOR +return NIL for unknown selectors on the NeXT runtime, so compile-time +warnings about unknown methods are possible there now. The latter +relies on sel_isMapped, whose semantics are not entirely clear to me. +On the one hand, Apple's reference manual states: “You can use this +function to determine whether a given address is a valid selector,” +which I interpret as meaning that it takes a selector pointer as an +argument, not a string. On the other hand, in the preceding section, +the same document states: “You can still use the sel_isMapped function +to determine whether a method name is mapped to a selector.” + +So if I have two strings that aren't the same under POINTER-EQ, but that +both name the same valid selector that is registered with the runtime, +like "self", say, does sel_isMapped work reliably in this case? I'm not +sure. + +On another note, I wonder what the difference between +sel_get_uid/sel_getUid and sel_register_name/sel_registerName might be. +They seem to do the same thing. + +Maybe this whole #ifdef mess isn't even strictly necessary, anyway. I +could just copy objc-gnu2next.h from the GNUstep project (LGPLv3, so the +licensing is fine). + +http://svn.gna.org/svn/gnustep/libs/base/trunk/Headers/Additions/GNUstepBase/objc-gnu2next.h + + + * 2007-10-04, 17:27:02 CEST ** `char' Does Actually Indicate a Char, Sometimes diff --git a/Lisp/compiler-macros.lisp b/Lisp/compiler-macros.lisp index 97aecb7..3ffba63 100644 --- a/Lisp/compiler-macros.lisp +++ b/Lisp/compiler-macros.lisp @@ -28,7 +28,7 @@ (eq 'load-time-value (car method-name))))) `(primitive-invoke ,receiver (load-time-value (handler-case - (selector ,method-name) + (find-selector ,method-name t) (serious-condition () (warn (make-condition @@ -52,7 +52,7 @@ `(invoke-by-name ,receiver (load-time-value (handler-case - (selector ,method-name) + (find-selector ,method-name t) (serious-condition () (warn (make-condition 'simple-style-warning @@ -70,11 +70,15 @@ ;; ones. (define-compiler-macro invoke (receiver message-start &rest message-components) (multiple-value-bind (method-name args) - (split-method-call message-start message-components) + (split-method-call (if (and (consp message-start) + (eq (first message-start) 'quote)) + (second message-start) + message-start) + message-components) `(invoke-by-name ,receiver (load-time-value (handler-case - (selector ',method-name) + (find-selector ',method-name t) (serious-condition () (warn (make-condition 'simple-style-warning diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index eeb6d0d..a18f373 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -61,6 +61,9 @@ (defcfun ("objcl_find_selector" %objcl-find-selector) :pointer (selector-name :string)) +(defcfun ("objcl_intern_selector" %objcl-intern-selector) :pointer + (selector-name :string)) + (defcfun ("objcl_selector_name" %objcl-selector-name) :string (selector :pointer)) @@ -267,6 +270,14 @@ conventional case for namespace identifiers in Objective C." (make-pointer-wrapper 'selector :pointer selector-ptr)))) +(defun intern-selector-by-name (selector-name) + (let ((selector-ptr (%objcl-intern-selector selector-name))) + (assert (not (cffi:null-pointer-p selector-ptr)) + (selector-ptr) + "%OBJCL-INTERN-SELECTOR must always return a selector.") + (make-pointer-wrapper 'selector :pointer selector-ptr))) + + (declaim (ftype (function ((or objc-class id exception)) string) objc-class-name)) (defun objc-class-name (class) @@ -355,14 +366,17 @@ If *name* is the name of an existing selector: (pointer-to selector))) -(declaim (ftype (function ((or selector string list)) (or null selector)) +(declaim (ftype (function ((or selector symbol string list) &optional t) + (or null selector)) find-selector)) -(defun find-selector (selector-name) +(defun find-selector (selector-name &optional errorp) "Retrieve a method selector by name. ## Arguments and Values: -*selector-name* --- a **string** or a **list** of **symbol**s. +*selector-name* --- a **string**, a **symbol**, or a **list** of **symbol**s. + +*errorp* --- a **generalized boolean**. Returns: *selector* --- a __selector__ object, or __nil__. @@ -371,7 +385,11 @@ Returns: *selector* --- a __selector__ object, or __nil__. If *selector-name* is a **string**, the __selector__ named by that string is returned. If no __selector__ with the given name exists, -__nil__ is returned. +either __nil__ is returned if errorp is **false**, or an error of type +__no-such-selector__ is signaled if errorp is **true**. + +If *selector-name* is a **symbol**, it is treated the same as a **list** +whose only element is the **symbol**. If *selector-name* is a **list** of **symbol**s, all **symbol**s are first split into parts separated by hyphens and each part converted into @@ -399,17 +417,94 @@ by which __invoke__ converts its arguments into a *message name*. (find-selector \"self\") ;=> #<SELECTOR `self'> (find-selector '(self)) ;=> #<SELECTOR `self'> + (find-selector 'self) ;=> #<SELECTOR `self'> (find-selector \"stringWithCString:encoding:\") ;=> #<SELECTOR `stringWithCString:encoding:'> (find-selector '(:string-with-c-string :encoding)) - ;=> #<SELECTOR `stringWithCString:encoding:'>" + ;=> #<SELECTOR `stringWithCString:encoding:'> + + +## See also: + + __intern-selector__" + + (or (typecase selector-name + (string (find-selector-by-name selector-name)) + (symbol (find-selector-by-name (symbol-list->message-name + (list selector-name)))) + (list (find-selector-by-name (symbol-list->message-name + selector-name)))) + (and errorp + (error (make-condition 'no-such-selector :designator selector-name))))) + + +(defun intern-selector (selector-name) + "Retrieve a method selector by name, or create it if it does not exist. + +## Arguments and Values: + +*selector-name* --- a **string**, a **symbol**, or a **list** of **symbol**s. + +Returns: *selector* --- a __selector__ object. + + +## Description: + +If *selector-name* is a **string**, the __selector__ named by that +string is returned. If no __selector__ with the given name exists, such +a selector is created and registered with the Objective-C runtime, after +which it is returned. + +If *selector-name* is a **symbol**, it is treated the same as a **list** +whose only element is the **symbol**. + +If *selector-name* is a **list** of **symbol**s, all **symbol**s are +first split into parts separated by hyphens and each part converted into +a **string** according to the following rules: + +1. The first part is fully converted to **lowercase**. + +2. Any additional parts are also fully converted to **lowercase** except + for their first letters, which are left intact. + +3. If the symbol is a **keyword**, the resulting **string** is suffixed + by a **colon** (`:'). + +After that, all parts are concatenated in order to form a +single *selector name component*. The *selector name components* are in +turn concatenated in order to form the **string** that identifies the +selector, which is used as if given directly as an argument to a call to +__intern-selector__. + +Note that the conversion rules for selector names are identical to those +by which __invoke__ converts its arguments into a *message name*. + + +## Examples: + + (intern-selector \"self\") ;=> #<SELECTOR `self'> + (intern-selector '(self)) ;=> #<SELECTOR `self'> + (intern-selector 'self) ;=> #<SELECTOR `self'> + + (intern-selector \"stringWithCString:encoding:\") + ;=> #<SELECTOR `stringWithCString:encoding:'> + + (intern-selector '(:string-with-c-string :encoding)) + ;=> #<SELECTOR `stringWithCString:encoding:'> + + +## See also: + + __find-selector__" (typecase selector-name - (string (find-selector-by-name selector-name)) - (list (find-selector-by-name (symbol-list->message-name - selector-name))))) + (string (intern-selector-by-name selector-name)) + (symbol (intern-selector-by-name (symbol-list->message-name + (list selector-name)))) + (list (intern-selector-by-name (symbol-list->message-name + selector-name))))) (defun object-is-class-p (obj) @@ -433,6 +528,7 @@ by which __invoke__ converts its arguments into a *message name*. ((object-is-class-p obj) (object-get-meta-class obj)) (t (object-get-class obj)))) + ;;; (@* "Low-level Data Conversion") (eval-when (:compile-toplevel :load-toplevel) ;; In order to be able to dispatch over pointer types, we need to @@ -464,8 +560,7 @@ either a __selector__ object or one of a **symbol**, a **string**, or a **list** of **symbol**s representing a __selector__. If *selector-designator* is a **string** or a **list** of **symbol**s, -__find-selector__ is called and the value returned, except that if -__find-selector__ returns __nil__, an **error** is **signal**ed. +__intern-selector__ is called and the value returned. If *selector-designator* is a single **symbol**, it is treated as if it were a **list** whose **car** is the **symbol** and whose **cdr** is @@ -493,8 +588,7 @@ If *selector-designator* is a __selector__, it is simply returned. (selector designator) (symbol (selector (list designator))) ((or string list) - (or (find-selector designator) - (error (make-condition 'no-such-selector :designator designator)))))) + (intern-selector designator)))) ;;;; (@* "Helper functions") diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index 56ba2d7..9a48a1e 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -49,6 +49,9 @@ objcl_find_meta_class (const char *class_name); SEL objcl_find_selector (const char *selector_name); +SEL +objcl_intern_selector (const char *selector_name); + /* Return a null-terminated list of type information strings. The first entry describes the type of the method's return value. */ char ** diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index 6f09cfe..de899e3 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -131,7 +131,7 @@ objcl_find_class (const char *class_name) #ifdef __NEXT_RUNTIME__ return objc_lookUpClass (class_name); #else - return NSClassFromString ([NSString stringWithUTF8String: class_name]); + return objc_lookup_class (class_name); #endif } @@ -153,9 +153,28 @@ objcl_find_meta_class (const char *class_name) SEL -objcl_find_selector (const char *class_name) +objcl_find_selector (const char *selector_name) { - return NSSelectorFromString ([NSString stringWithUTF8String: class_name]); +#ifdef __NEXT_RUNTIME__ + if (!(sel_isMapped ((SEL) selector_name))) /* XXX Does this work? */ + return NULL; + else + return sel_getUid (selector_name); +#else + return sel_get_any_uid (selector_name); +#endif +} + + +SEL +objcl_intern_selector (const char *selector_name) +{ + /* sel_registerName and sel_register_name seem not to be necessary here. */ +#ifdef __NEXT_RUNTIME__ + return sel_getUid (selector_name); +#else + return sel_get_uid (selector_name); +#endif } |