aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2010-08-28 20:52:36 +0200
committerStefan Monnier2010-08-28 20:52:36 +0200
commit6fe79b7c7c4bf6df3a0dcae2969d5d83f4e28dc9 (patch)
tree484ecf94325122d4b4ba2fe82b552f73fa1a59bb
parent4abe5bf64a4608d2ede0b1124decb5ad63822d9f (diff)
downloademacs-6fe79b7c7c4bf6df3a0dcae2969d5d83f4e28dc9.tar.gz
emacs-6fe79b7c7c4bf6df3a0dcae2969d5d83f4e28dc9.zip
* lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Use pcase.
(macroexp-accumulate): Use `declare'.
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/emacs-lisp/macroexp.el139
2 files changed, 69 insertions, 75 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3664f67b821..a1564ac4a5f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
12010-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/macroexp.el (macroexpand-all-1): Use pcase.
4 (macroexp-accumulate): Use `declare'.
5
12010-08-27 Vinicius Jose Latorre <viniciusjl@ig.com.br> 62010-08-27 Vinicius Jose Latorre <viniciusjl@ig.com.br>
2 7
3 * whitespace.el (whitespace-style): Adjust type declaration. 8 * whitespace.el (whitespace-style): Adjust type declaration.
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 876b9a468ac..6dfd47b4ad1 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -52,6 +52,7 @@ possible (for instance, when BODY just returns VAR unchanged, the
52result will be eq to LIST). 52result will be eq to LIST).
53 53
54\(fn (VAR LIST) BODY...)" 54\(fn (VAR LIST) BODY...)"
55 (declare (indent 1))
55 (let ((var (car var+list)) 56 (let ((var (car var+list))
56 (list (cadr var+list)) 57 (list (cadr var+list))
57 (shared (make-symbol "shared")) 58 (shared (make-symbol "shared"))
@@ -72,7 +73,6 @@ result will be eq to LIST).
72 (push ,new-el ,unshared)) 73 (push ,new-el ,unshared))
73 (setq ,tail (cdr ,tail))) 74 (setq ,tail (cdr ,tail)))
74 (nconc (nreverse ,unshared) ,shared)))) 75 (nconc (nreverse ,unshared) ,shared))))
75(put 'macroexp-accumulate 'lisp-indent-function 1)
76 76
77(defun macroexpand-all-forms (forms &optional skip) 77(defun macroexpand-all-forms (forms &optional skip)
78 "Return FORMS with macros expanded. FORMS is a list of forms. 78 "Return FORMS with macros expanded. FORMS is a list of forms.
@@ -107,80 +107,69 @@ Assumes the caller has bound `macroexpand-all-environment'."
107 macroexpand-all-environment) 107 macroexpand-all-environment)
108 ;; Normal form; get its expansion, and then expand arguments. 108 ;; Normal form; get its expansion, and then expand arguments.
109 (setq form (macroexpand form macroexpand-all-environment)) 109 (setq form (macroexpand form macroexpand-all-environment))
110 (if (consp form) 110 (pcase form
111 (let ((fun (car form))) 111 (`(cond . ,clauses)
112 (cond 112 (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
113 ((eq fun 'cond) 113 (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
114 (maybe-cons fun (macroexpand-all-clauses (cdr form)) form)) 114 (maybe-cons
115 ((eq fun 'condition-case) 115 'condition-case
116 (maybe-cons 116 (maybe-cons err
117 fun 117 (maybe-cons (macroexpand-all-1 body)
118 (maybe-cons (cadr form) 118 (macroexpand-all-clauses handlers 1)
119 (maybe-cons (macroexpand-all-1 (nth 2 form)) 119 (cddr form))
120 (macroexpand-all-clauses (nthcdr 3 form) 1) 120 (cdr form))
121 (cddr form)) 121 form))
122 (cdr form)) 122 (`(defmacro ,name . ,args-and-body)
123 form)) 123 (push (cons name (cons 'lambda args-and-body))
124 ((eq fun 'defmacro) 124 macroexpand-all-environment)
125 (push (cons (cadr form) (cons 'lambda (cddr form))) 125 (macroexpand-all-forms form 3))
126 macroexpand-all-environment) 126 (`(defun . ,_) (macroexpand-all-forms form 3))
127 (macroexpand-all-forms form 3)) 127 (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
128 ((eq fun 'defun) 128 (`(function ,(and f `(lambda . ,_)))
129 (macroexpand-all-forms form 3)) 129 (maybe-cons 'function
130 ((memq fun '(defvar defconst)) 130 (maybe-cons (macroexpand-all-forms f 2)
131 (macroexpand-all-forms form 2)) 131 nil
132 ((eq fun 'function) 132 (cdr form))
133 (if (and (consp (cadr form)) (eq (car (cadr form)) 'lambda)) 133 form))
134 (maybe-cons fun 134 (`(,(or `function `quote) . ,_) form)
135 (maybe-cons (macroexpand-all-forms (cadr form) 2) 135 (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
136 nil 136 (maybe-cons fun
137 (cdr form)) 137 (maybe-cons (macroexpand-all-clauses bindings 1)
138 form) 138 (macroexpand-all-forms body)
139 form)) 139 (cdr form))
140 ((memq fun '(let let*)) 140 form))
141 (maybe-cons fun 141 (`(,(and fun `(lambda . ,_)) . ,args)
142 (maybe-cons (macroexpand-all-clauses (cadr form) 1) 142 ;; Embedded lambda in function position.
143 (macroexpand-all-forms (cddr form)) 143 (maybe-cons (macroexpand-all-forms fun 2)
144 (cdr form)) 144 (macroexpand-all-forms args)
145 form)) 145 form))
146 ((eq fun 'quote) 146 ;; The following few cases are for normal function calls that
147 form) 147 ;; are known to funcall one of their arguments. The byte
148 ((and (consp fun) (eq (car fun) 'lambda)) 148 ;; compiler has traditionally handled these functions specially
149 ;; Embedded lambda in function position. 149 ;; by treating a lambda expression quoted by `quote' as if it
150 (maybe-cons (macroexpand-all-forms fun 2) 150 ;; were quoted by `function'. We make the same transformation
151 (macroexpand-all-forms (cdr form)) 151 ;; here, so that any code that cares about the difference will
152 form)) 152 ;; see the same transformation.
153 ;; The following few cases are for normal function calls that 153 ;; First arg is a function:
154 ;; are known to funcall one of their arguments. The byte 154 (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) ',f . ,args)
155 ;; compiler has traditionally handled these functions specially 155 ;; We don't use `maybe-cons' since there's clearly a change.
156 ;; by treating a lambda expression quoted by `quote' as if it 156 (cons fun
157 ;; were quoted by `function'. We make the same transformation 157 (cons (macroexpand-all-1 (list 'function f))
158 ;; here, so that any code that cares about the difference will 158 (macroexpand-all-forms args))))
159 ;; see the same transformation. 159 ;; Second arg is a function:
160 ;; First arg is a function: 160 (`(,(and fun (or `sort)) ,arg1 ',f . ,args)
161 ((and (memq fun '(apply mapcar mapatoms mapconcat mapc)) 161 ;; We don't use `maybe-cons' since there's clearly a change.
162 (consp (cadr form)) 162 (cons fun
163 (eq (car (cadr form)) 'quote)) 163 (cons (macroexpand-all-1 arg1)
164 ;; We don't use `maybe-cons' since there's clearly a change. 164 (cons (macroexpand-all-1
165 (cons fun 165 (list 'function f))
166 (cons (macroexpand-all-1 (cons 'function (cdr (cadr form)))) 166 (macroexpand-all-forms args)))))
167 (macroexpand-all-forms (cddr form))))) 167 (`(,_ . ,_)
168 ;; Second arg is a function: 168 ;; For every other list, we just expand each argument (for
169 ((and (eq fun 'sort) 169 ;; setq/setq-default this works alright because the variable names
170 (consp (nth 2 form)) 170 ;; are symbols).
171 (eq (car (nth 2 form)) 'quote)) 171 (macroexpand-all-forms form 1))
172 ;; We don't use `maybe-cons' since there's clearly a change. 172 (t form))))
173 (cons fun
174 (cons (macroexpand-all-1 (cadr form))
175 (cons (macroexpand-all-1
176 (cons 'function (cdr (nth 2 form))))
177 (macroexpand-all-forms (nthcdr 3 form))))))
178 (t
179 ;; For everything else, we just expand each argument (for
180 ;; setq/setq-default this works alright because the variable names
181 ;; are symbols).
182 (macroexpand-all-forms form 1))))
183 form)))
184 173
185;;;###autoload 174;;;###autoload
186(defun macroexpand-all (form &optional environment) 175(defun macroexpand-all (form &optional environment)