Mercurial > emacs
annotate lisp/emacs-lisp/backquote.el @ 1091:3302f6e93ce5
*** empty log message ***
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 11 Sep 1992 09:04:24 +0000 |
parents | 213978acbc1e |
children | 9ca8c55f9ae5 |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;; backquote.el --- backquoting for Emacs Lisp macros |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
5 ;; Author: Dick King (king@kestrel). |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: extensions |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
7 |
181 | 8 ;; This file is part of GNU Emacs. |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
181 | 13 ;; any later version. |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
24 ;;; Commentary: |
181 | 25 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
26 ;;; This is a rudimentry backquote package written by D. King, |
181 | 27 ;;; king@kestrel, on 8/31/85. (` x) is a macro |
28 ;;; that expands to a form that produces x. (` (a b ..)) is | |
29 ;;; a macro that expands into a form that produces a list of what a b | |
30 ;;; etc. would have produced. Any element can be of the form | |
31 ;;; (, <form>) in which case the resulting form evaluates | |
32 ;;; <form> before putting it into place, or (,@ <form>), in which | |
33 ;;; case the evaluation of <form> is arranged for and each element | |
34 ;;; of the result (which must be a (possibly null) list) is inserted. | |
35 ;;; As an example, the immediately following macro push (v l) could | |
36 ;;; have been written | |
37 ;;; (defmacro push (v l) | |
38 ;;; (` (setq (, l) (cons (,@ (list v l)))))) | |
39 ;;; although | |
40 ;;; (defmacro push (v l) | |
41 ;;; (` (setq (, l) (cons (, v) (, l))))) | |
42 ;;; is far more natural. The magic atoms , | |
43 ;;; and ,@ are user-settable and list-valued. We recommend that | |
44 ;;; things never be removed from this list lest you break something | |
45 ;;; someone else wrote in the dim past that comes to be recompiled in | |
46 ;;; the distant future. | |
47 | |
48 ;;; LIMITATIONS: tail consing is not handled correctly. Do not say | |
49 ;;; (` (a . (, b))) - say (` (a (,@ b))) | |
50 ;;; which works even if b is not list-valued. | |
51 ;;; No attempt is made to handle vectors. (` [a (, b) c]) doesn't work. | |
52 ;;; Sorry, you must say things like | |
53 ;;; (` (a (,@ 'b))) to get (a . b) and | |
54 ;;; (` ((, ',) c)) to get (, c) - [(` (a , b)) will work but is a bad habit] | |
55 ;;; I haven't taught it the joys of nconc. | |
56 ;;; (` atom) dies. (` (, atom)) or anything else is okay. | |
57 | |
58 ;;; BEWARE BEWARE BEWARE | |
59 ;;; inclusion of (,atom) rather than (, atom) or (,@atom) rather than | |
60 ;;; (,@ atom) will result in errors that will show up very late. | |
61 ;;; This is so crunchy that I am considering including a check for | |
62 ;;; this or changing the syntax to ... ,(<form>). RMS: opinion? | |
63 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
64 ;;; Code: |
181 | 65 |
66 ;;; a raft of general-purpose macros follows. See the nearest | |
67 ;;; Commonlisp manual. | |
68 (defmacro bq-push (v l) | |
69 "Pushes evaluated first form onto second unevaluated object | |
70 a list-value atom" | |
71 (list 'setq l (list 'cons v l))) | |
72 | |
73 (defmacro bq-caar (l) | |
74 (list 'car (list 'car l))) | |
75 | |
76 (defmacro bq-cadr (l) | |
77 (list 'car (list 'cdr l))) | |
78 | |
79 (defmacro bq-cdar (l) | |
80 (list 'cdr (list 'car l))) | |
81 | |
82 | |
83 ;;; These two advertised variables control what characters are used to | |
84 ;;; unquote things. I have included , and ,@ as the unquote and | |
85 ;;; splice operators, respectively, to give users of MIT CADR machine | |
86 ;;; derivitive machines a warm, cosy feeling. | |
87 | |
88 (defconst backquote-unquote '(,) | |
89 "*A list of all objects that stimulate unquoting in `. Memq test.") | |
90 | |
91 | |
92 (defconst backquote-splice '(,@) | |
93 "*A list of all objects that stimulate splicing in `. Memq test.") | |
94 | |
95 | |
96 ;;; This is the interface | |
256 | 97 ;;;###autoload |
181 | 98 (defmacro ` (form) |
99 "(` FORM) is a macro that expands to code to construct FORM. | |
100 Note that this is very slow in interpreted code, but fast if you compile. | |
101 FORM is one or more nested lists, which are `almost quoted': | |
102 They are copied recursively, with non-lists used unchanged in the copy. | |
103 (` a b) == (list 'a 'b) constructs a new list with two elements, `a' and `b'. | |
104 (` a (b c)) == (list 'a (list 'b 'c)) constructs two nested new lists. | |
105 | |
106 However, certain special lists are not copied. They specify substitution. | |
107 Lists that look like (, EXP) are evaluated and the result is substituted. | |
108 (` a (, (+ x 5))) == (list 'a (+ x 5)) | |
109 | |
110 Elements of the form (,@ EXP) are evaluated and then all the elements | |
111 of the result are substituted. This result must be a list; it may | |
112 be `nil'. | |
113 | |
114 As an example, a simple macro `push' could be written: | |
115 (defmacro push (v l) | |
116 (` (setq (, l) (cons (,@ (list v l)))))) | |
117 or as | |
118 (defmacro push (v l) | |
119 (` (setq (, l) (cons (, v) (, l))))) | |
120 | |
121 LIMITATIONS: \"dotted lists\" are not allowed in FORM. | |
122 The ultimate cdr of each list scanned by ` must be `nil'. | |
123 \(This does not apply to constants inside expressions to be substituted.) | |
124 | |
125 Substitution elements are not allowed as the cdr | |
126 of a cons cell. For example, (` (A . (, B))) does not work. | |
127 Instead, write (` (A (,@ B))). | |
128 | |
129 You cannot construct vectors, only lists. Vectors are treated as | |
130 constants. | |
131 | |
132 BEWARE BEWARE BEWARE | |
133 Inclusion of (,ATOM) rather than (, ATOM) | |
134 or of (,@ATOM) rather than (,@ ATOM) | |
135 will result in errors that will show up very late." | |
136 (bq-make-maker form)) | |
137 | |
138 ;;; We develop the method for building the desired list from | |
139 ;;; the end towards the beginning. The contract is that there be a | |
140 ;;; variable called state and a list called tailmaker, and that the form | |
141 ;;; (cons state tailmaker) deliver the goods. Exception - if the | |
142 ;;; state is quote the tailmaker is the form itself. | |
143 ;;; This function takes a form and returns what I will call a maker in | |
144 ;;; what follows. Evaluating the maker would produce the form, | |
145 ;;; properly evaluated according to , and ,@ rules. | |
146 ;;; I work backwards - it seemed a lot easier. The reason for this is | |
147 ;;; if I'm in some sort of a routine building a maker and I switch | |
148 ;;; gears, it seemed to me easier to jump into some other state and | |
149 ;;; glue what I've already done to the end, than to to prepare that | |
150 ;;; something and go back to put things together. | |
151 (defun bq-make-maker (form) | |
152 "Given one argument, a `mostly quoted' object, produces a maker. | |
153 See backquote.el for details" | |
154 (let ((tailmaker (quote nil)) (qc 0) (ec 0) (state nil)) | |
155 (mapcar 'bq-iterative-list-builder (reverse form)) | |
156 (and state | |
157 (cond ((eq state 'quote) | |
340 | 158 (list state (if (equal form tailmaker) form tailmaker))) |
181 | 159 ((= (length tailmaker) 1) |
160 (funcall (bq-cadr (assq state bq-singles)) tailmaker)) | |
161 (t (cons state tailmaker)))))) | |
162 | |
163 ;;; There are exceptions - we wouldn't want to call append of one | |
164 ;;; argument, for example. | |
165 (defconst bq-singles '((quote bq-quotecar) | |
166 (append car) | |
167 (list bq-make-list) | |
168 (cons bq-id))) | |
169 | |
170 (defun bq-id (x) x) | |
171 | |
172 (defun bq-quotecar (x) (list 'quote (car x))) | |
173 | |
174 (defun bq-make-list (x) (cons 'list x)) | |
175 | |
176 ;;; fr debugging use only | |
177 ;(defun funcalll (a b) (funcall a b)) | |
178 ;(defun funcalll (a b) (debug nil 'enter state tailmaker a b) | |
179 ; (let ((ans (funcall a b))) (debug nil 'leave state tailmaker) | |
180 ; ans)) | |
181 | |
182 ;;; Given a state/tailmaker pair that already knows how to make a | |
183 ;;; partial tail of the desired form, this function knows how to add | |
184 ;;; yet another element to the burgening list. There are four cases; | |
185 ;;; the next item is an atom (which will certainly be quoted); a | |
186 ;;; (, xxx), which will be evaluated and put into the list at the top | |
187 ;;; level; a (,@ xxx), which will be evaluated and spliced in, or | |
188 ;;; some other list, in which case we first compute the form's maker, | |
189 ;;; and then we either launch into the quoted case if the maker's | |
190 ;;; top level function is quote, or into the comma case if it isn't. | |
191 ;;; The fourth case reduces to one of the other three, so here we have | |
192 ;;; a choice of three ways to build tailmaker, and cit turns out we | |
193 ;;; use five possible values of state (although someday I'll add | |
194 ;;; nconcto the possible values of state). | |
195 ;;; This maintains the invariant that (cons state tailmaker) is the | |
196 ;;; maker for the elements of the tail we've eaten so far. | |
197 (defun bq-iterative-list-builder (form) | |
198 "Called by `bq-make-maker'. Adds a new item form to tailmaker, | |
199 changing state if need be, so tailmaker and state constitute a recipe | |
200 for making the list so far." | |
201 (cond ((atom form) | |
202 (funcall (bq-cadr (assq state bq-quotefns)) form)) | |
203 ((memq (car form) backquote-unquote) | |
204 (funcall (bq-cadr (assq state bq-evalfns)) (bq-cadr form))) | |
205 ((memq (car form) backquote-splice) | |
206 (funcall (bq-cadr (assq state bq-splicefns)) (bq-cadr form))) | |
207 (t | |
208 (let ((newform (bq-make-maker form))) | |
209 (if (and (listp newform) (eq (car newform) 'quote)) | |
210 (funcall (bq-cadr (assq state bq-quotefns)) (bq-cadr newform)) | |
211 (funcall (bq-cadr (assq state bq-evalfns)) newform)))) | |
212 )) | |
213 | |
214 ;;; We do a 2-d branch on the form of splicing and the old state. | |
215 ;;; Here's fifteen functions' names... | |
216 (defconst bq-splicefns '((nil bq-splicenil) | |
217 (append bq-spliceappend) | |
218 (list bq-splicelist) | |
219 (quote bq-splicequote) | |
220 (cons bq-splicecons))) | |
221 | |
222 (defconst bq-evalfns '((nil bq-evalnil) | |
223 (append bq-evalappend) | |
224 (list bq-evallist) | |
225 (quote bq-evalquote) | |
226 (cons bq-evalcons))) | |
227 | |
228 (defconst bq-quotefns '((nil bq-quotenil) | |
229 (append bq-quoteappend) | |
230 (list bq-quotelist) | |
231 (quote bq-quotequote) | |
232 (cons bq-quotecons))) | |
233 | |
234 ;;; The name of each function is | |
235 ;;; (concat 'bq- <type-of-element-addition> <old-state>) | |
236 ;;; I'll comment the non-obvious ones before the definitions... | |
237 ;;; In what follows, uppercase letters and form will always be | |
238 ;;; metavariables that don't need commas in backquotes, and I will | |
239 ;;; assume the existence of something like matches that takes a | |
240 ;;; backquote-like form and a value, binds metavariables and returns | |
241 ;;; t if the pattern match is successful, returns nil otherwise. I | |
242 ;;; will write such a goodie someday. | |
243 | |
244 ;;; (setq tailmaker | |
245 ;;; (if (matches ((quote X) Y) tailmaker) | |
246 ;;; (` ((quote (form X)) Y)) | |
247 ;;; (` ((list form (quote X)) Y)))) | |
248 ;;; (setq state 'append) | |
249 (defun bq-quotecons (form) | |
250 (if (and (listp (car tailmaker)) | |
251 (eq (bq-caar tailmaker) 'quote)) | |
252 (setq tailmaker | |
253 (list (list 'quote (list form (bq-cadr (car tailmaker)))) | |
254 (bq-cadr tailmaker))) | |
255 (setq tailmaker | |
256 (list (list 'list | |
257 (list 'quote form) | |
258 (car tailmaker)) | |
259 (bq-cadr tailmaker)))) | |
260 (setq state 'append)) | |
261 | |
262 (defun bq-quotequote (form) | |
263 (bq-push form tailmaker)) | |
264 | |
265 ;;; Could be improved to convert (list 'a 'b 'c .. 'w x) | |
266 ;;; to (append '(a b c .. w) x) | |
267 ;;; when there are enough elements | |
268 (defun bq-quotelist (form) | |
269 (bq-push (list 'quote form) tailmaker)) | |
270 | |
271 ;;; (setq tailmaker | |
272 ;;; (if (matches ((quote X) (,@ Y))) | |
273 ;;; (` ((quote (, (cons form X))) (,@ Y))))) | |
274 (defun bq-quoteappend (form) | |
275 (cond ((and (listp tailmaker) | |
276 (listp (car tailmaker)) | |
277 (eq (bq-caar tailmaker) 'quote)) | |
278 (rplaca (bq-cdar tailmaker) | |
279 (cons form (car (bq-cdar tailmaker))))) | |
280 (t (bq-push (list 'quote (list form)) tailmaker)))) | |
281 | |
282 (defun bq-quotenil (form) | |
283 (setq tailmaker (list form)) | |
284 (setq state 'quote)) | |
285 | |
286 ;;; (if (matches (X Y) tailmaker) ; it must | |
287 ;;; (` ((list form X) Y))) | |
288 (defun bq-evalcons (form) | |
289 (setq tailmaker | |
290 (list (list 'list form (car tailmaker)) | |
291 (bq-cadr tailmaker))) | |
292 (setq state 'append)) | |
293 | |
294 ;;; (if (matches (X Y Z (,@ W))) | |
295 ;;; (progn (setq state 'append) | |
296 ;;; (` ((list form) (quote (X Y Z (,@ W)))))) | |
297 ;;; (progn (setq state 'list) | |
298 ;;; (list form 'X 'Y .. ))) ; quote each one there is | |
299 (defun bq-evalquote (form) | |
300 (cond ((< (length tailmaker) 3) | |
301 (setq tailmaker | |
302 (cons form | |
303 (mapcar (function (lambda (x) | |
304 (list 'quote x))) | |
305 tailmaker))) | |
306 (setq state 'list)) | |
307 (t | |
308 (setq tailmaker | |
309 (list (list 'list form) | |
310 (list 'quote tailmaker))) | |
311 (setq state 'append)))) | |
312 | |
313 (defun bq-evallist (form) | |
314 (bq-push form tailmaker)) | |
315 | |
316 ;;; (cond ((matches ((list (,@ X)) (,@ Y))) | |
317 ;;; (` ((list form (,@ X)) (,@ Y)))) | |
318 ;;; ((matches (X)) | |
319 ;;; (` (form (,@ X))) (setq state 'cons)) | |
320 ;;; ((matches ((,@ X))) | |
321 ;;; (` (form (,@ X))))) | |
322 (defun bq-evalappend (form) | |
323 (cond ((and (listp tailmaker) | |
324 (listp (car tailmaker)) | |
325 (eq (bq-caar tailmaker) 'list)) | |
326 (rplacd (car tailmaker) | |
327 (cons form (bq-cdar tailmaker)))) | |
328 ((= (length tailmaker) 1) | |
329 (setq tailmaker (cons form tailmaker) | |
330 state 'cons)) | |
331 (t (bq-push (list 'list form) tailmaker)))) | |
332 | |
333 (defun bq-evalnil (form) | |
334 (setq tailmaker (list form) | |
335 state 'list)) | |
336 | |
337 ;;; (if (matches (X Y)) ; it must | |
338 ;;; (progn (setq state 'append) | |
339 ;;; (` (form (cons X Y))))) ; couldn't think of anything clever | |
340 (defun bq-splicecons (form) | |
341 (setq tailmaker | |
342 (list form | |
343 (list 'cons (car tailmaker) (bq-cadr tailmaker))) | |
344 state 'append)) | |
345 | |
346 (defun bq-splicequote (form) | |
347 (setq tailmaker (list form (list 'quote tailmaker)) | |
348 state 'append)) | |
349 | |
350 (defun bq-splicelist (form) | |
351 (setq tailmaker (list form (cons 'list tailmaker)) | |
352 state 'append)) | |
353 | |
354 (defun bq-spliceappend (form) | |
355 (bq-push form tailmaker)) | |
356 | |
357 (defun bq-splicenil (form) | |
358 (setq state 'append | |
359 tailmaker (list form))) | |
584 | 360 |
361 (provide 'backquote) | |
362 | |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
363 ;;; backquote.el ends here |