Commit 6fe79b7c authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Use pcase.

(macroexp-accumulate): Use `declare'.
parent 4abe5bf6
2010-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/macroexp.el (macroexpand-all-1): Use pcase.
(macroexp-accumulate): Use `declare'.
2010-08-27 Vinicius Jose Latorre <viniciusjl@ig.com.br> 2010-08-27 Vinicius Jose Latorre <viniciusjl@ig.com.br>
   
* whitespace.el (whitespace-style): Adjust type declaration. * whitespace.el (whitespace-style): Adjust type declaration.
......
...@@ -52,6 +52,7 @@ possible (for instance, when BODY just returns VAR unchanged, the ...@@ -52,6 +52,7 @@ possible (for instance, when BODY just returns VAR unchanged, the
result will be eq to LIST). result will be eq to LIST).
\(fn (VAR LIST) BODY...)" \(fn (VAR LIST) BODY...)"
(declare (indent 1))
(let ((var (car var+list)) (let ((var (car var+list))
(list (cadr var+list)) (list (cadr var+list))
(shared (make-symbol "shared")) (shared (make-symbol "shared"))
...@@ -72,7 +73,6 @@ result will be eq to LIST). ...@@ -72,7 +73,6 @@ result will be eq to LIST).
(push ,new-el ,unshared)) (push ,new-el ,unshared))
(setq ,tail (cdr ,tail))) (setq ,tail (cdr ,tail)))
(nconc (nreverse ,unshared) ,shared)))) (nconc (nreverse ,unshared) ,shared))))
(put 'macroexp-accumulate 'lisp-indent-function 1)
(defun macroexpand-all-forms (forms &optional skip) (defun macroexpand-all-forms (forms &optional skip)
"Return FORMS with macros expanded. FORMS is a list of forms. "Return FORMS with macros expanded. FORMS is a list of forms.
...@@ -107,48 +107,41 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -107,48 +107,41 @@ Assumes the caller has bound `macroexpand-all-environment'."
macroexpand-all-environment) macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments. ;; Normal form; get its expansion, and then expand arguments.
(setq form (macroexpand form macroexpand-all-environment)) (setq form (macroexpand form macroexpand-all-environment))
(if (consp form) (pcase form
(let ((fun (car form))) (`(cond . ,clauses)
(cond (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
((eq fun 'cond) (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
(maybe-cons fun (macroexpand-all-clauses (cdr form)) form))
((eq fun 'condition-case)
(maybe-cons (maybe-cons
fun 'condition-case
(maybe-cons (cadr form) (maybe-cons err
(maybe-cons (macroexpand-all-1 (nth 2 form)) (maybe-cons (macroexpand-all-1 body)
(macroexpand-all-clauses (nthcdr 3 form) 1) (macroexpand-all-clauses handlers 1)
(cddr form)) (cddr form))
(cdr form)) (cdr form))
form)) form))
((eq fun 'defmacro) (`(defmacro ,name . ,args-and-body)
(push (cons (cadr form) (cons 'lambda (cddr form))) (push (cons name (cons 'lambda args-and-body))
macroexpand-all-environment) macroexpand-all-environment)
(macroexpand-all-forms form 3)) (macroexpand-all-forms form 3))
((eq fun 'defun) (`(defun . ,_) (macroexpand-all-forms form 3))
(macroexpand-all-forms form 3)) (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
((memq fun '(defvar defconst)) (`(function ,(and f `(lambda . ,_)))
(macroexpand-all-forms form 2)) (maybe-cons 'function
((eq fun 'function) (maybe-cons (macroexpand-all-forms f 2)
(if (and (consp (cadr form)) (eq (car (cadr form)) 'lambda))
(maybe-cons fun
(maybe-cons (macroexpand-all-forms (cadr form) 2)
nil nil
(cdr form)) (cdr form))
form)
form)) form))
((memq fun '(let let*)) (`(,(or `function `quote) . ,_) form)
(`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
(maybe-cons fun (maybe-cons fun
(maybe-cons (macroexpand-all-clauses (cadr form) 1) (maybe-cons (macroexpand-all-clauses bindings 1)
(macroexpand-all-forms (cddr form)) (macroexpand-all-forms body)
(cdr form)) (cdr form))
form)) form))
((eq fun 'quote) (`(,(and fun `(lambda . ,_)) . ,args)
form)
((and (consp fun) (eq (car fun) 'lambda))
;; Embedded lambda in function position. ;; Embedded lambda in function position.
(maybe-cons (macroexpand-all-forms fun 2) (maybe-cons (macroexpand-all-forms fun 2)
(macroexpand-all-forms (cdr form)) (macroexpand-all-forms args)
form)) form))
;; The following few cases are for normal function calls that ;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte ;; are known to funcall one of their arguments. The byte
...@@ -158,29 +151,25 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -158,29 +151,25 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; here, so that any code that cares about the difference will ;; here, so that any code that cares about the difference will
;; see the same transformation. ;; see the same transformation.
;; First arg is a function: ;; First arg is a function:
((and (memq fun '(apply mapcar mapatoms mapconcat mapc)) (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) ',f . ,args)
(consp (cadr form))
(eq (car (cadr form)) 'quote))
;; We don't use `maybe-cons' since there's clearly a change. ;; We don't use `maybe-cons' since there's clearly a change.
(cons fun (cons fun
(cons (macroexpand-all-1 (cons 'function (cdr (cadr form)))) (cons (macroexpand-all-1 (list 'function f))
(macroexpand-all-forms (cddr form))))) (macroexpand-all-forms args))))
;; Second arg is a function: ;; Second arg is a function:
((and (eq fun 'sort) (`(,(and fun (or `sort)) ,arg1 ',f . ,args)
(consp (nth 2 form))
(eq (car (nth 2 form)) 'quote))
;; We don't use `maybe-cons' since there's clearly a change. ;; We don't use `maybe-cons' since there's clearly a change.
(cons fun (cons fun
(cons (macroexpand-all-1 (cadr form)) (cons (macroexpand-all-1 arg1)
(cons (macroexpand-all-1 (cons (macroexpand-all-1
(cons 'function (cdr (nth 2 form)))) (list 'function f))
(macroexpand-all-forms (nthcdr 3 form)))))) (macroexpand-all-forms args)))))
(t (`(,_ . ,_)
;; For everything else, we just expand each argument (for ;; For every other list, we just expand each argument (for
;; setq/setq-default this works alright because the variable names ;; setq/setq-default this works alright because the variable names
;; are symbols). ;; are symbols).
(macroexpand-all-forms form 1)))) (macroexpand-all-forms form 1))
form))) (t form))))
;;;###autoload ;;;###autoload
(defun macroexpand-all (form &optional environment) (defun macroexpand-all (form &optional environment)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment