From 4c0727ea781c578de7b3e661ab6e3ed956bd88ce Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Wed, 12 Mar 2008 15:40:48 +0100
Subject: Fix selector funcallability on CMUCL.

darcs-hash:e0f4df3e7fc24d1bc9261d161b6efd62ec32b66d
---
 Lisp/data-types.lisp | 23 ++++++++++++++++++-----
 objective-cl.asd     |  3 ++-
 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"
-- 
cgit v1.2.3