diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-21 19:46:04 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-09-21 19:46:04 +0200 |
commit | 131f41186f41a41dbad6e7e1bce0320af2b74f72 (patch) | |
tree | 12df22156130727890530cd0bd99a1eb7a31142d /Lisp/compiler-macros.lisp | |
parent | 4bcd7e54d49e128f4a8e713faa2a25f4797e0120 (diff) |
Add a compiler macro for INVOKE.
darcs-hash:93b465085160cfe9dc8978554acdfca73670f6f6
Diffstat (limited to 'Lisp/compiler-macros.lisp')
-rw-r--r-- | Lisp/compiler-macros.lisp | 70 |
1 files changed, 70 insertions, 0 deletions
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))) |