Further simplify compiler macros.

darcs-hash:b79d2b2279d2814e5f92b18106b70f79550166cc

1 files changed, 16 insertions, 27 deletions

diff --git a/Lisp/compiler-macros.lisp b/Lisp/compiler-macros.lisp
index 71f944b..77fb4b6 100644
--- a/Lisp/compiler-macros.lisp
+++ b/Lisp/compiler-macros.lisp
@@ -34,38 +34,30 @@
 
 ;; Optimise constant method names away by converting them to selectors
 ;; at load-time.
+;;
+;; Optimise all (SELECTOR ...) forms.  This is important in order to
+;; make (FUNCALL (SELECTOR ...) ...) efficient.
+(define-compiler-macro selector (&whole form method-name)
+  (if (constantp method-name)
+      (selector-load-time-form (eval method-name))
+      form))
+
+
+;; Have PRIMITIVE-INVOKE take advantage of the compiler macro for
+;; SELECTOR.
 (define-compiler-macro primitive-invoke (&whole form
                                          receiver method-name return-type
                                          &rest args)
-  (if (and (constantp method-name)
-           (not (and (listp method-name)
-                     (eq 'load-time-value (car method-name)))))
-      `(primitive-invoke ,receiver
-                         ,(selector-load-time-form (eval method-name))
-                         ,return-type ,@args)
+  (if (constantp method-name)
+      `(primitive-invoke ,receiver (selector ,method-name) ,return-type ,@args)
       form))
 
 
 ;; Do the same optimisations for INVOKE-BY-NAME as for PRIMITIVE-INVOKE.
 (define-compiler-macro invoke-by-name (&whole form
                                        receiver method-name &rest args)
-  (if (and (constantp method-name)
-           (not (and (listp method-name)
-                     (eq 'load-time-value (car method-name)))))
-      `(invoke-by-name
-        ,receiver
-        ,(selector-load-time-form (eval method-name))
-        ,@args)
-      form))
-
-
-;; Optimise all (SELECTOR ...) forms.  This is important in order to
-;; make (FUNCALL (SELECTOR ...) ...) efficient.
-(define-compiler-macro selector (&whole form method-name)
-  (if (and (constantp method-name)
-           (not (and (listp method-name)
-                     (eq 'load-time-value (car method-name)))))
-      (selector-load-time-form (eval method-name))
+  (if (constantp method-name)
+      `(invoke-by-name ,receiver (selector ,method-name) ,@args)
       form))
 
 
@@ -78,7 +70,4 @@
                              (second message-start)
                              message-start)
                          message-components)
-    `(invoke-by-name
-      ,receiver
-      ,(selector-load-time-form method-name)
-      ,@args)))
+    `(invoke-by-name ,receiver (selector ',method-name) ,@args)))