LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - macroexp.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 170 260 65.4 %
Date: 2017-08-30 10:12:24 Functions: 23 30 76.7 %

          Line data    Source code
       1             : ;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
       2             : ;;
       3             : ;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
       4             : ;;
       5             : ;; Author: Miles Bader <miles@gnu.org>
       6             : ;; Keywords: lisp, compiler, macros
       7             : 
       8             : ;; This file is part of GNU Emacs.
       9             : 
      10             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      11             : ;; it under the terms of the GNU General Public License as published by
      12             : ;; the Free Software Foundation, either version 3 of the License, or
      13             : ;; (at your option) any later version.
      14             : 
      15             : ;; GNU Emacs is distributed in the hope that it will be useful,
      16             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      17             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      18             : ;; GNU General Public License for more details.
      19             : 
      20             : ;; You should have received a copy of the GNU General Public License
      21             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Commentary:
      24             : ;;
      25             : ;; This file contains macro-expansions functions that are not defined in
      26             : ;; the Lisp core, namely `macroexpand-all', which expands all macros in
      27             : ;; a form, not just a top-level one.
      28             : 
      29             : ;;; Code:
      30             : 
      31             : ;; Bound by the top-level `macroexpand-all', and modified to include any
      32             : ;; macros defined by `defmacro'.
      33             : (defvar macroexpand-all-environment nil)
      34             : 
      35             : (defun macroexp--cons (car cdr original-cons)
      36             :   "Return (CAR . CDR), using ORIGINAL-CONS if possible."
      37      152454 :   (if (and (eq car (car original-cons)) (eq cdr (cdr original-cons)))
      38      117562 :       original-cons
      39      152454 :     (cons car cdr)))
      40             : 
      41             : ;; We use this special macro to iteratively process forms and share list
      42             : ;; structure of the result with the input.  Doing so recursively using
      43             : ;; `macroexp--cons' results in excessively deep recursion for very long
      44             : ;; input forms.
      45             : (defmacro macroexp--accumulate (var+list &rest body)
      46             :   "Return a list of the results of evaluating BODY for each element of LIST.
      47             : Evaluate BODY with VAR bound to each `car' from LIST, in turn.
      48             : Return a list of the values of the final form in BODY.
      49             : The list structure of the result will share as much with LIST as
      50             : possible (for instance, when BODY just returns VAR unchanged, the
      51             : result will be eq to LIST).
      52             : 
      53             : \(fn (VAR LIST) BODY...)"
      54             :   (declare (indent 1))
      55           2 :   (let ((var (car var+list))
      56           2 :         (list (cadr var+list))
      57           2 :         (shared (make-symbol "shared"))
      58           2 :         (unshared (make-symbol "unshared"))
      59           2 :         (tail (make-symbol "tail"))
      60           2 :         (new-el (make-symbol "new-el")))
      61           2 :     `(let* ((,shared ,list)
      62           2 :             (,unshared nil)
      63           2 :             (,tail ,shared)
      64           2 :             ,var ,new-el)
      65           2 :        (while (consp ,tail)
      66           2 :          (setq ,var (car ,tail)
      67           2 :                ,new-el (progn ,@body))
      68           2 :          (unless (eq ,var ,new-el)
      69           2 :            (while (not (eq ,shared ,tail))
      70           2 :              (push (pop ,shared) ,unshared))
      71           2 :            (setq ,shared (cdr ,shared))
      72           2 :            (push ,new-el ,unshared))
      73           2 :          (setq ,tail (cdr ,tail)))
      74           2 :        (nconc (nreverse ,unshared) ,shared))))
      75             : 
      76             : (defun macroexp--all-forms (forms &optional skip)
      77             :   "Return FORMS with macros expanded.  FORMS is a list of forms.
      78             : If SKIP is non-nil, then don't expand that many elements at the start of
      79             : FORMS."
      80      772908 :   (macroexp--accumulate (form forms)
      81             :     (if (or (null skip) (zerop skip))
      82             :         (macroexp--expand-all form)
      83             :       (setq skip (1- skip))
      84      772908 :       form)))
      85             : 
      86             : (defun macroexp--all-clauses (clauses &optional skip)
      87             :   "Return CLAUSES with macros expanded.
      88             : CLAUSES is a list of lists of forms; any clause that's not a list is ignored.
      89             : If SKIP is non-nil, then don't expand that many elements at the start of
      90             : each clause."
      91       61280 :   (macroexp--accumulate (clause clauses)
      92             :     (if (listp clause)
      93             :         (macroexp--all-forms clause skip)
      94       61280 :       clause)))
      95             : 
      96             : (defun macroexp--compiler-macro (handler form)
      97        9342 :   (condition-case err
      98        9342 :       (apply handler form (cdr form))
      99             :     (error
     100           0 :      (message "Compiler-macro error for %S: %S" (car form) err)
     101        9342 :            form)))
     102             : 
     103             : (defun macroexp--funcall-if-compiled (_form)
     104             :   "Pseudo function used internally by macroexp to delay warnings.
     105             : The purpose is to delay warnings to bytecomp.el, so they can use things
     106             : like `byte-compile-warn' to get better file-and-line-number data
     107             : and also to avoid outputting the warning during normal execution."
     108             :   nil)
     109             : (put 'macroexp--funcall-if-compiled 'byte-compile
     110             :      (lambda (form)
     111             :        (funcall (eval (cadr form)))
     112             :        (byte-compile-constant nil)))
     113             : 
     114             : (defun macroexp--compiling-p ()
     115             :   "Return non-nil if we're macroexpanding for the compiler."
     116             :   ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
     117             :   ;; macro-expansion will be processed by the byte-compiler, we check
     118             :   ;; circumstantial evidence.
     119           6 :   (member '(declare-function . byte-compile-macroexpand-declare-function)
     120           6 :           macroexpand-all-environment))
     121             : 
     122             : (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
     123             : 
     124             : (defun macroexp--warn-and-return (msg form &optional compile-only)
     125           0 :   (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
     126           0 :     (cond
     127           0 :      ((null msg) form)
     128           0 :      ((macroexp--compiling-p)
     129           0 :       (if (gethash form macroexp--warned)
     130             :           ;; Already wrapped this exp with a warning: avoid inf-looping
     131             :           ;; where we keep adding the same warning onto `form' because
     132             :           ;; macroexpand-all gets right back to macroexpanding `form'.
     133           0 :           form
     134           0 :         (puthash form form macroexp--warned)
     135           0 :         `(progn
     136           0 :            (macroexp--funcall-if-compiled ',when-compiled)
     137           0 :            ,form)))
     138             :      (t
     139           0 :       (unless compile-only
     140           0 :         (message "%s%s" (if (stringp load-file-name)
     141           0 :                             (concat (file-relative-name load-file-name) ": ")
     142           0 :                           "")
     143           0 :                  msg))
     144           0 :       form))))
     145             : 
     146             : (defun macroexp--obsolete-warning (fun obsolescence-data type)
     147           0 :   (let ((instead (car obsolescence-data))
     148           0 :         (asof (nth 2 obsolescence-data)))
     149           0 :     (format-message
     150           0 :      "`%s' is an obsolete %s%s%s" fun type
     151           0 :      (if asof (concat " (as of " asof ")") "")
     152           0 :      (cond ((stringp instead) (concat "; " (substitute-command-keys instead)))
     153           0 :            (instead (format-message "; use `%s' instead." instead))
     154           0 :            (t ".")))))
     155             : 
     156             : (defun macroexpand-1 (form &optional environment)
     157             :   "Perform (at most) one step of macroexpansion."
     158         366 :   (cond
     159         366 :    ((consp form)
     160         366 :     (let* ((head (car form))
     161         366 :            (env-expander (assq head environment)))
     162         366 :       (if env-expander
     163           0 :           (if (cdr env-expander)
     164           0 :               (apply (cdr env-expander) (cdr form))
     165           0 :             form)
     166         366 :         (if (not (and (symbolp head) (fboundp head)))
     167           0 :             form
     168         366 :           (let ((def (autoload-do-load (symbol-function head) head 'macro)))
     169         366 :             (cond
     170             :              ;; Follow alias, but only for macros, otherwise we may end up
     171             :              ;; skipping an important compiler-macro (e.g. cl--block-wrapper).
     172         366 :              ((and (symbolp def) (macrop def)) (cons def (cdr form)))
     173         366 :              ((not (consp def)) form)
     174             :              (t
     175         242 :               (if (eq 'macro (car def))
     176         124 :                   (apply (cdr def) (cdr form))
     177         366 :                 form))))))))
     178         366 :    (t form)))
     179             : 
     180             : (defun macroexp-macroexpand (form env)
     181             :   "Like `macroexpand' but checking obsolescence."
     182     1513090 :   (let ((new-form
     183     1513090 :          (macroexpand form env)))
     184     1513090 :     (if (and (not (eq form new-form))   ;It was a macro call.
     185       26501 :              (car-safe form)
     186       26501 :              (symbolp (car form))
     187       26501 :              (get (car form) 'byte-obsolete-info)
     188           0 :              (or (not (fboundp 'byte-compile-warning-enabled-p))
     189     1513090 :                  (byte-compile-warning-enabled-p 'obsolete)))
     190           0 :         (let* ((fun (car form))
     191           0 :                (obsolete (get fun 'byte-obsolete-info)))
     192           0 :           (macroexp--warn-and-return
     193           0 :            (macroexp--obsolete-warning
     194           0 :             fun obsolete
     195           0 :             (if (symbolp (symbol-function fun))
     196           0 :                 "alias" "macro"))
     197           0 :            new-form))
     198     1513090 :       new-form)))
     199             : 
     200             : (defun macroexp--expand-all (form)
     201             :   "Expand all macros in FORM.
     202             : This is an internal version of `macroexpand-all'.
     203             : Assumes the caller has bound `macroexpand-all-environment'."
     204     1511709 :   (if (eq (car-safe form) 'backquote-list*)
     205             :       ;; Special-case `backquote-list*', as it is normally a macro that
     206             :       ;; generates exceedingly deep expansions from relatively shallow input
     207             :       ;; forms.  We just process it `in reverse' -- first we expand all the
     208             :       ;; arguments, _then_ we expand the top-level definition.
     209         133 :       (macroexpand (macroexp--all-forms form 1)
     210         133 :                    macroexpand-all-environment)
     211             :     ;; Normal form; get its expansion, and then expand arguments.
     212     1511576 :     (setq form (macroexp-macroexpand form macroexpand-all-environment))
     213     1511576 :     (pcase form
     214             :       (`(cond . ,clauses)
     215         774 :        (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
     216             :       (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
     217        9929 :        (macroexp--cons
     218             :         'condition-case
     219        9929 :         (macroexp--cons err
     220        9929 :                         (macroexp--cons (macroexp--expand-all body)
     221        9929 :                                         (macroexp--all-clauses handlers 1)
     222        9929 :                                         (cddr form))
     223        9929 :                         (cdr form))
     224        9929 :         form))
     225        1945 :       (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
     226             :       (`(function ,(and f `(lambda . ,_)))
     227       10341 :        (macroexp--cons 'function
     228       10341 :                        (macroexp--cons (macroexp--all-forms f 2)
     229             :                                        nil
     230       10341 :                                        (cdr form))
     231       10341 :                        form))
     232      125735 :       (`(,(or `function `quote) . ,_) form)
     233             :       (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
     234       50462 :        (macroexp--cons fun
     235       50462 :                        (macroexp--cons (macroexp--all-clauses bindings 1)
     236       50462 :                                        (macroexp--all-forms body)
     237       50462 :                                        (cdr form))
     238       50462 :                        form))
     239             :       (`(,(and fun `(lambda . ,_)) . ,args)
     240             :        ;; Embedded lambda in function position.
     241           0 :        (macroexp--cons (macroexp--all-forms fun 2)
     242           0 :                        (macroexp--all-forms args)
     243           0 :                        form))
     244             :       ;; The following few cases are for normal function calls that
     245             :       ;; are known to funcall one of their arguments.  The byte
     246             :       ;; compiler has traditionally handled these functions specially
     247             :       ;; by treating a lambda expression quoted by `quote' as if it
     248             :       ;; were quoted by `function'.  We make the same transformation
     249             :       ;; here, so that any code that cares about the difference will
     250             :       ;; see the same transformation.
     251             :       ;; First arg is a function:
     252             :       (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
     253             :          ',(and f `(lambda . ,_)) . ,args)
     254           0 :        (macroexp--warn-and-return
     255           0 :         (format "%s quoted with ' rather than with #'"
     256           0 :                 (list 'lambda (nth 1 f) '...))
     257           0 :         (macroexp--expand-all `(,fun ,f . ,args))))
     258             :       ;; Second arg is a function:
     259             :       (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
     260           0 :        (macroexp--warn-and-return
     261           0 :         (format "%s quoted with ' rather than with #'"
     262           0 :                 (list 'lambda (nth 1 f) '...))
     263           0 :         (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
     264             :       (`(funcall #',(and f (pred symbolp)) . ,args)
     265             :        ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
     266             :        ;; has a compiler-macro.
     267          17 :        (macroexp--expand-all `(,f . ,args)))
     268             :       (`(,func . ,_)
     269             :        ;; Macro expand compiler macros.  This cannot be delayed to
     270             :        ;; byte-optimize-form because the output of the compiler-macro can
     271             :        ;; use macros.
     272      648589 :        (let ((handler (function-get func 'compiler-macro)))
     273      648589 :          (if (null handler)
     274             :              ;; No compiler macro.  We just expand each argument (for
     275             :              ;; setq/setq-default this works alright because the variable names
     276             :              ;; are symbols).
     277      639419 :              (macroexp--all-forms form 1)
     278             :            ;; If the handler is not loaded yet, try (auto)loading the
     279             :            ;; function itself, which may in turn load the handler.
     280        9170 :            (unless (functionp handler)
     281           0 :              (with-demoted-errors "macroexp--expand-all: %S"
     282        9170 :                (autoload-do-load (indirect-function func) func)))
     283        9170 :            (let ((newform (macroexp--compiler-macro handler form)))
     284        9170 :              (if (eq form newform)
     285             :                  ;; The compiler macro did not find anything to do.
     286         470 :                  (if (equal form (setq newform (macroexp--all-forms form 1)))
     287         300 :                      form
     288             :                    ;; Maybe after processing the args, some new opportunities
     289             :                    ;; appeared, so let's try the compiler macro again.
     290         170 :                    (setq form (macroexp--compiler-macro handler newform))
     291         170 :                    (if (eq newform form)
     292          66 :                        newform
     293         470 :                      (macroexp--expand-all newform)))
     294      648589 :                (macroexp--expand-all newform))))))
     295             : 
     296     1511709 :       (_ form))))
     297             : 
     298             : ;;;###autoload
     299             : (defun macroexpand-all (form &optional environment)
     300             :   "Return result of expanding macros at all levels in FORM.
     301             : If no macros are expanded, FORM is returned unchanged.
     302             : The second optional arg ENVIRONMENT specifies an environment of macro
     303             : definitions to shadow the loaded ones for use in file byte-compilation."
     304       20492 :   (let ((macroexpand-all-environment environment))
     305       20492 :     (macroexp--expand-all form)))
     306             : 
     307             : ;;; Handy functions to use in macros.
     308             : 
     309             : (defun macroexp-parse-body (body)
     310             :   "Parse a function BODY into (DECLARATIONS . EXPS)."
     311         715 :   (let ((decls ()))
     312        1115 :     (while (and (cdr body)
     313         554 :                 (let ((e (car body)))
     314         554 :                   (or (stringp e)
     315         355 :                       (memq (car-safe e)
     316        1115 :                             '(:documentation declare interactive cl-declare)))))
     317         800 :       (push (pop body) decls))
     318         715 :     (cons (nreverse decls) body)))
     319             : 
     320             : (defun macroexp-progn (exps)
     321             :   "Return an expression equivalent to `(progn ,@EXPS)."
     322        5344 :   (if (cdr exps) `(progn ,@exps) (car exps)))
     323             : 
     324             : (defun macroexp-unprogn (exp)
     325             :   "Turn EXP into a list of expressions to execute in sequence.
     326             : Never returns an empty list."
     327         389 :   (if (eq (car-safe exp) 'progn) (or (cdr exp) '(nil)) (list exp)))
     328             : 
     329             : (defun macroexp-let* (bindings exp)
     330             :   "Return an expression equivalent to `(let* ,bindings ,exp)."
     331        1760 :   (cond
     332        1760 :    ((null bindings) exp)
     333        1025 :    ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
     334        1760 :    (t `(let* ,bindings ,exp))))
     335             : 
     336             : (defun macroexp-if (test then else)
     337             :   "Return an expression equivalent to `(if ,TEST ,THEN ,ELSE)."
     338         190 :   (cond
     339         190 :    ((eq (car-safe else) 'if)
     340          37 :     (cond
     341             :      ;; Drop this optimization: It's unsafe (it assumes that `test' is
     342             :      ;; pure, or at least idempotent), and it's not used even a single
     343             :      ;; time while compiling Emacs's sources.
     344             :      ;;((equal test (nth 1 else))
     345             :      ;; ;; Doing a test a second time: get rid of the redundancy.
     346             :      ;; (message "macroexp-if: sharing 'test' %S" test)
     347             :      ;; `(if ,test ,then ,@(nthcdr 3 else)))
     348          37 :      ((equal then (nth 2 else))
     349             :       ;; (message "macroexp-if: sharing 'then' %S" then)
     350           1 :       `(if (or ,test ,(nth 1 else)) ,then ,@(nthcdr 3 else)))
     351          36 :      ((equal (macroexp-unprogn then) (nthcdr 3 else))
     352             :       ;; (message "macroexp-if: sharing 'then' with not %S" then)
     353           3 :       `(if (or ,test (not ,(nth 1 else)))
     354           3 :            ,then ,@(macroexp-unprogn (nth 2 else))))
     355             :      (t
     356          33 :       `(cond (,test ,@(macroexp-unprogn then))
     357          33 :              (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
     358          37 :              (t ,@(nthcdr 3 else))))))
     359         153 :    ((eq (car-safe else) 'cond)
     360          48 :     `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
     361             :    ;; Invert the test if that lets us reduce the depth of the tree.
     362         105 :    ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
     363         190 :    (t `(if ,test ,then ,@(macroexp-unprogn else)))))
     364             : 
     365             : (defmacro macroexp-let2 (test sym exp &rest body)
     366             :   "Evaluate BODY with SYM bound to an expression for EXP's value.
     367             : The intended usage is that BODY generates an expression that
     368             : will refer to EXP's value multiple times, but will evaluate
     369             : EXP only once.  As BODY generates that expression, it should
     370             : use SYM to stand for the value of EXP.
     371             : 
     372             : If EXP is a simple, safe expression, then SYM's value is EXP itself.
     373             : Otherwise, SYM's value is a symbol which holds the value produced by
     374             : evaluating EXP.  The return value incorporates the value of BODY, plus
     375             : additional code to evaluate EXP once and save the result so SYM can
     376             : refer to it.
     377             : 
     378             : If BODY consists of multiple forms, they are all evaluated
     379             : but only the last one's value matters.
     380             : 
     381             : TEST is a predicate to determine whether EXP qualifies as simple and
     382             : safe; if TEST is nil, only constant expressions qualify.
     383             : 
     384             : Example:
     385             :  (macroexp-let2 nil foo EXP
     386             :    \\=`(* ,foo ,foo))
     387             : generates an expression that evaluates EXP once,
     388             : then returns the square of that value.
     389             : You could do this with
     390             :   (let ((foovar EXP))
     391             :     (* foovar foovar))
     392             : but using `macroexp-let2' produces more efficient code in
     393             : cases where EXP is a constant."
     394             :   (declare (indent 3) (debug (sexp sexp form body)))
     395           4 :   (let ((bodysym (make-symbol "body"))
     396           4 :         (expsym (make-symbol "exp")))
     397           4 :     `(let* ((,expsym ,exp)
     398           4 :             (,sym (if (funcall #',(or test #'macroexp-const-p) ,expsym)
     399           4 :                       ,expsym (make-symbol ,(symbol-name sym))))
     400           4 :             (,bodysym ,(macroexp-progn body)))
     401           4 :        (if (eq ,sym ,expsym) ,bodysym
     402           4 :          (macroexp-let* (list (list ,sym ,expsym))
     403           4 :                         ,bodysym)))))
     404             : 
     405             : (defmacro macroexp-let2* (test bindings &rest body)
     406             :   "Bind each binding in BINDINGS as `macroexp-let2' does."
     407             :   (declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
     408           3 :   (pcase-exhaustive bindings
     409           1 :     (`nil (macroexp-progn body))
     410             :     (`((,var ,exp) . ,tl)
     411           2 :      `(macroexp-let2 ,test ,var ,exp
     412           3 :         (macroexp-let2* ,test ,tl ,@body)))))
     413             : 
     414             : (defun macroexp--maxsize (exp size)
     415          40 :   (cond ((< size 0) size)
     416          28 :         ((symbolp exp) (1- size))
     417          16 :         ((stringp exp) (- size (/ (length exp) 16)))
     418          16 :         ((vectorp exp)
     419           0 :          (dotimes (i (length exp))
     420           0 :            (setq size (macroexp--maxsize (aref exp i) size)))
     421           0 :          (1- size))
     422          16 :         ((consp exp)
     423             :          ;; We could try to be more clever with quote&function,
     424             :          ;; but it is difficult to do so correctly, and it's not obvious that
     425             :          ;; it would be worth the effort.
     426          12 :          (dolist (e exp)
     427          36 :            (setq size (macroexp--maxsize e size)))
     428          12 :          (1- size))
     429          40 :         (t -1)))
     430             : 
     431             : (defun macroexp-small-p (exp)
     432             :   "Return non-nil if EXP can be considered small."
     433           4 :   (> (macroexp--maxsize exp 10) 0))
     434             : 
     435             : (defsubst macroexp--const-symbol-p (symbol &optional any-value)
     436             :   "Non-nil if SYMBOL is constant.
     437             : If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
     438             : symbol itself."
     439         651 :   (or (memq symbol '(nil t))
     440         591 :       (keywordp symbol)
     441         585 :       (if any-value
     442          30 :           (or (memq symbol byte-compile-const-variables)
     443             :               ;; FIXME: We should provide a less intrusive way to find out
     444             :               ;; if a variable is "constant".
     445          30 :               (and (boundp symbol)
     446           0 :                    (condition-case nil
     447           0 :                        (progn (set symbol (symbol-value symbol)) nil)
     448         651 :                      (setting-constant t)))))))
     449             : 
     450             : (defun macroexp-const-p (exp)
     451             :   "Return non-nil if EXP will always evaluate to the same value."
     452        1874 :   (cond ((consp exp) (or (eq (car exp) 'quote)
     453        1484 :                          (and (eq (car exp) 'function)
     454        1553 :                               (symbolp (cadr exp)))))
     455             :         ;; It would sometimes make sense to pass `any-value', but it's not
     456             :         ;; always safe since a "constant" variable may not actually always have
     457             :         ;; the same value.
     458         321 :         ((symbolp exp) (macroexp--const-symbol-p exp))
     459        1874 :         (t t)))
     460             : 
     461             : (defun macroexp-copyable-p (exp)
     462             :   "Return non-nil if EXP can be copied without extra cost."
     463         571 :   (or (symbolp exp) (macroexp-const-p exp)))
     464             : 
     465             : (defun macroexp-quote (v)
     466             :   "Return an expression E such that `(eval E)' is V.
     467             : 
     468             : E is either V or (quote V) depending on whether V evaluates to
     469             : itself or not."
     470           0 :   (if (and (not (consp v))
     471           0 :            (or (keywordp v)
     472           0 :                (not (symbolp v))
     473           0 :                (memq v '(nil t))))
     474           0 :       v
     475           0 :     (list 'quote v)))
     476             : 
     477             : ;;; Load-time macro-expansion.
     478             : 
     479             : ;; Because macro-expansion used to be more lazy, eager macro-expansion
     480             : ;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
     481             : ;; So, we have to delay macro-expansion like we used to when we detect
     482             : ;; such a cycle, and we also want to help coders resolve those cycles (since
     483             : ;; they can be non-obvious) by providing a usefully trimmed backtrace
     484             : ;; (hopefully) highlighting the problem.
     485             : 
     486             : (defun macroexp--backtrace ()
     487             :   "Return the Elisp backtrace, more recent frames first."
     488           0 :   (let ((bt ())
     489             :         (i 0))
     490           0 :     (while
     491           0 :         (let ((frame (backtrace-frame i)))
     492           0 :           (when frame
     493           0 :             (push frame bt)
     494           0 :             (setq i (1+ i)))))
     495           0 :     (nreverse bt)))
     496             : 
     497             : (defun macroexp--trim-backtrace-frame (frame)
     498           0 :   (pcase frame
     499           0 :     (`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
     500             :     (`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
     501           0 :      (if (or (symbolp second)
     502           0 :              (and (eq 'quote (car-safe second))
     503           0 :                   (symbolp (cadr second))))
     504           0 :          `(macroexpand-all (,head ,second …))
     505           0 :        '(macroexpand-all …)))
     506             :     (`(,_ load-with-code-conversion ,name . ,_)
     507           0 :      `(load ,(file-name-nondirectory name)))))
     508             : 
     509             : (defvar macroexp--pending-eager-loads nil
     510             :   "Stack of files currently undergoing eager macro-expansion.")
     511             : 
     512             : (defvar macroexp--debug-eager nil)
     513             : 
     514             : (defun internal-macroexpand-for-load (form full-p)
     515             :   ;; Called from the eager-macroexpansion in readevalloop.
     516       28513 :   (cond
     517             :    ;; Don't repeat the same warning for every top-level element.
     518       28513 :    ((eq 'skip (car macroexp--pending-eager-loads)) form)
     519             :    ;; If we detect a cycle, skip macro-expansion for now, and output a warning
     520             :    ;; with a trimmed backtrace.
     521       28513 :    ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
     522           0 :     (let* ((bt (delq nil
     523           0 :                      (mapcar #'macroexp--trim-backtrace-frame
     524           0 :                              (macroexp--backtrace))))
     525           0 :            (elem `(load ,(file-name-nondirectory load-file-name)))
     526           0 :            (tail (member elem (cdr (member elem bt)))))
     527           0 :       (if tail (setcdr tail (list '…)))
     528           0 :       (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
     529           0 :       (if macroexp--debug-eager
     530           0 :           (debug 'eager-macroexp-cycle)
     531           0 :         (message "Warning: Eager macro-expansion skipped due to cycle:\n  %s"
     532           0 :                  (mapconcat #'prin1-to-string (nreverse bt) " => ")))
     533           0 :       (push 'skip macroexp--pending-eager-loads)
     534           0 :       form))
     535             :    (t
     536       28513 :     (condition-case err
     537       28513 :         (let ((macroexp--pending-eager-loads
     538       28513 :                (cons load-file-name macroexp--pending-eager-loads)))
     539       28513 :           (if full-p
     540       13948 :               (macroexpand-all form)
     541       28513 :             (macroexpand form)))
     542             :       (error
     543             :        ;; Hopefully this shouldn't happen thanks to the cycle detection,
     544             :        ;; but in case it does happen, let's catch the error and give the
     545             :        ;; code a chance to macro-expand later.
     546           0 :        (message "Eager macro-expansion failure: %S" err)
     547       28513 :        form)))))
     548             : 
     549             : ;; ¡¡¡ Big Ugly Hack !!!
     550             : ;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
     551             : ;; macroexp, bytecomp, cconv, and byte-opt to be fast.  Generally this is done
     552             : ;; by compiling those files first, but this only makes a difference if those
     553             : ;; files are not preloaded.  But macroexp.el is preloaded so we reload it if
     554             : ;; the current version is interpreted and there's a compiled version available.
     555             : (eval-when-compile
     556             :   (add-hook 'emacs-startup-hook
     557             :             (lambda ()
     558             :               (and (not (byte-code-function-p
     559             :                          (symbol-function 'macroexpand-all)))
     560             :                    (locate-library "macroexp.elc")
     561             :                    (load "macroexp.elc")))))
     562             : 
     563             : (provide 'macroexp)
     564             : 
     565             : ;;; macroexp.el ends here

Generated by: LCOV version 1.12