Mercurial > hg > xemacs-beta

comparison lisp/backquote.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 41ff10fd062f
children 74fd4e045ea6
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
40 ;; - support for old-backquote-compatibility-hook nixed because the 40 ;; - support for old-backquote-compatibility-hook nixed because the
41 ;; old-backquote compatibility is now done in the reader... 41 ;; old-backquote compatibility is now done in the reader...
42 ;; - nixed support for |,.| because 42 ;; - nixed support for |,.| because
43 ;; (a) it's not in CLtl2 43 ;; (a) it's not in CLtl2
44 ;; (b) ",.foo" is the same as ". ,foo" 44 ;; (b) ",.foo" is the same as ". ,foo"
45 ;; (c) because RMS isn't interested in using this version of backquote.el 45 ;; (c) because RMS isn't interested in using this version of backquote.el
46 ;; 46 ;;
47 ;; wing@666.com; added ,. support back in: 47 ;; wing@666.com; added ,. support back in:
48 ;; (a) yes, it is in CLtl2. Read closely on page 529. 48 ;; (a) yes, it is in CLtl2. Read closely on page 529.
49 ;; (b) RMS in 19.30 adds C support for ,. even if it's not really 49 ;; (b) RMS in 19.30 adds C support for ,. even if it's not really
50 ;; handled. 50 ;; handled.
64 ;; |`,|: [a] => a 64 ;; |`,|: [a] => a
65 ;; NIL: [a] => a ;the NIL flag is used only when a is NIL 65 ;; NIL: [a] => a ;the NIL flag is used only when a is NIL
66 ;; T: [a] => a ;the T flag is used when a is self-evaluating 66 ;; T: [a] => a ;the T flag is used when a is self-evaluating
67 ;; QUOTE: [a] => (QUOTE a) 67 ;; QUOTE: [a] => (QUOTE a)
68 ;; APPEND: [a] => (APPEND . a) 68 ;; APPEND: [a] => (APPEND . a)
69 ;; NCONC: [a] => (NCONC . a) 69 ;; NCONC: [a] => (NCONC . a)
70 ;; LIST: [a] => (LIST . a) 70 ;; LIST: [a] => (LIST . a)
71 ;; LIST*: [a] => (LIST* . a) 71 ;; LIST*: [a] => (LIST* . a)
72 ;; 72 ;;
73 ;; The flags are combined according to the following set of rules: 73 ;; The flags are combined according to the following set of rules:
74 ;; ([a] means that a should be converted according to the previous table) 74 ;; ([a] means that a should be converted according to the previous table)
75 ;; 75 ;;
76 ;; \ car || otherwise | QUOTE or | |`,@| | |`,.| 76 ;; \ car || otherwise | QUOTE or | |`,@| | |`,.|
77 ;;cdr \ || | T or NIL | | 77 ;;cdr \ || | T or NIL | |
78 ;;============================================================================ 78 ;;============================================================================
79 ;; |`,| ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a [d]) 79 ;; |`,| ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a [d])
80 ;; NIL ||LIST ([a]) |QUOTE (a) |<hair> a |<hair> a 80 ;; NIL ||LIST ([a]) |QUOTE (a) |<hair> a |<hair> a
81 ;;QUOTE or T||LIST* ([a] [d]) |QUOTE (a . d) |APPEND (a [d]) |NCONC (a [d]) 81 ;;QUOTE or T||LIST* ([a] [d]) |QUOTE (a . d) |APPEND (a [d]) |NCONC (a [d])
82 ;; APPEND ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a . d) |NCONC (a [d]) 82 ;; APPEND ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a . d) |NCONC (a [d])
83 ;; NCONC ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a . d) 83 ;; NCONC ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a . d)
84 ;; LIST ||LIST ([a] . d) |LIST ([a] . d) |APPEND (a [d]) |NCONC (a [d]) 84 ;; LIST ||LIST ([a] . d) |LIST ([a] . d) |APPEND (a [d]) |NCONC (a [d])
85 ;; LIST* ||LIST* ([a] . d) |LIST* ([a] . d) |APPEND (a [d]) |NCONC (a [d]) 85 ;; LIST* ||LIST* ([a] . d) |LIST* ([a] . d) |APPEND (a [d]) |NCONC (a [d])
86 ;; 86 ;;
87 ;;<hair> involves starting over again pretending you had read ".,a)" instead 87 ;;<hair> involves starting over again pretending you had read ".,a)" instead
88 ;; of ",@a)" 88 ;; of ",@a)"
89 ;; 89 ;;
90 90
91 ;; These are the forms it expects: |backquote| |`| |,| |,@| and |,.|. 91 ;; These are the forms it expects: |backquote| |`| |,| |,@| and |,.|.
92 92
93 ;;; Code: 93 ;;; Code:
94 94
95 (defconst bq-backquote-marker 'backquote) 95 (defconst bq-backquote-marker 'backquote)
96 (defconst bq-backtick-marker '\`) ; remnant of the old lossage 96 (defconst bq-backtick-marker '\`) ; remnant of the old lossage
97 (defconst bq-comma-marker '\,) 97 (defconst bq-comma-marker '\,)
98 (defconst bq-at-marker '\,@) 98 (defconst bq-at-marker '\,@)
99 (defconst bq-dot-marker '\,\.) 99 (defconst bq-dot-marker '\,\.)
100 100
128 128
129 \(backquote TEMPLATE) is a macro that produces code to construct TEMPLATE. 129 \(backquote TEMPLATE) is a macro that produces code to construct TEMPLATE.
130 Note that this is very slow in interpreted code, but fast if you compile. 130 Note that this is very slow in interpreted code, but fast if you compile.
131 TEMPLATE is one or more nested lists or vectors, which are `almost quoted'. 131 TEMPLATE is one or more nested lists or vectors, which are `almost quoted'.
132 They are copied recursively, with elements preceded by comma evaluated. 132 They are copied recursively, with elements preceded by comma evaluated.
133 (backquote (a b)) == (list 'a 'b) 133 (backquote (a b)) == (list 'a 'b)
134 (backquote (a [b c])) == (list 'a (vector 'b 'c)) 134 (backquote (a [b c])) == (list 'a (vector 'b 'c))
135 135
136 However, certain special lists are not copied. They specify substitution. 136 However, certain special lists are not copied. They specify substitution.
137 Lists that look like (\\, EXP) are evaluated and the result is substituted. 137 Lists that look like (\\, EXP) are evaluated and the result is substituted.
138 (backquote (a (\\, (+ x 5)))) == (list 'a (+ x 5)) 138 (backquote (a (\\, (+ x 5)))) == (list 'a (+ x 5))
139 139
195 ;;; This does the expansion from table 2. 195 ;;; This does the expansion from table 2.
196 (defun bq-process-2 (code) 196 (defun bq-process-2 (code)
197 (cond ((vectorp code) 197 (cond ((vectorp code)
198 (let* ((dflag-d 198 (let* ((dflag-d
199 (bq-process-2 (bq-vector-contents code)))) 199 (bq-process-2 (bq-vector-contents code))))
200 (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d))))) 200 (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d)))))
201 ((atom code) 201 ((atom code)
202 (cond ((null code) (cons nil nil)) 202 (cond ((null code) (cons nil nil))
203 ((or (numberp code) (eq code t)) 203 ((or (numberp code) (eq code t))
204 (cons t code)) 204 (cons t code))
205 (t (cons 'quote code)))) 205 (t (cons 'quote code))))
251 (if (memq dflag '(list list*)) 251 (if (memq dflag '(list list*))
252 (cons dflag (cons a d)) 252 (cons dflag (cons a d))
253 (cons 'list* 253 (cons 'list*
254 (list a (bq-process-1 dflag d))))))))))) 254 (list a (bq-process-1 dflag d)))))))))))
255 255
256 ;;; This handles the <hair> cases 256 ;;; This handles the <hair> cases
257 (defun bq-comma (code) 257 (defun bq-comma (code)
258 (cond ((atom code) 258 (cond ((atom code)
259 (cond ((null code) 259 (cond ((null code)
260 (cons nil nil)) 260 (cons nil nil))
261 ((or (numberp code) (eq code 't)) 261 ((or (numberp code) (eq code 't))
288 thing)))) 288 thing))))
289 289
290 ;;; ---------------------------------------------------------------- 290 ;;; ----------------------------------------------------------------
291 291
292 (defmacro bq-list* (&rest args) 292 (defmacro bq-list* (&rest args)
293 "Returns a list of its arguments with last cons a dotted pair." 293 "Return a list of its arguments with last cons a dotted pair."
294 (setq args (reverse args)) 294 (setq args (reverse args))
295 (let ((result (car args))) 295 (let ((result (car args)))
296 (setq args (cdr args)) 296 (setq args (cdr args))
297 (while args 297 (while args
298 (setq result (list 'cons (car args) result)) 298 (setq result (list 'cons (car args) result))