(defvar byte-compiler-error-flag)
-(defvar byte-compile--form-stack nil
- "Dynamic list of successive enclosing forms.
-This is used by the warning message routines to determine a
-source code position. The most accessible element is the current
-most deeply nested form.")
-
(defun byte-compile-recurse-toplevel (form non-toplevel-case)
"Implement `eval-when-compile' and `eval-and-compile'.
Return the compile-time value of FORM."
byte-compile-new-defuns))
(setf result
(byte-compile-eval
- (macroexp-strip-symbol-positions
(byte-compile-top-level
- (byte-compile-preprocess form))))))))
+ (byte-compile-preprocess form)))))))
(list 'quote result))))
(eval-and-compile . ,(lambda (&rest body)
(byte-compile-recurse-toplevel
;; Don't compile here, since we don't know
;; whether to compile as byte-compile-form
;; or byte-compile-file-form.
- (let ((expanded
- (macroexpand--all-toplevel
- form
- macroexpand-all-environment)))
+ (let* ((print-symbols-bare t)
+ (expanded
+ (macroexpand--all-toplevel
+ form
+ macroexpand-all-environment)))
(eval expanded lexical-binding)
expanded)))))
(with-suppressed-warnings
(t 0))))
(defun byte-compile--warning-source-offset ()
- "Return a source offset from `byte-compile--form-stack'.
+ "Return a source offset from `byte-compile-form-stack'.
Return nil if such is not found."
(catch 'offset
- (dolist (form byte-compile--form-stack)
+ (dolist (form byte-compile-form-stack)
(let ((s (byte-compile--first-symbol form)))
(if (symbol-with-pos-p s)
(throw 'offset (symbol-with-pos-pos s)))))))
(defun byte-compile-warn (format &rest args)
"Issue a byte compiler warning; use (format-message FORMAT ARGS...) for message."
- (setq args (mapcar #'macroexp-strip-symbol-positions args))
(setq format (apply #'format-message format args))
(if byte-compile-error-on-warn
(error "%s" format) ; byte-compile-file catches and logs it
ARG is the source element (likely a symbol with position) central to
the warning, intended to supply source position information.
FORMAT and ARGS are as in `byte-compile-warn'."
- (let ((byte-compile--form-stack (cons arg byte-compile--form-stack)))
+ (let ((byte-compile-form-stack (cons arg byte-compile-form-stack)))
(apply #'byte-compile-warn format args)))
(defun byte-compile-warn-obsolete (symbol)
(warning-series-started
(and (markerp warning-series)
(eq (marker-buffer warning-series)
- (get-buffer byte-compile-log-buffer)))))
+ (get-buffer byte-compile-log-buffer))))
+ (byte-compile-form-stack byte-compile-form-stack))
(if (or (eq warning-series 'byte-compile-warning-series)
warning-series-started)
;; warning-series does come from compilation,
(write-region (point-min) (point-max) dynvar-file)))))
(if load
(load target-file))
- t)))
- ;; Strip positions from symbols for the native compiler.
- (setq byte-to-native-top-level-forms
- (macroexp-strip-symbol-positions byte-to-native-top-level-forms))))
+ t)))))
;;; compiling a single function
;;;###autoload
(save-excursion
(end-of-defun)
(beginning-of-defun)
- (let* ((byte-compile-current-file (current-buffer))
+ (let* ((print-symbols-bare t)
+ (byte-compile-current-file (current-buffer))
(byte-compile-current-buffer (current-buffer))
(byte-compile-read-position (point))
(byte-compile-last-position byte-compile-read-position)
(read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
;; (byte-compile-warnings byte-compile-warnings)
- )
+ (symbols-with-pos-enabled t))
(byte-compile-close-variables
(with-current-buffer
(setq byte-compile--outbuffer
;; it here.
(when byte-native-compiling
;; Spill output for the native compiler here
- (push
- (macroexp-strip-symbol-positions
- (make-byte-to-native-top-level :form form :lexical lexical-binding))
- byte-to-native-top-level-forms))
- (let ((print-escape-newlines t)
+ (push (make-byte-to-native-top-level :form form :lexical lexical-binding)
+ byte-to-native-top-level-forms))
+ (let ((print-symbols-bare t)
+ (print-escape-newlines t)
(print-length nil)
(print-level nil)
(print-quoted t)
;; in the input buffer (now current), not in the output buffer.
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
(with-current-buffer byte-compile--outbuffer
- (let (position)
-
+ (let (position
+ (print-symbols-bare t))
;; Insert the doc string, and make it a comment with #@LENGTH.
(and (>= (nth 1 info) 0)
dynamic-docstrings
;; byte-hunk-handlers cannot call this!
(defun byte-compile-toplevel-file-form (top-level-form)
- (let ((byte-compile--form-stack
- (cons top-level-form byte-compile--form-stack)))
- (byte-compile-recurse-toplevel
- top-level-form
- (lambda (form)
- (let ((byte-compile-current-form nil)) ; close over this for warnings.
- (byte-compile-file-form (byte-compile-preprocess form t)))))))
+ ;; (let ((byte-compile-form-stack
+ ;; (cons top-level-form byte-compile-form-stack)))
+ (push top-level-form byte-compile-form-stack)
+ (prog1
+ (byte-compile-recurse-toplevel
+ top-level-form
+ (lambda (form)
+ (let ((byte-compile-current-form nil)) ; close over this for warnings.
+ (byte-compile-file-form (byte-compile-preprocess form t)))))
+ (pop byte-compile-form-stack)))
;; byte-hunk-handlers can call this.
(defun byte-compile-file-form (form)
;; byte-compile-noruntime-functions, in case we have an autoload
;; of foo-func following an (eval-when-compile (require 'foo)).
(unless (fboundp funsym)
- (push (macroexp-strip-symbol-positions
- (cons funsym (cons 'autoload (cdr (cdr form)))))
+ (push (cons funsym (cons 'autoload (cdr (cdr form))))
byte-compile-function-environment))
;; If an autoload occurs _before_ the first call to a function,
;; byte-compile-callargs-warn does not add an entry to
(delq (assq funsym byte-compile-unresolved-functions)
byte-compile-unresolved-functions)))))
(if (stringp (nth 3 form))
- (prog1 (macroexp-strip-symbol-positions form)
+ (prog1
+ form
(byte-compile-docstring-length-warn form))
;; No doc string, so we can compile this as a normal form.
(byte-compile-keep-pending form 'byte-compile-normal-call)))
(byte-compile-top-level (nth 2 form) nil 'file)))
((symbolp (nth 2 form))
(setcar (cddr form) (bare-symbol (nth 2 form))))
- (t (setcar (cddr form)
- (macroexp-strip-symbol-positions (nth 2 form)))))
+ (t (setcar (cddr form) (nth 2 form))))
(setcar form (bare-symbol (car form)))
(if (symbolp (nth 1 form))
(setcar (cdr form) (bare-symbol (nth 1 form))))
(defun byte-compile-file-form-make-obsolete (form)
(prog1 (byte-compile-keep-pending form)
(apply 'make-obsolete
- (mapcar 'eval
- (macroexp-strip-symbol-positions (cdr form))))))
+ (mapcar 'eval (cdr form)))))
(defun byte-compile-file-form-defmumble (name macro arglist body rest)
"Process a `defalias' for NAME.
(when byte-native-compiling
;; Spill output for the native compiler here.
(push
- (macroexp-strip-symbol-positions
(if macro
(make-byte-to-native-top-level
:form `(defalias ',name '(macro . ,code) nil)
:lexical lexical-binding)
(make-byte-to-native-func-def :name name
- :byte-func code)))
- byte-to-native-top-level-forms))
+ :byte-func code))
+ byte-to-native-top-level-forms))
;; Output the form by hand, that's much simpler than having
;; b-c-output-file-form analyze the defalias.
(byte-compile-output-docform
(setq fun (eval fun t)))
(if macro (push 'macro fun))
(if (symbolp form) (fset form fun))
- fun)))
- (setq byte-to-native-top-level-forms
- (macroexp-strip-symbol-positions byte-to-native-top-level-forms)))))))
+ fun))))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."
;; which may include "calls" to
;; internal-make-closure (Bug#29988).
lexical-binding)
- (setq int (macroexp-strip-symbol-positions `(interactive ,newform)))
- (setq int (macroexp-strip-symbol-positions int)))))
+ (setq int `(interactive ,newform)))))
((cdr int) ; Invalid (interactive . something).
(byte-compile-warn-x int "malformed interactive spec: %s"
int))))
(byte-compile-make-lambda-lexenv
arglistvars))
reserved-csts))
- (bare-arglist (macroexp-strip-symbol-positions arglist)))
+ (bare-arglist arglist))
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
(let ((out
(cond
;; We have some command modes, so use the vector form.
(command-modes
- (list (vector (nth 1 int)
- (macroexp-strip-symbol-positions
- command-modes))))
+ (list (vector (nth 1 int) command-modes)))
;; No command modes, use the simple form with just the
;; interactive spec.
(int
;; byte-compile--for-effect flag too.)
;;
(defun byte-compile-form (form &optional for-effect)
- (let ((byte-compile--for-effect for-effect)
- (byte-compile--form-stack (cons form byte-compile--form-stack)))
+ (let ((byte-compile--for-effect for-effect))
+ (push form byte-compile-form-stack)
(cond
((not (consp form))
(cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
(setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))
(if byte-compile--for-effect
- (byte-compile-discard))))
+ (byte-compile-discard))
+ (pop byte-compile-form-stack)))
(defun byte-compile-normal-call (form)
(when (and (symbolp (car form))
(setq const (bare-symbol const)))
(byte-compile-out
'byte-constant
- (byte-compile-get-constant
- (macroexp-strip-symbol-positions const))))
+ (byte-compile-get-constant const)))
\f
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
(dolist (case cases)
(setq tag (byte-compile-make-tag)
- test-objects (macroexp-strip-symbol-positions (car case))
+ test-objects (car case)
body (cdr case))
(byte-compile-out-tag tag)
(dolist (value test-objects)
;;; call tree stuff
(defun byte-compile-annotate-call-tree (form)
- (let ((current-form (macroexp-strip-symbol-positions
+ (let ((current-form (byte-run-strip-symbol-positions
byte-compile-current-form))
- (bare-car-form (macroexp-strip-symbol-positions (car form)))
+ (bare-car-form (byte-run-strip-symbol-positions (car form)))
entry)
;; annotate the current call
(if (setq entry (assq bare-car-form byte-compile-call-tree))
(if (null (batch-byte-compile-file (car command-line-args-left)))
(setq error t))))
(setq command-line-args-left (cdr command-line-args-left)))
- (setq byte-to-native-top-level-forms
- (macroexp-strip-symbol-positions byte-to-native-top-level-forms))
(kill-emacs (if error 1 0))))
(defun batch-byte-compile-file (file)
;;; Code:
+(defvar byte-compile-form-stack nil
+ "Dynamic list of successive enclosing forms.
+This is used by the warning message routines to determine a
+source code position. The most accessible element is the current
+most deeply nested form.
+
+Normally a form is manually pushed onto the list at the beginning
+of `byte-compile-form', etc., and manually popped off at its end.
+This is to preserve the data in it in the event of a
+condition-case handling a signaled error.")
+
;; Bound by the top-level `macroexpand-all', and modified to include any
;; macros defined by `defmacro'.
(defvar macroexpand-all-environment nil)
-(defvar macroexp--ssp-conses-seen nil
- "Which conses have been processed in a strip-symbol-positions operation?")
-(defvar macroexp--ssp-vectors-seen nil
- "Which vectors have been processed in a strip-symbol-positions operation?")
-(defvar macroexp--ssp-records-seen nil
- "Which records have been processed in a strip-symbol-positions operation?")
-
-(defun macroexp--strip-s-p-2 (arg)
- "Strip all positions from symbols in ARG, destructively modifying ARG.
-Return the modified ARG."
- (cond
- ((symbolp arg)
- (bare-symbol arg))
- ((consp arg)
- (unless (and macroexp--ssp-conses-seen
- (gethash arg macroexp--ssp-conses-seen))
- (if macroexp--ssp-conses-seen
- (puthash arg t macroexp--ssp-conses-seen))
- (let ((a arg))
- (while (consp (cdr a))
- (setcar a (macroexp--strip-s-p-2 (car a)))
- (setq a (cdr a)))
- (setcar a (macroexp--strip-s-p-2 (car a)))
- ;; (if (cdr a)
- (unless (bare-symbol-p (cdr a)) ; includes (unpositioned) nil.
- (setcdr a (macroexp--strip-s-p-2 (cdr a))))))
- arg)
- ((vectorp arg)
- (unless (and macroexp--ssp-vectors-seen
- (gethash arg macroexp--ssp-vectors-seen))
- (if macroexp--ssp-vectors-seen
- (puthash arg t macroexp--ssp-vectors-seen))
- (let ((i 0)
- (len (length arg)))
- (while (< i len)
- (aset arg i (macroexp--strip-s-p-2 (aref arg i)))
- (setq i (1+ i)))))
- arg)
- ((recordp arg)
- (unless (and macroexp--ssp-records-seen
- (gethash arg macroexp--ssp-records-seen))
- (if macroexp--ssp-records-seen
- (puthash arg t macroexp--ssp-records-seen))
- (let ((i 0)
- (len (length arg)))
- (while (< i len)
- (aset arg i (macroexp--strip-s-p-2 (aref arg i)))
- (setq i (1+ i)))))
- arg)
- (t arg)))
-
-(defun byte-compile-strip-s-p-1 (arg)
- "Strip all positions from symbols in ARG, destructively modifying ARG.
-Return the modified ARG."
- (condition-case err
- (progn
- (setq macroexp--ssp-conses-seen nil)
- (setq macroexp--ssp-vectors-seen nil)
- (setq macroexp--ssp-records-seen nil)
- (macroexp--strip-s-p-2 arg))
- (recursion-error
- (dolist (tab '(macroexp--ssp-conses-seen macroexp--ssp-vectors-seen
- macroexp--ssp-records-seen))
- (set tab (make-hash-table :test 'eq)))
- (macroexp--strip-s-p-2 arg))
- (error (signal (car err) (cdr err)))))
-
-(defun macroexp-strip-symbol-positions (arg)
- "Strip all positions from symbols (recursively) in ARG. Don't modify ARG."
- (let ((arg1 (copy-tree arg t)))
- (byte-compile-strip-s-p-1 arg1)))
-
(defun macroexp--cons (car cdr original-cons)
"Return ORIGINAL-CONS if the car/cdr of it is `eq' to CAR and CDR, respectively.
If not, return (CAR . CDR)."
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'."
- (if (eq (car-safe form) 'backquote-list*)
- ;; Special-case `backquote-list*', as it is normally a macro that
- ;; generates exceedingly deep expansions from relatively shallow input
- ;; forms. We just process it `in reverse' -- first we expand all the
- ;; arguments, _then_ we expand the top-level definition.
- (macroexpand (macroexp--all-forms form 1)
- macroexpand-all-environment)
- ;; Normal form; get its expansion, and then expand arguments.
- (setq form (macroexp-macroexpand form macroexpand-all-environment))
- ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
- ;; I tried it, it broke the bootstrap :-(
- (pcase form
- (`(cond . ,clauses)
- (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
- (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
- (macroexp--cons
- 'condition-case
- (macroexp--cons err
- (macroexp--cons (macroexp--expand-all body)
- (macroexp--all-clauses handlers 1)
- (cddr form))
- (cdr form))
- form))
- (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
- (push name macroexp--dynvars)
- (macroexp--all-forms form 2))
- (`(function ,(and f `(lambda . ,_)))
- (let ((macroexp--dynvars macroexp--dynvars))
- (macroexp--cons 'function
- (macroexp--cons (macroexp--all-forms f 2)
- nil
- (cdr form))
- form)))
- (`(,(or 'function 'quote) . ,_) form)
- (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
- pcase--dontcare))
- (let ((macroexp--dynvars macroexp--dynvars))
- (macroexp--cons
- fun
- (macroexp--cons
- (macroexp--all-clauses bindings 1)
- (if (null body)
- (macroexp-unprogn
- (macroexp-warn-and-return
- fun
- (format "Empty %s body" fun)
- nil nil 'compile-only))
- (macroexp--all-forms body))
- (cdr form))
- form)))
- (`(,(and fun `(lambda . ,_)) . ,args)
- ;; Embedded lambda in function position.
- ;; If the byte-optimizer is loaded, try to unfold this,
- ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
- ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
- ;; creation of a closure, thus resulting in much better code.
- (let ((newform (macroexp--unfold-lambda form)))
- (if (eq newform form)
- ;; Unfolding failed for some reason, avoid infinite recursion.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form)
- (macroexp--expand-all newform))))
-
- (`(funcall . ,(or `(,exp . ,args) pcase--dontcare))
- (let ((eexp (macroexp--expand-all exp))
- (eargs (macroexp--all-forms args)))
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro, or to unfold it.
- (pcase eexp
- (`#',f (macroexp--expand-all `(,f . ,eargs)))
- (_ `(funcall ,eexp . ,eargs)))))
- (`(,func . ,_)
- (let ((handler (function-get func 'compiler-macro))
- (funargs (function-get func 'funarg-positions)))
- ;; Check functions quoted with ' rather than with #'
- (dolist (funarg funargs)
- (let ((arg (nth funarg form)))
- (when (and (eq 'quote (car-safe arg))
- (eq 'lambda (car-safe (cadr arg))))
- (setcar (nthcdr funarg form)
- (macroexp-warn-and-return
- (cadr arg)
- (format "%S quoted with ' rather than with #'"
- (let ((f (cadr arg)))
- (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
- arg)))))
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- (if (null handler)
- ;; No compiler macro. We just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexp--all-forms form 1)
- ;; If the handler is not loaded yet, try (auto)loading the
- ;; function itself, which may in turn load the handler.
- (unless (functionp handler)
- (with-demoted-errors "macroexp--expand-all: %S"
- (autoload-do-load (indirect-function func) func)))
- (let ((newform (macroexp--compiler-macro handler form)))
- (if (eq form newform)
- ;; The compiler macro did not find anything to do.
- (if (equal form (setq newform (macroexp--all-forms form 1)))
- form
- ;; Maybe after processing the args, some new opportunities
- ;; appeared, so let's try the compiler macro again.
- (setq form (macroexp--compiler-macro handler newform))
- (if (eq newform form)
- newform
- (macroexp--expand-all newform)))
- (macroexp--expand-all newform))))))
-
- (_ form))))
+ (push form byte-compile-form-stack)
+ (prog1
+ (if (eq (car-safe form) 'backquote-list*)
+ ;; Special-case `backquote-list*', as it is normally a macro that
+ ;; generates exceedingly deep expansions from relatively shallow input
+ ;; forms. We just process it `in reverse' -- first we expand all the
+ ;; arguments, _then_ we expand the top-level definition.
+ (macroexpand (macroexp--all-forms form 1)
+ macroexpand-all-environment)
+ ;; Normal form; get its expansion, and then expand arguments.
+ (setq form (macroexp-macroexpand form macroexpand-all-environment))
+ ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
+ ;; I tried it, it broke the bootstrap :-(
+ (pcase form
+ (`(cond . ,clauses)
+ (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
+ (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
+ (macroexp--cons
+ 'condition-case
+ (macroexp--cons err
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
+ form))
+ (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
+ (push name macroexp--dynvars)
+ (macroexp--all-forms form 2))
+ (`(function ,(and f `(lambda . ,_)))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons 'function
+ (macroexp--cons (macroexp--all-forms f 2)
+ nil
+ (cdr form))
+ form)))
+ (`(,(or 'function 'quote) . ,_) form)
+ (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+ pcase--dontcare))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons
+ fun
+ (macroexp--cons
+ (macroexp--all-clauses bindings 1)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp-warn-and-return
+ fun
+ (format "Empty %s body" fun)
+ nil nil 'compile-only))
+ (macroexp--all-forms body))
+ (cdr form))
+ form)))
+ (`(,(and fun `(lambda . ,_)) . ,args)
+ ;; Embedded lambda in function position.
+ ;; If the byte-optimizer is loaded, try to unfold this,
+ ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
+ ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
+ ;; creation of a closure, thus resulting in much better code.
+ (let ((newform (macroexp--unfold-lambda form)))
+ (if (eq newform form)
+ ;; Unfolding failed for some reason, avoid infinite recursion.
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form)
+ (macroexp--expand-all newform))))
+ (`(funcall . ,(or `(,exp . ,args) pcase--dontcare))
+ (let ((eexp (macroexp--expand-all exp))
+ (eargs (macroexp--all-forms args)))
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro, or to unfold it.
+ (pcase eexp
+ (`#',f (macroexp--expand-all `(,f . ,eargs)))
+ (_ `(funcall ,eexp . ,eargs)))))
+ (`(,func . ,_)
+ (let ((handler (function-get func 'compiler-macro))
+ (funargs (function-get func 'funarg-positions)))
+ ;; Check functions quoted with ' rather than with #'
+ (dolist (funarg funargs)
+ (let ((arg (nth funarg form)))
+ (when (and (eq 'quote (car-safe arg))
+ (eq 'lambda (car-safe (cadr arg))))
+ (setcar (nthcdr funarg form)
+ (macroexp-warn-and-return
+ (cadr arg)
+ (format "%S quoted with ' rather than with #'"
+ (let ((f (cadr arg)))
+ (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
+ arg)))))
+ ;; Macro expand compiler macros. This cannot be delayed to
+ ;; byte-optimize-form because the output of the compiler-macro can
+ ;; use macros.
+ (if (null handler)
+ ;; No compiler macro. We just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexp--all-forms form 1)
+ ;; If the handler is not loaded yet, try (auto)loading the
+ ;; function itself, which may in turn load the handler.
+ (unless (functionp handler)
+ (with-demoted-errors "macroexp--expand-all: %S"
+ (autoload-do-load (indirect-function func) func)))
+ (let ((newform (macroexp--compiler-macro handler form)))
+ (if (eq form newform)
+ ;; The compiler macro did not find anything to do.
+ (if (equal form (setq newform (macroexp--all-forms form 1)))
+ form
+ ;; Maybe after processing the args, some new opportunities
+ ;; appeared, so let's try the compiler macro again.
+ (setq form (macroexp--compiler-macro handler newform))
+ (if (eq newform form)
+ newform
+ (macroexp--expand-all newform)))
+ (macroexp--expand-all newform))))))
+
+ (_ form)))
+ (pop byte-compile-form-stack)))
;; Record which arguments expect functions, so we can warn when those
;; are accidentally quoted with ' rather than with #'
(defun internal-macroexpand-for-load (form full-p)
;; Called from the eager-macroexpansion in readevalloop.
- (setq form (macroexp-strip-symbol-positions form))
- (cond
- ;; Don't repeat the same warning for every top-level element.
- ((eq 'skip (car macroexp--pending-eager-loads)) form)
- ;; If we detect a cycle, skip macro-expansion for now, and output a warning
- ;; with a trimmed backtrace.
- ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
- (let* ((bt (delq nil
- (mapcar #'macroexp--trim-backtrace-frame
- (macroexp--backtrace))))
- (elem `(load ,(file-name-nondirectory load-file-name)))
- (tail (member elem (cdr (member elem bt)))))
- (if tail (setcdr tail (list '…)))
- (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
- (if macroexp--debug-eager
- (debug 'eager-macroexp-cycle)
- (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
- (mapconcat #'prin1-to-string (nreverse bt) " => ")))
- (push 'skip macroexp--pending-eager-loads)
- form))
- (t
- (condition-case err
- (let ((macroexp--pending-eager-loads
- (cons load-file-name macroexp--pending-eager-loads)))
- (if full-p
- (macroexpand--all-toplevel form)
- (macroexpand form)))
- (error
- ;; Hopefully this shouldn't happen thanks to the cycle detection,
- ;; but in case it does happen, let's catch the error and give the
- ;; code a chance to macro-expand later.
- (message "Eager macro-expansion failure: %S" err)
- form)))))
+ (let ((symbols-with-pos-enabled t)
+ (print-symbols-bare t))
+ (cond
+ ;; Don't repeat the same warning for every top-level element.
+ ((eq 'skip (car macroexp--pending-eager-loads)) form)
+ ;; If we detect a cycle, skip macro-expansion for now, and output a warning
+ ;; with a trimmed backtrace.
+ ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
+ (let* ((bt (delq nil
+ (mapcar #'macroexp--trim-backtrace-frame
+ (macroexp--backtrace))))
+ (elem `(load ,(file-name-nondirectory load-file-name)))
+ (tail (member elem (cdr (member elem bt)))))
+ (if tail (setcdr tail (list '…)))
+ (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
+ (if macroexp--debug-eager
+ (debug 'eager-macroexp-cycle)
+ (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
+ (mapconcat #'prin1-to-string (nreverse bt) " => ")))
+ (push 'skip macroexp--pending-eager-loads)
+ form))
+ (t
+ (condition-case err
+ (let ((macroexp--pending-eager-loads
+ (cons load-file-name macroexp--pending-eager-loads)))
+ (if full-p
+ (macroexpand--all-toplevel form)
+ (macroexpand form)))
+ (error
+ ;; Hopefully this shouldn't happen thanks to the cycle detection,
+ ;; but in case it does happen, let's catch the error and give the
+ ;; code a chance to macro-expand later.
+ (message "Eager macro-expansion failure: %S" err)
+ form))))))
;; ¡¡¡ Big Ugly Hack !!!
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
projects / emacs.git / commitdiff