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