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