From 131f41186f41a41dbad6e7e1bce0320af2b74f72 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Fri, 21 Sep 2007 19:46:04 +0200
Subject: Add a compiler macro for INVOKE.

darcs-hash:93b465085160cfe9dc8978554acdfca73670f6f6
---
 Lisp/compiler-macros.lisp | 70 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 Lisp/compiler-macros.lisp

(limited to 'Lisp/compiler-macros.lisp')

diff --git a/Lisp/compiler-macros.lisp b/Lisp/compiler-macros.lisp
new file mode 100644
index 0000000..ba29c2d
--- /dev/null
+++ b/Lisp/compiler-macros.lisp
@@ -0,0 +1,70 @@
+(in-package #:mulk.objective-cl)
+
+
+;; Optimise constant method names away by converting them to selectors
+;; at load-time.
+(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
+                         (load-time-value (handler-case
+                                              (selector ,method-name)
+                                            (serious-condition ()
+                                              (warn
+                                               (make-condition
+                                                'style-warning
+                                                :format-control
+                                                "~S designates an unknown ~
+                                                 method selector."
+                                                :format-arguments
+                                                (list ,method-name)))
+                                              ,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
+        (load-time-value (handler-case
+                             (selector ,method-name)
+                           (serious-condition ()
+                             (warn
+                              (make-condition 'style-warning
+                                              :format-control
+                                              "~S designates an unknown ~
+                                               method selector."
+                                              :format-arguments
+                                              (list ,method-name)))
+                             ,method-name)))
+        ,@args)
+      form))
+
+
+;; This compiler macro is a bit more complicated than the preceding
+;; ones.
+(define-compiler-macro invoke (receiver message-start &rest message-components)
+  (multiple-value-bind (method-name args)
+      (split-method-call message-start message-components)
+    `(invoke-by-name
+      ,receiver
+      (load-time-value (handler-case
+                           (selector ',method-name)
+                         (serious-condition ()
+                           (warn
+                            (make-condition 'style-warning
+                                            :format-control
+                                            "~S designates an unknown ~
+                                               method selector."
+                                            :format-arguments
+                                            (list ',method-name)))
+                           ',method-name)))
+      ,@args)))
-- 
cgit v1.2.3