Commit | Line | Data |
---|---|---|
6dd12ef2 CY |
1 | ;;; eieio-comp.el -- eieio routines to help with byte compilation |
2 | ||
9ffe3f52 | 3 | ;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002, 2005, 2008, |
49f70d46 | 4 | ;; 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
6dd12ef2 | 5 | |
9ffe3f52 | 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
6dd12ef2 CY |
7 | ;; Version: 0.2 |
8 | ;; Keywords: oop, lisp, tools | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; Byte compiler functions for defmethod. This will affect the new GNU | |
28 | ;; byte compiler for Emacs 19 and better. This function will be called by | |
29 | ;; the byte compiler whenever a `defmethod' is encountered in a file. | |
30 | ;; It will output a function call to `eieio-defmethod' with the byte | |
31 | ;; compiled function as a parameter. | |
32 | ||
33 | ;;; Code: | |
34 | ||
35 | (declare-function eieio-defgeneric-form "eieio" (method doc-string)) | |
36 | ||
37 | ;; Some compatibility stuff | |
38 | (eval-and-compile | |
39 | (if (not (fboundp 'byte-compile-compiled-obj-to-list)) | |
40 | (defun byte-compile-compiled-obj-to-list (moose) nil)) | |
41 | ||
42 | (if (not (boundp 'byte-compile-outbuffer)) | |
43 | (defvar byte-compile-outbuffer nil)) | |
44 | ) | |
45 | ||
46 | ;; This teaches the byte compiler how to do this sort of thing. | |
47 | (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) | |
48 | ||
49 | ;; Variables used free: | |
50 | (defvar outbuffer) | |
51 | (defvar filename) | |
52 | ||
53 | (defun byte-compile-file-form-defmethod (form) | |
54 | "Mumble about the method we are compiling. | |
a8f316ca JB |
55 | This function is mostly ripped from `byte-compile-file-form-defun', |
56 | but it's been modified to handle the special syntax of the `defmethod' | |
57 | command. There should probably be one for `defgeneric' as well, but | |
6dd12ef2 CY |
58 | that is called but rarely. Argument FORM is the body of the method." |
59 | (setq form (cdr form)) | |
60 | (let* ((meth (car form)) | |
61 | (key (progn (setq form (cdr form)) | |
62 | (cond ((or (eq ':BEFORE (car form)) | |
63 | (eq ':before (car form))) | |
64 | (setq form (cdr form)) | |
65 | ":before ") | |
66 | ((or (eq ':AFTER (car form)) | |
67 | (eq ':after (car form))) | |
68 | (setq form (cdr form)) | |
69 | ":after ") | |
70 | ((or (eq ':PRIMARY (car form)) | |
71 | (eq ':primary (car form))) | |
72 | (setq form (cdr form)) | |
73 | ":primary ") | |
74 | ((or (eq ':STATIC (car form)) | |
75 | (eq ':static (car form))) | |
76 | (setq form (cdr form)) | |
77 | ":static ") | |
78 | (t "")))) | |
79 | (params (car form)) | |
80 | (lamparams (byte-compile-defmethod-param-convert params)) | |
81 | (arg1 (car params)) | |
82 | (class (if (listp arg1) (nth 1 arg1) nil)) | |
83 | (my-outbuffer (if (eval-when-compile (featurep 'xemacs)) | |
84 | byte-compile-outbuffer | |
85 | (condition-case nil | |
86 | bytecomp-outbuffer | |
87 | (error outbuffer)))) | |
88 | ) | |
89 | (let ((name (format "%s::%s" (or class "#<generic>") meth))) | |
90 | (if byte-compile-verbose | |
91 | ;; #### filename used free | |
92 | (message "Compiling %s... (%s)" (or filename "") name)) | |
93 | (setq byte-compile-current-form name) ; for warnings | |
94 | ) | |
95 | ;; Flush any pending output | |
96 | (byte-compile-flush-pending) | |
97 | ;; Byte compile the body. For the byte compiled forms, add the | |
98 | ;; rest arguments, which will get ignored by the engine which will | |
99 | ;; add them later (I hope) | |
100 | (let* ((new-one (byte-compile-lambda | |
101 | (append (list 'lambda lamparams) | |
102 | (cdr form)))) | |
103 | (code (byte-compile-byte-code-maker new-one))) | |
104 | (princ "\n(eieio-defmethod '" my-outbuffer) | |
105 | (princ meth my-outbuffer) | |
106 | (princ " '(" my-outbuffer) | |
107 | (princ key my-outbuffer) | |
108 | (prin1 params my-outbuffer) | |
109 | (princ " " my-outbuffer) | |
110 | (prin1 code my-outbuffer) | |
111 | (princ "))" my-outbuffer) | |
112 | ) | |
113 | ;; Now add this function to the list of known functions. | |
114 | ;; Don't bother with a doc string. Not relevant here. | |
115 | (add-to-list 'byte-compile-function-environment | |
116 | (cons meth | |
117 | (eieio-defgeneric-form meth ""))) | |
118 | ||
119 | ;; Remove it from the undefined list if it is there. | |
120 | (let ((elt (assq meth byte-compile-unresolved-functions))) | |
121 | (if elt (setq byte-compile-unresolved-functions | |
122 | (delq elt byte-compile-unresolved-functions)))) | |
123 | ||
124 | ;; nil prevents cruft from appearing in the output buffer. | |
125 | nil)) | |
126 | ||
127 | (defun byte-compile-defmethod-param-convert (paramlist) | |
a8f316ca | 128 | "Convert method params into the params used by the `defmethod' thingy. |
9ffe3f52 | 129 | Argument PARAMLIST is the parameter list to convert." |
6dd12ef2 CY |
130 | (let ((argfix nil)) |
131 | (while paramlist | |
132 | (setq argfix (cons (if (listp (car paramlist)) | |
133 | (car (car paramlist)) | |
134 | (car paramlist)) | |
135 | argfix)) | |
136 | (setq paramlist (cdr paramlist))) | |
137 | (nreverse argfix))) | |
138 | ||
139 | (provide 'eieio-comp) | |
140 | ||
3999968a | 141 | ;; arch-tag: f2aacdd3-1da2-4ee9-b3e5-e8eac0832ee3 |
6dd12ef2 | 142 | ;;; eieio-comp.el ends here |