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