Mercurial > emacs
comparison lisp/emacs-lisp/eieio-comp.el @ 104431:a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
emacs-lisp/eieio-custom.el, emacs-lisp/eieio-datadebug.el,
emacs-lisp/eieio-doc.el, emacs-lisp/eieio-opt.el,
emacs-lisp/eieio-speedbar.el, emacs-lisp/eieio.el: Move from eieio/directory.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 30 Aug 2009 02:02:15 +0000 |
parents | |
children | 25e047f7f6a2 |
comparison
equal
deleted
inserted
replaced
104430:b93dbe652ecd | 104431:a64f3429f0ac |
---|---|
1 ;;; eieio-comp.el -- eieio routines to help with byte compilation | |
2 | |
3 ;;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002, 2005, 2008, | |
4 ;;; 2009 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
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 (eval-and-compile | |
36 (if (featurep 'xemacs) | |
37 (progn | |
38 ;; XEmacs compatibility settings. | |
39 (if (not (fboundp 'byte-compile-compiled-obj-to-list)) | |
40 (defun byte-compile-compiled-obj-to-list (moose) nil)) | |
41 (if (not (boundp 'byte-compile-outbuffer)) | |
42 (defvar byte-compile-outbuffer nil)) | |
43 (defmacro eieio-byte-compile-princ-code (code outbuffer) | |
44 `(progn (if (atom ,code) | |
45 (princ "#[" ,outbuffer) | |
46 (princ "'(" ,outbuffer)) | |
47 (let ((codelist (if (byte-code-function-p ,code) | |
48 (byte-compile-compiled-obj-to-list ,code) | |
49 (append ,code nil)))) | |
50 (while codelist | |
51 (eieio-prin1 (car codelist) ,outbuffer) | |
52 (princ " " ,outbuffer) | |
53 (setq codelist (cdr codelist)))) | |
54 (if (atom ,code) | |
55 (princ "]" ,outbuffer) | |
56 (princ ")" ,outbuffer)))) | |
57 (defun eieio-prin1 (code outbuffer) | |
58 (cond ((byte-code-function-p code) | |
59 (let ((codelist (byte-compile-compiled-obj-to-list code))) | |
60 (princ "#[" outbuffer) | |
61 (while codelist | |
62 (eieio-prin1 (car codelist) outbuffer) | |
63 (princ " " outbuffer) | |
64 (setq codelist (cdr codelist))) | |
65 (princ "]" outbuffer))) | |
66 ((vectorp code) | |
67 (let ((i 0) (ln (length code))) | |
68 (princ "[" outbuffer) | |
69 (while (< i ln) | |
70 (eieio-prin1 (aref code i) outbuffer) | |
71 (princ " " outbuffer) | |
72 (setq i (1+ i))) | |
73 (princ "]" outbuffer))) | |
74 (t (prin1 code outbuffer))))) | |
75 ;; Emacs: | |
76 (defmacro eieio-byte-compile-princ-code (code outbuffer) | |
77 (list 'prin1 code outbuffer)) | |
78 ;; Dynamically bound in byte-compile-from-buffer. | |
79 (defvar bytecomp-outbuffer) | |
80 (defvar bytecomp-filename))) | |
81 | |
82 (declare-function eieio-defgeneric-form "eieio" (method doc-string)) | |
83 | |
84 (defun byte-compile-defmethod-param-convert (paramlist) | |
85 "Convert method params into the params used by the defmethod thingy. | |
86 Argument PARAMLIST is the paramter list to convert." | |
87 (let ((argfix nil)) | |
88 (while paramlist | |
89 (setq argfix (cons (if (listp (car paramlist)) | |
90 (car (car paramlist)) | |
91 (car paramlist)) | |
92 argfix)) | |
93 (setq paramlist (cdr paramlist))) | |
94 (nreverse argfix))) | |
95 | |
96 ;; This teaches the byte compiler how to do this sort of thing. | |
97 (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) | |
98 | |
99 (defun byte-compile-file-form-defmethod (form) | |
100 "Mumble about the method we are compiling. | |
101 This function is mostly ripped from `byte-compile-file-form-defun', but | |
102 it's been modified to handle the special syntax of the defmethod | |
103 command. There should probably be one for defgeneric as well, but | |
104 that is called but rarely. Argument FORM is the body of the method." | |
105 (setq form (cdr form)) | |
106 (let* ((meth (car form)) | |
107 (key (progn (setq form (cdr form)) | |
108 (cond ((or (eq ':BEFORE (car form)) | |
109 (eq ':before (car form))) | |
110 (setq form (cdr form)) | |
111 ":before ") | |
112 ((or (eq ':AFTER (car form)) | |
113 (eq ':after (car form))) | |
114 (setq form (cdr form)) | |
115 ":after ") | |
116 ((or (eq ':PRIMARY (car form)) | |
117 (eq ':primary (car form))) | |
118 (setq form (cdr form)) | |
119 ":primary ") | |
120 ((or (eq ':STATIC (car form)) | |
121 (eq ':static (car form))) | |
122 (setq form (cdr form)) | |
123 ":static ") | |
124 (t "")))) | |
125 (params (car form)) | |
126 (lamparams (byte-compile-defmethod-param-convert params)) | |
127 (arg1 (car params)) | |
128 (class (if (listp arg1) (nth 1 arg1) nil)) | |
129 (my-outbuffer (if (featurep 'xemacs) | |
130 byte-compile-outbuffer | |
131 bytecomp-outbuffer))) | |
132 (let ((name (format "%s::%s" (or class "#<generic>") meth))) | |
133 (if byte-compile-verbose | |
134 ;; bytecomp-filename is from byte-compile-from-buffer. | |
135 (message "Compiling %s... (%s)" (or bytecomp-filename "") name)) | |
136 (setq byte-compile-current-form name)) ; for warnings | |
137 ;; Flush any pending output | |
138 (byte-compile-flush-pending) | |
139 ;; Byte compile the body. For the byte compiled forms, add the | |
140 ;; rest arguments, which will get ignored by the engine which will | |
141 ;; add them later (I hope) | |
142 (let* ((new-one (byte-compile-lambda | |
143 (append (list 'lambda lamparams) | |
144 (cdr form)))) | |
145 (code (byte-compile-byte-code-maker new-one))) | |
146 (princ "\n(eieio-defmethod '" my-outbuffer) | |
147 (princ meth my-outbuffer) | |
148 (princ " '(" my-outbuffer) | |
149 (princ key my-outbuffer) | |
150 (prin1 params my-outbuffer) | |
151 (princ " " my-outbuffer) | |
152 (eieio-byte-compile-princ-code code my-outbuffer) | |
153 (princ "))" my-outbuffer)) | |
154 ;; Now add this function to the list of known functions. | |
155 ;; Don't bother with a doc string. Not relevant here. | |
156 (add-to-list 'byte-compile-function-environment | |
157 (cons meth | |
158 (eieio-defgeneric-form meth ""))) | |
159 | |
160 ;; Remove it from the undefined list if it is there. | |
161 (let ((elt (assq meth byte-compile-unresolved-functions))) | |
162 (if elt (setq byte-compile-unresolved-functions | |
163 (delq elt byte-compile-unresolved-functions)))) | |
164 | |
165 ;; nil prevents cruft from appearing in the output buffer. | |
166 nil)) | |
167 | |
168 (provide 'eieio-comp) | |
169 | |
170 ;;; eieio-comp.el ends here |