1 ;; backquote.el --- backquoting for Emacs Lisp macros
3 ;; Copyright (C) 1985 Free Software Foundation, Inc.
5 ;; Author: Dick King (king@kestrel).
6 ;; Keywords: extensions
8 ;; This file is part of GNU Emacs.
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
12 ;; the Free Software Foundation; either version 2, or (at your option)
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.
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.
26 ;;; This is a rudimentry backquote package written by D. King,
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
37 ;;; (defmacro push (v l)
38 ;;; (` (setq (, l) (cons (,@ (list v l))))))
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.
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.
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?
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
71 (list 'setq l (list 'cons v l)))
74 (list 'car (list 'car l)))
77 (list 'car (list 'cdr l)))
80 (list 'cdr (list 'car l)))
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.
88 (defconst backquote-unquote '(,)
89 "*A list of all objects that stimulate unquoting in `. Memq test.")
92 (defconst backquote-splice '(,@)
93 "*A list of all objects that stimulate splicing in `. Memq test.")
96 ;;; This is the interface
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.
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))
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
114 As an example, a simple macro `push' could be written:
116 (` (setq (, l) (cons (,@ (list v l))))))
119 (` (setq (, l) (cons (, v) (, l)))))
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.)
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))).
129 You cannot construct vectors, only lists. Vectors are treated as
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))
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 argument FORM, 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))
157 (cond ((eq state 'quote)
158 (list state (if (equal form tailmaker) form tailmaker)))
159 ((= (length tailmaker) 1)
160 (funcall (bq-cadr (assq state bq-singles)) tailmaker))
161 (t (cons state tailmaker))))))
163 ;;; There are exceptions - we wouldn't want to call append of one
164 ;;; argument, for example.
165 (defconst bq-singles '((quote bq-quotecar)
172 (defun bq-quotecar (x) (list 'quote (car x)))
174 (defun bq-make-list (x) (cons 'list x))
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)
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)
199 (funcall (bq-cadr (assq state bq-quotefns)) form))
200 ((memq (car form) backquote-unquote)
201 (funcall (bq-cadr (assq state bq-evalfns)) (bq-cadr form)))
202 ((memq (car form) backquote-splice)
203 (funcall (bq-cadr (assq state bq-splicefns)) (bq-cadr form)))
205 (let ((newform (bq-make-maker form)))
206 (if (and (listp newform) (eq (car newform) 'quote))
207 (funcall (bq-cadr (assq state bq-quotefns)) (bq-cadr newform))
208 (funcall (bq-cadr (assq state bq-evalfns)) newform))))
211 ;;; We do a 2-d branch on the form of splicing and the old state.
212 ;;; Here's fifteen functions' names...
213 (defconst bq-splicefns '((nil bq-splicenil)
214 (append bq-spliceappend)
216 (quote bq-splicequote)
217 (cons bq-splicecons)))
219 (defconst bq-evalfns '((nil bq-evalnil)
220 (append bq-evalappend)
225 (defconst bq-quotefns '((nil bq-quotenil)
226 (append bq-quoteappend)
228 (quote bq-quotequote)
229 (cons bq-quotecons)))
231 ;;; The name of each function is
232 ;;; (concat 'bq- <type-of-element-addition> <old-state>)
233 ;;; I'll comment the non-obvious ones before the definitions...
234 ;;; In what follows, uppercase letters and form will always be
235 ;;; metavariables that don't need commas in backquotes, and I will
236 ;;; assume the existence of something like matches that takes a
237 ;;; backquote-like form and a value, binds metavariables and returns
238 ;;; t if the pattern match is successful, returns nil otherwise. I
239 ;;; will write such a goodie someday.
242 ;;; (if (matches ((quote X) Y) tailmaker)
243 ;;; (` ((quote (form X)) Y))
244 ;;; (` ((list form (quote X)) Y))))
245 ;;; (setq state 'append)
246 (defun bq-quotecons (form)
247 (if (and (listp (car tailmaker))
248 (eq (bq-caar tailmaker) 'quote))
250 (list (list 'quote (list form (bq-cadr (car tailmaker))))
251 (bq-cadr tailmaker)))
256 (bq-cadr tailmaker))))
257 (setq state 'append))
259 (defun bq-quotequote (form)
260 (bq-push form tailmaker))
262 ;;; Could be improved to convert (list 'a 'b 'c .. 'w x)
263 ;;; to (append '(a b c .. w) x)
264 ;;; when there are enough elements
265 (defun bq-quotelist (form)
266 (bq-push (list 'quote form) tailmaker))
269 ;;; (if (matches ((quote X) (,@ Y)))
270 ;;; (` ((quote (, (cons form X))) (,@ Y)))))
271 (defun bq-quoteappend (form)
272 (cond ((and (listp tailmaker)
273 (listp (car tailmaker))
274 (eq (bq-caar tailmaker) 'quote))
275 (rplaca (bq-cdar tailmaker)
276 (cons form (car (bq-cdar tailmaker)))))
277 (t (bq-push (list 'quote (list form)) tailmaker))))
279 (defun bq-quotenil (form)
280 (setq tailmaker (list form))
283 ;;; (if (matches (X Y) tailmaker) ; it must
284 ;;; (` ((list form X) Y)))
285 (defun bq-evalcons (form)
287 (list (list 'list form (car tailmaker))
288 (bq-cadr tailmaker)))
289 (setq state 'append))
291 ;;; (if (matches (X Y Z (,@ W)))
292 ;;; (progn (setq state 'append)
293 ;;; (` ((list form) (quote (X Y Z (,@ W))))))
294 ;;; (progn (setq state 'list)
295 ;;; (list form 'X 'Y .. ))) ; quote each one there is
296 (defun bq-evalquote (form)
297 (cond ((< (length tailmaker) 3)
300 (mapcar (function (lambda (x)
306 (list (list 'list form)
307 (list 'quote tailmaker)))
308 (setq state 'append))))
310 (defun bq-evallist (form)
311 (bq-push form tailmaker))
313 ;;; (cond ((matches ((list (,@ X)) (,@ Y)))
314 ;;; (` ((list form (,@ X)) (,@ Y))))
316 ;;; (` (form (,@ X))) (setq state 'cons))
317 ;;; ((matches ((,@ X)))
318 ;;; (` (form (,@ X)))))
319 (defun bq-evalappend (form)
320 (cond ((and (listp tailmaker)
321 (listp (car tailmaker))
322 (eq (bq-caar tailmaker) 'list))
323 (rplacd (car tailmaker)
324 (cons form (bq-cdar tailmaker))))
325 ((= (length tailmaker) 1)
326 (setq tailmaker (cons form tailmaker)
328 (t (bq-push (list 'list form) tailmaker))))
330 (defun bq-evalnil (form)
331 (setq tailmaker (list form)
334 ;;; (if (matches (X Y)) ; it must
335 ;;; (progn (setq state 'append)
336 ;;; (` (form (cons X Y))))) ; couldn't think of anything clever
337 (defun bq-splicecons (form)
340 (list 'cons (car tailmaker) (bq-cadr tailmaker)))
343 (defun bq-splicequote (form)
344 (setq tailmaker (list form (list 'quote tailmaker))
347 (defun bq-splicelist (form)
348 (setq tailmaker (list form (cons 'list tailmaker))
351 (defun bq-spliceappend (form)
352 (bq-push form tailmaker))
354 (defun bq-splicenil (form)
356 tailmaker (list form)))
360 ;;; backquote.el ends here