diff options
| author | Richard M. Stallman | 1994-03-06 19:43:23 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-03-06 19:43:23 +0000 |
| commit | 288f95bd036dc83326396c90d32679a3ecdeec6e (patch) | |
| tree | 83cfb54f3d0e2956b85d09c6b2230e3680ce5a6c | |
| parent | 41ea659a7f62f5eed5f5306ce1c44f3c5de6f2b5 (diff) | |
| download | emacs-288f95bd036dc83326396c90d32679a3ecdeec6e.tar.gz emacs-288f95bd036dc83326396c90d32679a3ecdeec6e.zip | |
(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*.
| -rw-r--r-- | lisp/emacs-lisp/backquote.el | 52 |
1 files changed, 25 insertions, 27 deletions
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 419e5ca02ba..777cbbf8f9a 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el | |||
| @@ -36,7 +36,7 @@ | |||
| 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. |
| @@ -45,12 +45,12 @@ | |||
| 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) |
| @@ -61,10 +61,10 @@ For example (list* 'a 'b 'c) => (a b . c)" | |||
| 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)) |
| @@ -78,7 +78,7 @@ For example (list* 'a 'b 'c) == (cons 'a (cons 'b 'c))" | |||
| 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. |
| @@ -87,10 +87,10 @@ For example (list* 'a 'b 'c) == (cons 'a (cons 'b 'c))" | |||
| 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. |
| @@ -105,25 +105,22 @@ b => (ba bb bc) ; assume b has this value | |||
| 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 |
| @@ -142,27 +139,28 @@ backquote-splice-symbol" | |||
| 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)) |
| @@ -170,16 +168,16 @@ 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) |
| @@ -199,7 +197,7 @@ backquote-splice-symbol" | |||
| 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))))) |