diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-12 15:40:48 +0100 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-12 15:40:48 +0100 |
commit | 4c0727ea781c578de7b3e661ab6e3ed956bd88ce (patch) | |
tree | ff44bcf03a5e638aca15220a1a3ee6a69500670f /Lisp | |
parent | 614297426c173788c3d6d0c12a425d45d834e9ee (diff) |
Fix selector funcallability on CMUCL.
darcs-hash:e0f4df3e7fc24d1bc9261d161b6efd62ec32b66d
Diffstat (limited to 'Lisp')
-rw-r--r-- | Lisp/data-types.lisp | 23 |
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) |