Mercurial > emacs
comparison lisp/emacs-lisp/backquote.el @ 6224:a27c028e757a
(backquote-listify): Renamed from bq-listify.
(backquote-process): Renamed from bq-process.
(backquote-list*-function): Renamed from list*-function.
(backquote-list*-macro): Renamed from list*-macro.
(backquote-list*): Renamed from list*.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 06 Mar 1994 19:43:23 +0000 |
parents | de6afd5ec418 |
children | 922626d0570d |
comparison
equal
deleted
inserted
replaced
6223:de6afd5ec418 | 6224:a27c028e757a |
---|---|
34 ;; Minimizes gratuitous consing. | 34 ;; Minimizes gratuitous consing. |
35 ;; Faster operation with simpler semantics. | 35 ;; Faster operation with simpler semantics. |
36 ;; Generates faster run-time expressions. | 36 ;; Generates faster run-time expressions. |
37 ;; One third fewer calories than our regular beer. | 37 ;; One third fewer calories than our regular beer. |
38 | 38 |
39 ;; This backquote will generate calls to the list* form. | 39 ;; This backquote will generate calls to the backquote-list* form. |
40 ;; Both a function version and a macro version are included. | 40 ;; Both a function version and a macro version are included. |
41 ;; The macro version is used by default because it is faster | 41 ;; The macro version is used by default because it is faster |
42 ;; and needs no run-time support. It should really be a subr. | 42 ;; and needs no run-time support. It should really be a subr. |
43 | 43 |
44 ;;; Code: | 44 ;;; Code: |
45 | 45 |
46 (provide 'backquote) | 46 (provide 'backquote) |
47 | 47 |
48 ;; function and macro versions of list* | 48 ;; function and macro versions of backquote-list* |
49 | 49 |
50 (defun list*-function (first &rest list) | 50 (defun backquote-list*-function (first &rest list) |
51 "Like `list' but the last argument is the tail of the new list. | 51 "Like `list' but the last argument is the tail of the new list. |
52 | 52 |
53 For example (list* 'a 'b 'c) => (a b . c)" | 53 For example (backquote-list* 'a 'b 'c) => (a b . c)" |
54 (if list | 54 (if list |
55 (let* ((rest list) (newlist (cons first nil)) (last newlist)) | 55 (let* ((rest list) (newlist (cons first nil)) (last newlist)) |
56 (while (cdr rest) | 56 (while (cdr rest) |
57 (setcdr last (cons (car rest) nil)) | 57 (setcdr last (cons (car rest) nil)) |
58 (setq last (cdr last) | 58 (setq last (cdr last) |
59 rest (cdr rest))) | 59 rest (cdr rest))) |
60 (setcdr last (car rest)) | 60 (setcdr last (car rest)) |
61 newlist) | 61 newlist) |
62 first)) | 62 first)) |
63 | 63 |
64 (defmacro list*-macro (first &rest list) | 64 (defmacro backquote-list*-macro (first &rest list) |
65 "Like `cons' but accepts more arguments. | 65 "Like `list' but the last argument is the tail of the new list. |
66 | 66 |
67 For example (list* 'a 'b 'c) == (cons 'a (cons 'b 'c))" | 67 For example (backquote-list* 'a 'b 'c) => (a b . c)" |
68 (setq list (reverse (cons first list)) | 68 (setq list (reverse (cons first list)) |
69 first (car list) | 69 first (car list) |
70 list (cdr list)) | 70 list (cdr list)) |
71 (if list | 71 (if list |
72 (let* ((second (car list)) | 72 (let* ((second (car list)) |
76 (setq newlist (list 'cons (car rest) newlist) | 76 (setq newlist (list 'cons (car rest) newlist) |
77 rest (cdr rest))) | 77 rest (cdr rest))) |
78 newlist) | 78 newlist) |
79 first)) | 79 first)) |
80 | 80 |
81 (fset 'list* (symbol-function 'list*-macro)) | 81 (fset 'backquote-list* (symbol-function 'backquote-list*-macro)) |
82 | 82 |
83 ;; A few advertised variables that control which symbols are used | 83 ;; A few advertised variables that control which symbols are used |
84 ;; to represent the backquote, unquote, and splice operations. | 84 ;; to represent the backquote, unquote, and splice operations. |
85 | 85 |
86 (defvar backquote-backquote-symbol '` | 86 (defvar backquote-backquote-symbol '` |
87 "*Symbol used to represent a backquote or nested backquote (e.g. `).") | 87 "*Symbol used to represent a backquote or nested backquote (e.g. `).") |
88 | 88 |
89 (defvar backquote-unquote-symbol ', | 89 (defvar backquote-unquote-symbol ', |
90 "*Symbol used to represent an unquote (e.g. ,) inside a backquote.") | 90 "*Symbol used to represent an unquote (e.g. `,') inside a backquote.") |
91 | 91 |
92 (defvar backquote-splice-symbol ',@ | 92 (defvar backquote-splice-symbol ',@ |
93 "*Symbol used to represent a splice (e.g. ,@) inside a backquote.") | 93 "*Symbol used to represent a splice (e.g. `,'@) inside a backquote.") |
94 | 94 |
95 (defmacro backquote (arg) | 95 (defmacro backquote (arg) |
96 "Argument STRUCTURE describes a template to build. | 96 "Argument STRUCTURE describes a template to build. |
97 | 97 |
98 The whole structure acts as if it were quoted except for certain | 98 The whole structure acts as if it were quoted except for certain |
103 b => (ba bb bc) ; assume b has this value | 103 b => (ba bb bc) ; assume b has this value |
104 \(` (a b c)) => (a b c) ; backquote acts like quote | 104 \(` (a b c)) => (a b c) ; backquote acts like quote |
105 \(` (a (, b) c)) => (a (ba bb bc) c) ; insert the value of b | 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 | 106 \(` (a (,@ b) c)) => (a ba bb bc c) ; splice in the value of b |
107 | 107 |
108 Vectors work just like lists. Nested backquotes are permitted. | 108 Vectors work just like lists. Nested backquotes are permitted." |
109 | 109 (cdr (backquote-process arg))) |
110 Variables: backquote-backquote-symbol, backquote-unquote-symbol, | |
111 backquote-splice-symbol" | |
112 (cdr (bq-process arg))) | |
113 | 110 |
114 ;; GNU Emacs has no reader macros | 111 ;; GNU Emacs has no reader macros |
115 | 112 |
116 (fset backquote-backquote-symbol (symbol-function 'backquote)) | 113 (fset backquote-backquote-symbol (symbol-function 'backquote)) |
117 | 114 |
118 ;; bq-process returns a dotted-pair of a tag (0, 1, or 2) and | 115 ;; backquote-process returns a dotted-pair of a tag (0, 1, or 2) and |
119 ;; the backquote-processed structure. 0 => the structure is | 116 ;; the backquote-processed structure. 0 => the structure is |
120 ;; constant, 1 => to be unquoted, 2 => to be spliced in. | 117 ;; constant, 1 => to be unquoted, 2 => to be spliced in. |
121 ;; The top-level backquote macro just discards the tag. | 118 ;; The top-level backquote macro just discards the tag. |
122 | 119 |
123 (defun bq-process (s) | 120 (defun backquote-process (s) |
124 (cond | 121 (cond |
125 ((vectorp s) | 122 ((vectorp s) |
126 (let ((n (bq-process (append s ())))) | 123 (let ((n (backquote-process (append s ())))) |
127 (if (= (car n) 0) | 124 (if (= (car n) 0) |
128 (cons 0 s) | 125 (cons 0 s) |
129 (cons 1 (cond | 126 (cons 1 (cond |
130 ((eq (nth 1 n) 'list) | 127 ((eq (nth 1 n) 'list) |
131 (cons 'vector (nthcdr 2 n))) | 128 (cons 'vector (nthcdr 2 n))) |
140 ((eq (car s) backquote-unquote-symbol) | 137 ((eq (car s) backquote-unquote-symbol) |
141 (cons 1 (nth 1 s))) | 138 (cons 1 (nth 1 s))) |
142 ((eq (car s) backquote-splice-symbol) | 139 ((eq (car s) backquote-splice-symbol) |
143 (cons 2 (nth 1 s))) | 140 (cons 2 (nth 1 s))) |
144 ((eq (car s) backquote-backquote-symbol) | 141 ((eq (car s) backquote-backquote-symbol) |
145 (bq-process (cdr (bq-process (nth 1 s))))) | 142 (backquote-process (cdr (backquote-process (nth 1 s))))) |
146 (t | 143 (t |
147 (let ((rest s) (item nil) (firstlist nil) (list nil) (lists nil)) | 144 (let ((rest s) (item nil) (firstlist nil) (list nil) (lists nil)) |
148 (while (consp rest) | 145 (while (consp rest) |
149 (if (eq (car rest) backquote-unquote-symbol) | 146 (if (eq (car rest) backquote-unquote-symbol) |
150 (setq rest (list (list backquote-splice-symbol (nth 1 rest))))) | 147 (setq rest (list (list backquote-splice-symbol (nth 1 rest))))) |
151 (setq item (bq-process (car rest))) | 148 (setq item (backquote-process (car rest))) |
152 (cond | 149 (cond |
153 ((= (car item) 2) | 150 ((= (car item) 2) |
154 (if (null firstlist) | 151 (if (null firstlist) |
155 (setq firstlist list | 152 (setq firstlist list |
156 list nil)) | 153 list nil)) |
157 (if list | 154 (if list |
158 (setq lists (cons (bq-listify list '(0 . nil)) lists))) | 155 (setq lists (cons (backquote-listify list '(0 . nil)) lists))) |
159 (setq lists (cons (cdr item) lists)) | 156 (setq lists (cons (cdr item) lists)) |
160 (setq list nil)) | 157 (setq list nil)) |
161 (t | 158 (t |
162 (setq list (cons item list)))) | 159 (setq list (cons item list)))) |
163 (setq rest (cdr rest))) | 160 (setq rest (cdr rest))) |
164 (if (or rest list) | 161 (if (or rest list) |
165 (setq lists (cons (bq-listify list (bq-process rest)) lists))) | 162 (setq lists (cons (backquote-listify list (backquote-process rest)) |
163 lists))) | |
166 (setq lists | 164 (setq lists |
167 (if (or (cdr lists) | 165 (if (or (cdr lists) |
168 (and (consp (car lists)) | 166 (and (consp (car lists)) |
169 (eq (car (car lists)) backquote-splice-symbol))) | 167 (eq (car (car lists)) backquote-splice-symbol))) |
170 (cons 'append (nreverse lists)) | 168 (cons 'append (nreverse lists)) |
171 (car lists))) | 169 (car lists))) |
172 (if firstlist | 170 (if firstlist |
173 (setq lists (bq-listify firstlist (cons 1 lists)))) | 171 (setq lists (backquote-listify firstlist (cons 1 lists)))) |
174 (if (eq (car lists) 'quote) | 172 (if (eq (car lists) 'quote) |
175 (cons 0 (list 'quote s)) | 173 (cons 0 (list 'quote s)) |
176 (cons 1 lists)))))) | 174 (cons 1 lists)))))) |
177 | 175 |
178 ;; bq-listify takes (tag . structure) pairs from bq-process | 176 ;; backquote-listify takes (tag . structure) pairs from backquote-process |
179 ;; and decides between append, list, list*, and cons depending | 177 ;; and decides between append, list, backquote-list*, and cons depending |
180 ;; on which tags are in the list. | 178 ;; on which tags are in the list. |
181 | 179 |
182 (defun bq-listify (list old-tail) | 180 (defun backquote-listify (list old-tail) |
183 (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil)) | 181 (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil)) |
184 (if (= (car old-tail) 0) | 182 (if (= (car old-tail) 0) |
185 (setq tail (eval tail) | 183 (setq tail (eval tail) |
186 old-tail nil)) | 184 old-tail nil)) |
187 (while (consp list-tail) | 185 (while (consp list-tail) |
197 (if heads | 195 (if heads |
198 (let ((use-list* (or (cdr heads) | 196 (let ((use-list* (or (cdr heads) |
199 (and (consp (car heads)) | 197 (and (consp (car heads)) |
200 (eq (car (car heads)) | 198 (eq (car (car heads)) |
201 backquote-splice-symbol))))) | 199 backquote-splice-symbol))))) |
202 (cons (if use-list* 'list* 'cons) | 200 (cons (if use-list* 'backquote-list* 'cons) |
203 (append heads (list tail)))) | 201 (append heads (list tail)))) |
204 tail)) | 202 tail)) |
205 (t (cons 'list heads))))) | 203 (t (cons 'list heads))))) |
206 | 204 |
207 ;; backquote.el ends here | 205 ;; backquote.el ends here |