summaryrefslogtreecommitdiff
path: root/Lisp
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 /Lisp
parent614297426c173788c3d6d0c12a425d45d834e9ee (diff)
Fix selector funcallability on CMUCL.
darcs-hash:e0f4df3e7fc24d1bc9261d161b6efd62ec32b66d
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/data-types.lisp23
1 files changed, 18 insertions, 5 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)