Commit fa779ab0 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/macroexp.el: Don't require CL since we don't use it.

(macroexp--cons): Rename from maybe-cons.
(macroexp--accumulate): Rename from macroexp-accumulate.
(macroexp--all-forms): Rename from macroexpand-all-forms.
(macroexp--all-clauses): Rename from macroexpand-all-clauses.
(macroexp--expand-all): Rename from macroexpand-all-1.
parent 628299e0
2012-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/macroexp.el: Don't require CL since we don't use it.
(macroexp--cons): Rename from maybe-cons.
(macroexp--accumulate): Rename from macroexp-accumulate.
(macroexp--all-forms): Rename from macroexpand-all-forms.
(macroexp--all-clauses): Rename from macroexpand-all-clauses.
(macroexp--expand-all): Rename from macroexpand-all-1.
2012-06-06 Sam Steingold <sds@gnu.org> 2012-06-06 Sam Steingold <sds@gnu.org>
   
* calendar/calendar.el (calendar-in-read-only-buffer): * calendar/calendar.el (calendar-in-read-only-buffer):
......
...@@ -29,13 +29,11 @@ ...@@ -29,13 +29,11 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
;; Bound by the top-level `macroexpand-all', and modified to include any ;; Bound by the top-level `macroexpand-all', and modified to include any
;; macros defined by `defmacro'. ;; macros defined by `defmacro'.
(defvar macroexpand-all-environment nil) (defvar macroexpand-all-environment nil)
(defun maybe-cons (car cdr original-cons) (defun macroexp--cons (car cdr original-cons)
"Return (CAR . CDR), using ORIGINAL-CONS if possible." "Return (CAR . CDR), using ORIGINAL-CONS if possible."
(if (and (eq car (car original-cons)) (eq cdr (cdr original-cons))) (if (and (eq car (car original-cons)) (eq cdr (cdr original-cons)))
original-cons original-cons
...@@ -43,9 +41,9 @@ ...@@ -43,9 +41,9 @@
;; We use this special macro to iteratively process forms and share list ;; We use this special macro to iteratively process forms and share list
;; structure of the result with the input. Doing so recursively using ;; structure of the result with the input. Doing so recursively using
;; `maybe-cons' results in excessively deep recursion for very long ;; `macroexp--cons' results in excessively deep recursion for very long
;; input forms. ;; input forms.
(defmacro macroexp-accumulate (var+list &rest body) (defmacro macroexp--accumulate (var+list &rest body)
"Return a list of the results of evaluating BODY for each element of LIST. "Return a list of the results of evaluating BODY for each element of LIST.
Evaluate BODY with VAR bound to each `car' from LIST, in turn. Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Return a list of the values of the final form in BODY. Return a list of the values of the final form in BODY.
...@@ -76,27 +74,27 @@ result will be eq to LIST). ...@@ -76,27 +74,27 @@ result will be eq to LIST).
(setq ,tail (cdr ,tail))) (setq ,tail (cdr ,tail)))
(nconc (nreverse ,unshared) ,shared)))) (nconc (nreverse ,unshared) ,shared))))
(defun macroexpand-all-forms (forms &optional skip) (defun macroexp--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.
If SKIP is non-nil, then don't expand that many elements at the start of If SKIP is non-nil, then don't expand that many elements at the start of
FORMS." FORMS."
(macroexp-accumulate (form forms) (macroexp--accumulate (form forms)
(if (or (null skip) (zerop skip)) (if (or (null skip) (zerop skip))
(macroexpand-all-1 form) (macroexp--expand-all form)
(setq skip (1- skip)) (setq skip (1- skip))
form))) form)))
(defun macroexpand-all-clauses (clauses &optional skip) (defun macroexp--all-clauses (clauses &optional skip)
"Return CLAUSES with macros expanded. "Return CLAUSES with macros expanded.
CLAUSES is a list of lists of forms; any clause that's not a list is ignored. CLAUSES is a list of lists of forms; any clause that's not a list is ignored.
If SKIP is non-nil, then don't expand that many elements at the start of If SKIP is non-nil, then don't expand that many elements at the start of
each clause." each clause."
(macroexp-accumulate (clause clauses) (macroexp--accumulate (clause clauses)
(if (listp clause) (if (listp clause)
(macroexpand-all-forms clause skip) (macroexp--all-forms clause skip)
clause))) clause)))
(defun macroexpand-all-1 (form) (defun macroexp--expand-all (form)
"Expand all macros in FORM. "Expand all macros in FORM.
This is an internal version of `macroexpand-all'. This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'." Assumes the caller has bound `macroexpand-all-environment'."
...@@ -105,7 +103,7 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -105,7 +103,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; generates exceedingly deep expansions from relatively shallow input ;; generates exceedingly deep expansions from relatively shallow input
;; forms. We just process it `in reverse' -- first we expand all the ;; forms. We just process it `in reverse' -- first we expand all the
;; arguments, _then_ we expand the top-level definition. ;; arguments, _then_ we expand the top-level definition.
(macroexpand (macroexpand-all-forms form 1) (macroexpand (macroexp--all-forms form 1)
macroexpand-all-environment) macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments. ;; Normal form; get its expansion, and then expand arguments.
(let ((new-form (macroexpand form macroexpand-all-environment))) (let ((new-form (macroexpand form macroexpand-all-environment)))
...@@ -118,34 +116,34 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -118,34 +116,34 @@ Assumes the caller has bound `macroexpand-all-environment'."
(setq form new-form)) (setq form new-form))
(pcase form (pcase form
(`(cond . ,clauses) (`(cond . ,clauses)
(maybe-cons 'cond (macroexpand-all-clauses clauses) form)) (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
(`(condition-case . ,(or `(,err ,body . ,handlers) dontcare)) (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
(maybe-cons (macroexp--cons
'condition-case 'condition-case
(maybe-cons err (macroexp--cons err
(maybe-cons (macroexpand-all-1 body) (macroexp--cons (macroexp--expand-all body)
(macroexpand-all-clauses handlers 1) (macroexp--all-clauses handlers 1)
(cddr form)) (cddr form))
(cdr form)) (cdr form))
form)) form))
(`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2)) (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
(`(function ,(and f `(lambda . ,_))) (`(function ,(and f `(lambda . ,_)))
(maybe-cons 'function (macroexp--cons 'function
(maybe-cons (macroexpand-all-forms f 2) (macroexp--cons (macroexp--all-forms f 2)
nil nil
(cdr form)) (cdr form))
form)) form))
(`(,(or `function `quote) . ,_) form) (`(,(or `function `quote) . ,_) form)
(`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare)) (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
(maybe-cons fun (macroexp--cons fun
(maybe-cons (macroexpand-all-clauses bindings 1) (macroexp--cons (macroexp--all-clauses bindings 1)
(macroexpand-all-forms body) (macroexp--all-forms body)
(cdr form)) (cdr form))
form)) form))
(`(,(and fun `(lambda . ,_)) . ,args) (`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position. ;; Embedded lambda in function position.
(maybe-cons (macroexpand-all-forms fun 2) (macroexp--cons (macroexp--all-forms fun 2)
(macroexpand-all-forms args) (macroexp--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
...@@ -161,22 +159,22 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -161,22 +159,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
(format "%s quoted with ' rather than with #'" (format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...)) (list 'lambda (nth 1 f) '...))
t) t)
;; We don't use `maybe-cons' since there's clearly a change. ;; We don't use `macroexp--cons' since there's clearly a change.
(cons fun (cons fun
(cons (macroexpand-all-1 (list 'function f)) (cons (macroexp--expand-all (list 'function f))
(macroexpand-all-forms args)))) (macroexp--all-forms args))))
;; Second arg is a function: ;; Second arg is a function:
(`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args) (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
(byte-compile-log-warning (byte-compile-log-warning
(format "%s quoted with ' rather than with #'" (format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...)) (list 'lambda (nth 1 f) '...))
t) t)
;; We don't use `maybe-cons' since there's clearly a change. ;; We don't use `macroexp--cons' since there's clearly a change.
(cons fun (cons fun
(cons (macroexpand-all-1 arg1) (cons (macroexp--expand-all arg1)
(cons (macroexpand-all-1 (cons (macroexp--expand-all
(list 'function f)) (list 'function f))
(macroexpand-all-forms args))))) (macroexp--all-forms args)))))
(`(,func . ,_) (`(,func . ,_)
;; Macro expand compiler macros. This cannot be delayed to ;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can ;; byte-optimize-form because the output of the compiler-macro can
...@@ -196,14 +194,14 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -196,14 +194,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; No compiler macro. We just expand each argument (for ;; No compiler macro. 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) (macroexp--all-forms form 1)
(let ((newform (condition-case err (let ((newform (condition-case err
(apply handler form (cdr form)) (apply handler form (cdr form))
(error (message "Compiler-macro error: %S" err) (error (message "Compiler-macro error: %S" err)
form)))) form))))
(if (eq form newform) (if (eq form newform)
;; The compiler macro did not find anything to do. ;; The compiler macro did not find anything to do.
(if (equal form (setq newform (macroexpand-all-forms form 1))) (if (equal form (setq newform (macroexp--all-forms form 1)))
form form
;; Maybe after processing the args, some new opportunities ;; Maybe after processing the args, some new opportunities
;; appeared, so let's try the compiler macro again. ;; appeared, so let's try the compiler macro again.
...@@ -213,8 +211,8 @@ Assumes the caller has bound `macroexpand-all-environment'." ...@@ -213,8 +211,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
newform))) newform)))
(if (eq newform form) (if (eq newform form)
newform newform
(macroexpand-all-1 newform))) (macroexp--expand-all newform)))
(macroexpand-all-1 newform)))))) (macroexp--expand-all newform))))))
(t form)))) (t form))))
...@@ -225,7 +223,7 @@ If no macros are expanded, FORM is returned unchanged. ...@@ -225,7 +223,7 @@ If no macros are expanded, FORM is returned unchanged.
The second optional arg ENVIRONMENT specifies an environment of macro The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation." definitions to shadow the loaded ones for use in file byte-compilation."
(let ((macroexpand-all-environment environment)) (let ((macroexpand-all-environment environment))
(macroexpand-all-1 form))) (macroexp--expand-all form)))
(provide 'macroexp) (provide 'macroexp)
......
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