summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-12 15:40:48 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-12 15:40:48 +0100
commit4c0727ea781c578de7b3e661ab6e3ed956bd88ce (patch)
treeff44bcf03a5e638aca15220a1a3ee6a69500670f
parent614297426c173788c3d6d0c12a425d45d834e9ee (diff)
Fix selector funcallability on CMUCL.
darcs-hash:e0f4df3e7fc24d1bc9261d161b6efd62ec32b66d
-rw-r--r--Lisp/data-types.lisp23
-rw-r--r--objective-cl.asd3
2 files changed, 20 insertions, 6 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 840b5af..3400197 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -123,18 +123,31 @@ The following calls are all equivalent:
&rest initargs
&key
&allow-other-keys)
- ;; FIXME: CMUCL 19d does not allow the second argument to
+ ;; CMUCL 19d does not allow the second argument to
;; PCL:SET-FUNCALLABLE-INSTANCE-FUNCTION to be a closure. As we need
- ;; to close over SELECTOR, this piece of code throws weird errors on
- ;; CMUCL and will not work.
+ ;; to close over SELECTOR, simply using a lambda below leads to weird
+ ;; errors on CMUCL and will not work.
;;
;; In particular, one possible symptom is that SELECTOR may not be a
;; selector but something different when INVOKE-BY-NAME is called.
+ ;;
+ ;; Therefore, we handle this in a somewhat different manner for CMUCL.
+ ;; See SELECTOR-FUNCTION below.
(declare (ignore slot-names initargs))
(c2mop:set-funcallable-instance-function
selector
- #'(lambda (receiver &rest args)
- (apply #'invoke-by-name receiver selector args))))
+ #-cmu #'(lambda (receiver &rest args)
+ (apply #'invoke-by-name receiver selector args))
+ #+cmu (selector-function selector)))
+
+
+#+cmu
+(defun selector-function (selector)
+ ;; FIXME? This is okay, as load-forms for selectors are defined
+ ;; below. Unfortunately, having to call the compiler for each newly
+ ;; interned selector makes COLLECT-SELECTORS slow.
+ (compile nil `(lambda (receiver &rest args)
+ (apply #'invoke-by-name receiver ,selector args))))
(defmethod initialize-instance :after ((selector selector)
diff --git a/objective-cl.asd b/objective-cl.asd
index 712376e..96d94f6 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -131,7 +131,8 @@
"class-definition"
"method-invocation"
"method-definition"
- "reader-syntax"))
+ "reader-syntax"
+ "data-types"))
(:file "post-init" :depends-on ("defpackage"
"libobjcl"
"init"