15261
|
1 ;;; backquote.el --- implement the ` Lisp construct
|
14169
|
2
|
39085
|
3 ;;; Copyright (C) 1990, 1992, 1994, 2001 Free Software Foundation, Inc.
|
845
|
4
|
6223
|
5 ;; Author: Rick Sladkey <jrs@world.std.com>
|
|
6 ;; Maintainer: FSF
|
|
7 ;; Keywords: extensions, internal
|
807
|
8
|
13337
|
9 ;; This file is part of GNU Emacs.
|
181
|
10
|
|
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
|
12244
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
181
|
14 ;; any later version.
|
|
15
|
|
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.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
14169
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
24 ;; Boston, MA 02111-1307, USA.
|
181
|
25
|
13337
|
26 ;;; Commentary:
|
181
|
27
|
48172
|
28 ;; When the Lisp reader sees `(...), it generates (\` (...)).
|
|
29 ;; When it sees ,... inside such a backquote form, it generates (\, ...).
|
|
30 ;; For ,@... it generates (\,@ ...).
|
|
31
|
6224
|
32 ;; This backquote will generate calls to the backquote-list* form.
|
6223
|
33 ;; Both a function version and a macro version are included.
|
|
34 ;; The macro version is used by default because it is faster
|
|
35 ;; and needs no run-time support. It should really be a subr.
|
181
|
36
|
807
|
37 ;;; Code:
|
181
|
38
|
584
|
39 (provide 'backquote)
|
|
40
|
6224
|
41 ;; function and macro versions of backquote-list*
|
6223
|
42
|
6224
|
43 (defun backquote-list*-function (first &rest list)
|
6223
|
44 "Like `list' but the last argument is the tail of the new list.
|
|
45
|
6224
|
46 For example (backquote-list* 'a 'b 'c) => (a b . c)"
|
6223
|
47 (if list
|
|
48 (let* ((rest list) (newlist (cons first nil)) (last newlist))
|
|
49 (while (cdr rest)
|
|
50 (setcdr last (cons (car rest) nil))
|
|
51 (setq last (cdr last)
|
|
52 rest (cdr rest)))
|
|
53 (setcdr last (car rest))
|
|
54 newlist)
|
|
55 first))
|
|
56
|
6224
|
57 (defmacro backquote-list*-macro (first &rest list)
|
|
58 "Like `list' but the last argument is the tail of the new list.
|
6223
|
59
|
6224
|
60 For example (backquote-list* 'a 'b 'c) => (a b . c)"
|
6223
|
61 (setq list (reverse (cons first list))
|
|
62 first (car list)
|
|
63 list (cdr list))
|
|
64 (if list
|
|
65 (let* ((second (car list))
|
|
66 (rest (cdr list))
|
|
67 (newlist (list 'cons second first)))
|
|
68 (while rest
|
|
69 (setq newlist (list 'cons (car rest) newlist)
|
|
70 rest (cdr rest)))
|
|
71 newlist)
|
|
72 first))
|
|
73
|
7369
|
74 (defalias 'backquote-list* (symbol-function 'backquote-list*-macro))
|
6223
|
75
|
|
76 ;; A few advertised variables that control which symbols are used
|
|
77 ;; to represent the backquote, unquote, and splice operations.
|
27243
|
78 (defconst backquote-backquote-symbol '\`
|
39085
|
79 "Symbol used to represent a backquote or nested backquote.")
|
6223
|
80
|
27243
|
81 (defconst backquote-unquote-symbol ',
|
39085
|
82 "Symbol used to represent an unquote inside a backquote.")
|
6223
|
83
|
27243
|
84 (defconst backquote-splice-symbol ',@
|
39085
|
85 "Symbol used to represent a splice inside a backquote.")
|
6223
|
86
|
7299
|
87 ;;;###autoload
|
6223
|
88 (defmacro backquote (arg)
|
|
89 "Argument STRUCTURE describes a template to build.
|
|
90
|
|
91 The whole structure acts as if it were quoted except for certain
|
|
92 places where expressions are evaluated and inserted or spliced in.
|
|
93
|
|
94 For example:
|
|
95
|
11687
|
96 b => (ba bb bc) ; assume b has this value
|
|
97 `(a b c) => (a b c) ; backquote acts like quote
|
12606
|
98 `(a ,b c) => (a (ba bb bc) c) ; insert the value of b
|
|
99 `(a ,@b c) => (a ba bb bc c) ; splice in the value of b
|
6223
|
100
|
6224
|
101 Vectors work just like lists. Nested backquotes are permitted."
|
|
102 (cdr (backquote-process arg)))
|
6223
|
103
|
|
104 ;; GNU Emacs has no reader macros
|
|
105
|
7299
|
106 ;;;###autoload
|
11687
|
107 (defalias '\` (symbol-function 'backquote))
|
6223
|
108
|
6224
|
109 ;; backquote-process returns a dotted-pair of a tag (0, 1, or 2) and
|
6223
|
110 ;; the backquote-processed structure. 0 => the structure is
|
|
111 ;; constant, 1 => to be unquoted, 2 => to be spliced in.
|
|
112 ;; The top-level backquote macro just discards the tag.
|
|
113
|
6224
|
114 (defun backquote-process (s)
|
6223
|
115 (cond
|
|
116 ((vectorp s)
|
6224
|
117 (let ((n (backquote-process (append s ()))))
|
6223
|
118 (if (= (car n) 0)
|
|
119 (cons 0 s)
|
|
120 (cons 1 (cond
|
38028
|
121 ((not (listp (cdr n)))
|
|
122 (list 'vconcat (cdr n)))
|
6223
|
123 ((eq (nth 1 n) 'list)
|
|
124 (cons 'vector (nthcdr 2 n)))
|
|
125 ((eq (nth 1 n) 'append)
|
|
126 (cons 'vconcat (nthcdr 2 n)))
|
|
127 (t
|
|
128 (list 'apply '(function vector) (cdr n))))))))
|
|
129 ((atom s)
|
|
130 (cons 0 (if (or (null s) (eq s t) (not (symbolp s)))
|
|
131 s
|
|
132 (list 'quote s))))
|
|
133 ((eq (car s) backquote-unquote-symbol)
|
|
134 (cons 1 (nth 1 s)))
|
|
135 ((eq (car s) backquote-splice-symbol)
|
|
136 (cons 2 (nth 1 s)))
|
|
137 ((eq (car s) backquote-backquote-symbol)
|
6224
|
138 (backquote-process (cdr (backquote-process (nth 1 s)))))
|
6223
|
139 (t
|
6835
|
140 (let ((rest s)
|
|
141 item firstlist list lists expression)
|
|
142 ;; Scan this list-level, setting LISTS to a list of forms,
|
|
143 ;; each of which produces a list of elements
|
|
144 ;; that should go in this level.
|
49598
|
145 ;; The order of LISTS is backwards.
|
6835
|
146 ;; If there are non-splicing elements (constant or variable)
|
|
147 ;; at the beginning, put them in FIRSTLIST,
|
|
148 ;; as a list of tagged values (TAG . FORM).
|
|
149 ;; If there are any at the end, they go in LIST, likewise.
|
6223
|
150 (while (consp rest)
|
6835
|
151 ;; Turn . (, foo) into (,@ foo).
|
6223
|
152 (if (eq (car rest) backquote-unquote-symbol)
|
|
153 (setq rest (list (list backquote-splice-symbol (nth 1 rest)))))
|
6224
|
154 (setq item (backquote-process (car rest)))
|
6223
|
155 (cond
|
|
156 ((= (car item) 2)
|
8007
|
157 ;; Put the nonspliced items before the first spliced item
|
|
158 ;; into FIRSTLIST.
|
|
159 (if (null lists)
|
6223
|
160 (setq firstlist list
|
|
161 list nil))
|
8007
|
162 ;; Otherwise, put any preceding nonspliced items into LISTS.
|
6223
|
163 (if list
|
6224
|
164 (setq lists (cons (backquote-listify list '(0 . nil)) lists)))
|
6223
|
165 (setq lists (cons (cdr item) lists))
|
|
166 (setq list nil))
|
|
167 (t
|
|
168 (setq list (cons item list))))
|
|
169 (setq rest (cdr rest)))
|
6835
|
170 ;; Handle nonsplicing final elements, and the tail of the list
|
|
171 ;; (which remains in REST).
|
6223
|
172 (if (or rest list)
|
6224
|
173 (setq lists (cons (backquote-listify list (backquote-process rest))
|
|
174 lists)))
|
49598
|
175 ;; Turn LISTS into a form that produces the combined list.
|
6835
|
176 (setq expression
|
6223
|
177 (if (or (cdr lists)
|
6835
|
178 (eq (car-safe (car lists)) backquote-splice-symbol))
|
6223
|
179 (cons 'append (nreverse lists))
|
|
180 (car lists)))
|
6835
|
181 ;; Tack on any initial elements.
|
6223
|
182 (if firstlist
|
6835
|
183 (setq expression (backquote-listify firstlist (cons 1 expression))))
|
|
184 (if (eq (car-safe expression) 'quote)
|
6223
|
185 (cons 0 (list 'quote s))
|
6835
|
186 (cons 1 expression))))))
|
6223
|
187
|
6224
|
188 ;; backquote-listify takes (tag . structure) pairs from backquote-process
|
|
189 ;; and decides between append, list, backquote-list*, and cons depending
|
6223
|
190 ;; on which tags are in the list.
|
|
191
|
6224
|
192 (defun backquote-listify (list old-tail)
|
6223
|
193 (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil))
|
|
194 (if (= (car old-tail) 0)
|
|
195 (setq tail (eval tail)
|
|
196 old-tail nil))
|
|
197 (while (consp list-tail)
|
|
198 (setq item (car list-tail))
|
|
199 (setq list-tail (cdr list-tail))
|
|
200 (if (or heads old-tail (/= (car item) 0))
|
|
201 (setq heads (cons (cdr item) heads))
|
|
202 (setq tail (cons (eval (cdr item)) tail))))
|
|
203 (cond
|
|
204 (tail
|
|
205 (if (null old-tail)
|
|
206 (setq tail (list 'quote tail)))
|
|
207 (if heads
|
|
208 (let ((use-list* (or (cdr heads)
|
|
209 (and (consp (car heads))
|
|
210 (eq (car (car heads))
|
|
211 backquote-splice-symbol)))))
|
6224
|
212 (cons (if use-list* 'backquote-list* 'cons)
|
6223
|
213 (append heads (list tail))))
|
|
214 tail))
|
|
215 (t (cons 'list heads)))))
|
|
216
|
38412
|
217 ;;; backquote.el ends here
|