From 32eac2a29c9e6a62497f19cfd47148363201314e Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sat, 16 Feb 2008 16:46:10 +0100 Subject: Further simplify compiler macros. darcs-hash:b79d2b2279d2814e5f92b18106b70f79550166cc --- Lisp/compiler-macros.lisp | 43 ++++++++++++++++--------------------------- 1 file changed, 16 insertions(+), 27 deletions(-) (limited to 'Lisp/compiler-macros.lisp') 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))) -- cgit v1.2.3