summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-10-10 13:48:50 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-10-10 13:48:50 +0200
commitf71611e1995b2645a183a52e221fccfcca64d2e0 (patch)
treebb077189374c81a3ece36d37a221a5d75530bb99
parent8c5db651a2d55a8692b0dd78e37d4c01c4794585 (diff)
Make compile-time selector warnings work on the NeXT runtime, clean the Objective-C layer up a bit.
darcs-hash:bff1454e2749c658ed0d0ad4eb51c4b1802e6f40
-rw-r--r--JOURNAL31
-rw-r--r--Lisp/compiler-macros.lisp12
-rw-r--r--Lisp/libobjcl.lisp118
-rw-r--r--Objective-C/libobjcl.h3
-rw-r--r--Objective-C/libobjcl.m25
5 files changed, 170 insertions, 19 deletions
diff --git a/JOURNAL b/JOURNAL
index 77f7021..55ad1ba 100644
--- a/JOURNAL
+++ b/JOURNAL
@@ -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
}