bug#47049: [feature/native] macro-expansion cycle when compiling comp.el

[Andrea Corallo]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> > I made some local modifications in comp.el, and used that modified
>>> > comp.el for a while (by loading it manually at run time) to debug some
>>> > problem.  Then I undid those local modifications of comp.el (by saying
>>> > "git checkout") and said "make" to rebuild Emacs.  And I see this:
>>> >
>>> >     ELC      emacs-lisp/comp.elc
>>> >   Warning: Eager macro-expansion skipped due to cycle:
>>> >       => (load "comp.el") => (macroexpand-all (defalias 
>>> > 'comp-add-call-cstr  )) => (macroexpand (comp-loop-insn-in-block  )) => 
>>> > (load "comp.el")
>>> >
>>> > Why does this happen?
>>>
>>> I'm not sure, but I can reproduce it.
>>>
>>> I guess (just a guess) it might be because `comp-add-call-cstr' is using
>>> a macro `comp-loop-insn-in-block' that is expanding with a
>>> `cl-symbol-macrolet' inside? (no idea why this should be a problem).
>>>
>>> > could it be that while comp.el was modified it
>>> > got native-compiled, and now that inconsistent comp.eln gets in the
>>> > way?
>>>
>>> I think this has not to do specifically with native compilation.
>>>
>>> I see it goes away removing '(setq load-prefer-newer t)' from the
>>> invocation tho.
>>>
>>> Perhaps somebody already more into the macro expansion business might
>>> have some suggestion.
>>
>> Stefan, can you help, please?
>
> Nothing jumps at me by looking at the code.  I'll have to look at the
> actual complete stacktrace I think.

Cool didn't know was so easy to generate backtraces to debug this kind
of issues.  At the bottom I attached the backtrace I produced and had a
look into.

IIUC while *loading* "comp.el" we try to advice `macroexpand' and
consequentially we try to install a trampoline (was already compiled)
for `macroexpand', this is supposed to be done by
`comp-subr-trampoline-install' requiring "comp.el" to be loaded again!

Assuming my analysis is correct I'm not sure what's the best work around
for this condition.  WDYT?

  Andrea

==============
$ touch lisp/emacs-lisp/comp.el 
$ ./src/emacs -batch --no-site-file --no-site-lisp --eval '(setq 
load-prefer-newer t macroexp--debug-eager t)' -l comp -f 
batch-byte-native-compile-for-bootstrap lisp/emacs-lisp/comp.el

Debugger entered: (eager-macroexp-cycle)
  internal-macroexpand-for-load((require 'bytecomp) nil)
  load-with-code-conversion("/home/andcor03/emacs2/lisp/emacs-lisp/comp.el" 
"/home/andcor03/emacs2/lisp/emacs-lisp/comp.el" nil t)
  comp-subr-trampoline-install(macroexpand)
  #f(compiled-function (v1102) #<bytecode 
-0xbf6b4b02ba1e1b9>)(#f(advice-wrapper :around #<subr macroexpand> 
cl--sm-macroexpand))
  #f(compiled-function (gv--val) #<bytecode 
0x9f608bbba7cb3c2>)(#f(advice-wrapper :around #<subr macroexpand> 
cl--sm-macroexpand))
  advice--add-function(:around (#f(compiled-function () #<bytecode 
0x32e14019df7e91>) . #f(compiled-function (gv--val) #<bytecode 
0x9f608bbba7cb3c2>)) cl--sm-macroexpand nil)
  advice-add(macroexpand :around cl--sm-macroexpand)
  #f(compiled-function (arg1 &rest rest) "Make symbol macro 
definitions.\nWithin the body FORMs, references to the variable NAME will be 
replaced\nby EXPANSION, and (setq NAME ...) will act like (setf EXPANSION 
...)." #<bytecode 0x242ccdd625656f5>)(((insn (car insn-cell))) (let ((insn-cell 
(comp-block-insns bb))) (while insn-cell (when-let ((match (pcase insn (... 
...) (... ...)))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop 
with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f)) for arg in args for 
cstr = (funcall gen) for target = (comp-cond-cstrs-target-mvar arg insn bb) 
unless (comp-cstr-p cstr) do (sign\
al 'native-ice (list "Incoherent type specifier for function" f)) when (and 
target (not ...) (or ... ...)) do (comp-emit-call-cstr target insn-cell 
cstr)))) (setf insn-cell (cdr insn-cell)))))
  macroexpand((comp-loop-insn-in-block bb (when-let ((match (pcase insn (`... 
(when-let ... ...)) (`... (when-let ... ...))))) (cl-multiple-value-bind (f 
cstr-f lhs args) match (cl-loop with gen = (comp-lambda-list-gen 
(comp-cstr-f-args cstr-f)) for arg in args for cstr = (funcall gen) for target 
= (comp-cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do 
(signal 'native-ice (list "Incoherent type specifier for function" f)) when 
(and target (not (equal comp-cstr-t cstr)) (or (null lhs) (not ...))) do 
(comp-emit-call-cstr target insn-cell cstr))))) nil)
  macroexp-macroexpand((comp-loop-insn-in-block bb (when-let ((match (pcase 
insn (`... (when-let ... ...)) (`... (when-let ... ...))))) 
(cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = 
(comp-lambda-list-gen (comp-cstr-f-args cstr-f)) for arg in args for cstr = 
(funcall gen) for target = (comp-cond-cstrs-target-mvar arg insn bb) unless 
(comp-cstr-p cstr) do (signal 'native-ice (list "Incoherent type specifier for 
function" f)) when (and target (not (equal comp-cstr-t cstr)) (or (null lhs) 
(not ...))) do (comp-emit-call-cstr target insn-cell cstr))))) nil)
  macroexp--expand-all((comp-loop-insn-in-block bb (when-let ((match (pcase 
insn (`... (when-let ... ...)) (`... (when-let ... ...))))) 
(cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = 
(comp-lambda-list-gen (comp-cstr-f-args cstr-f)) for arg in args for cstr = 
(funcall gen) for target = (comp-cond-cstrs-target-mvar arg insn bb) unless 
(comp-cstr-p cstr) do (signal 'native-ice (list "Incoherent type specifier for 
function" f)) when (and target (not (equal comp-cstr-t cstr)) (or (null lhs) 
(not ...))) do (comp-emit-call-cstr target insn-cell cstr))))))
  macroexp--all-forms((lambda (--cl-var-- bb) (comp-loop-insn-in-block bb 
(when-let ((match (pcase insn (... ...) (... ...)))) (cl-multiple-value-bind (f 
cstr-f lhs args) match (cl-loop with gen = (comp-lambda-list-gen 
(comp-cstr-f-args cstr-f)) for arg in args for cstr = (funcall gen) for target 
= (comp-cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do 
(signal 'native-ice (list "Incoherent type specifier for function" f)) when 
(and target (not ...) (or ... ...)) do (comp-emit-call-cstr target insn-cell 
cstr)))))) 2)
  macroexp--expand-all((lambda (--cl-var-- bb) (comp-loop-insn-in-block bb 
(when-let ((match (pcase insn (... ...) (... ...)))) (cl-multiple-value-bind (f 
cstr-f lhs args) match (cl-loop with gen = (comp-lambda-list-gen 
(comp-cstr-f-args cstr-f)) for arg in args for cstr = (funcall gen) for target 
= (comp-cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do 
(signal 'native-ice (list "Incoherent type specifier for function" f)) when 
(and target (not ...) (or ... ...)) do (comp-emit-call-cstr target insn-cell 
cstr)))))))
  macroexp--all-forms((maphash (lambda (--cl-var-- bb) (comp-loop-insn-in-block 
bb (when-let ((match (pcase insn ... ...))) (cl-multiple-value-bind (f cstr-f 
lhs args) match (cl-loop with gen = (comp-lambda-list-gen ...) for arg in args 
for cstr = (funcall gen) for target = (comp-cond-cstrs-target-mvar arg insn bb) 
unless (comp-cstr-p cstr) do (signal ... ...) when (and target ... ...) do 
(comp-emit-call-cstr target insn-cell cstr)))))) (comp-func-blocks comp-func)) 
1)
  macroexp--expand-all((maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let ((match (pcase insn ... ...))) 
(cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = 
(comp-lambda-list-gen ...) for arg in args for cstr = (funcall gen) for target 
= (comp-cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do 
(signal ... ...) when (and target ... ...) do (comp-emit-call-cstr target 
insn-cell cstr)))))) (comp-func-blocks comp-func)))
  macroexpand-all((maphash (lambda (--cl-var-- bb) (comp-loop-insn-in-block bb 
(when-let ((match (pcase insn ... ...))) (cl-multiple-value-bind (f cstr-f lhs 
args) match (cl-loop with gen = (comp-lambda-list-gen ...) for arg in args for 
cstr = (funcall gen) for target = (comp-cond-cstrs-target-mvar arg insn bb) 
unless (comp-cstr-p cstr) do (signal ... ...) when (and target ... ...) do 
(comp-emit-call-cstr target insn-cell cstr)))))) (comp-func-blocks comp-func)) 
nil)
  cl--block-wrapper--cmacro((cl--block-wrapper (catch 
'--cl-block---cl-finish---- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let (...) (cl-multiple-value-bind ... match 
...)))) (comp-func-blocks comp-func)))) (catch '--cl-block---cl-finish---- 
(maphash (lambda (--cl-var-- bb) (comp-loop-insn-in-block bb (when-let ((match 
...)) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = ... 
for arg in args for cstr = ... for target = ... unless ... do ... when ... do 
...))))) (comp-func-blocks comp-func))))
  apply(cl--block-wrapper--cmacro (cl--block-wrapper (catch 
'--cl-block---cl-finish---- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let (...) (cl-multiple-value-bind ... match 
...)))) (comp-func-blocks comp-func)))) (catch '--cl-block---cl-finish---- 
(maphash (lambda (--cl-var-- bb) (comp-loop-insn-in-block bb (when-let ((match 
...)) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = ... 
for arg in args for cstr = ... for target = ... unless ... do ... when ... do 
...))))) (comp-func-blocks comp-func))))
  macroexp--compiler-macro(cl--block-wrapper--cmacro (cl--block-wrapper (catch 
'--cl-block---cl-finish---- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let (...) (cl-multiple-value-bind ... match 
...)))) (comp-func-blocks comp-func)))))
  macroexp--expand-all((cl-block --cl-finish-- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let ((match ...)) (cl-multiple-value-bind (f 
cstr-f lhs args) match (cl-loop with gen = ... for arg in args for cstr = ... 
for target = ... unless ... do ... when ... do ...))))) (comp-func-blocks 
comp-func))))
  macroexp--all-forms((progn (cl-block --cl-finish-- (maphash (lambda 
(--cl-var-- bb) (comp-loop-insn-in-block bb (when-let (...) 
(cl-multiple-value-bind ... match ...)))) (comp-func-blocks comp-func))) nil) 1)
  macroexp--expand-all((progn (cl-block --cl-finish-- (maphash (lambda 
(--cl-var-- bb) (comp-loop-insn-in-block bb (when-let (...) 
(cl-multiple-value-bind ... match ...)))) (comp-func-blocks comp-func))) nil))
  macroexpand-all((progn (cl-block --cl-finish-- (maphash (lambda (--cl-var-- 
bb) (comp-loop-insn-in-block bb (when-let (...) (cl-multiple-value-bind ... 
match ...)))) (comp-func-blocks comp-func))) nil) nil)
  cl--block-wrapper--cmacro((cl--block-wrapper (catch '--cl-block-nil-- 
(cl-block --cl-finish-- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let ... ...))) (comp-func-blocks comp-func))) 
nil)) (catch '--cl-block-nil-- (cl-block --cl-finish-- (maphash (lambda 
(--cl-var-- bb) (comp-loop-insn-in-block bb (when-let (...) 
(cl-multiple-value-bind ... match ...)))) (comp-func-blocks comp-func))) nil))
  apply(cl--block-wrapper--cmacro (cl--block-wrapper (catch '--cl-block-nil-- 
(cl-block --cl-finish-- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let ... ...))) (comp-func-blocks comp-func))) 
nil)) (catch '--cl-block-nil-- (cl-block --cl-finish-- (maphash (lambda 
(--cl-var-- bb) (comp-loop-insn-in-block bb (when-let (...) 
(cl-multiple-value-bind ... match ...)))) (comp-func-blocks comp-func))) nil))
  macroexp--compiler-macro(cl--block-wrapper--cmacro (cl--block-wrapper (catch 
'--cl-block-nil-- (cl-block --cl-finish-- (maphash (lambda (--cl-var-- bb) 
(comp-loop-insn-in-block bb (when-let ... ...))) (comp-func-blocks comp-func))) 
nil)))
  macroexp--expand-all((cl-loop for bb being each hash-value of 
(comp-func-blocks comp-func) do (comp-loop-insn-in-block bb (when-let ((match 
(pcase insn (... ...) (... ...)))) (cl-multiple-value-bind (f cstr-f lhs args) 
match (cl-loop with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f)) for 
arg in args for cstr = (funcall gen) for target = (comp-cond-cstrs-target-mvar 
arg insn bb) unless (comp-cstr-p cstr) do (signal 'native-ice (list "Incoherent 
type specifier for function" f)) when (and target (not ...) (or ... ...)) do 
(comp-emit-call-cstr target insn-cell cstr)))))))
  macroexp--all-forms((lambda nil "Add args assumptions for each function of 
which th..." (cl-loop for bb being each hash-value of (comp-func-blocks 
comp-func) do (comp-loop-insn-in-block bb (when-let ((match (pcase insn ... 
...))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = 
(comp-lambda-list-gen ...) for arg in args for cstr = (funcall gen) for target 
= (comp-cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do 
(signal ... ...) when (and target ... ...) do (comp-emit-call-cstr target 
insn-cell cstr))))))) 2)
  macroexp--expand-all(#'(lambda nil "Add args assumptions for each function of 
which th..." (cl-loop for bb being each hash-value of (comp-func-blocks 
comp-func) do (comp-loop-insn-in-block bb (when-let ((match ...)) 
(cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop with gen = ... for 
arg in args for cstr = ... for target = ... unless ... do ... when ... do 
...)))))))
  macroexp--all-forms((defalias 'comp-add-call-cstr #'(lambda nil "Add args 
assumptions for each function of which th..." (cl-loop for bb being each 
hash-value of (comp-func-blocks comp-func) do (comp-loop-insn-in-block bb 
(when-let (...) (cl-multiple-value-bind ... match ...)))))) 1)
  macroexp--expand-all((defalias 'comp-add-call-cstr #'(lambda nil "Add args 
assumptions for each function of which th..." (cl-loop for bb being each 
hash-value of (comp-func-blocks comp-func) do (comp-loop-insn-in-block bb 
(when-let (...) (cl-multiple-value-bind ... match ...)))))))
  macroexpand-all((defalias 'comp-add-call-cstr #'(lambda nil "Add args 
assumptions for each function of which th..." (cl-loop for bb being each 
hash-value of (comp-func-blocks comp-func) do (comp-loop-insn-in-block bb 
(when-let (...) (cl-multiple-value-bind ... match ...)))))))
  internal-macroexpand-for-load((defalias 'comp-add-call-cstr #'(lambda nil 
"Add args assumptions for each function of which th..." (cl-loop for bb being 
each hash-value of (comp-func-blocks comp-func) do (comp-loop-insn-in-block bb 
(when-let (...) (cl-multiple-value-bind ... match ...)))))) t)
  load-with-code-conversion("/home/andcor03/emacs2/lisp/emacs-lisp/comp.el" 
"/home/andcor03/emacs2/lisp/emacs-lisp/comp.el" nil t)
  command-line-1(("--eval" "(setq load-prefer-newer t macroexp--debug-eager t)" 
"-l" "comp" "-f" "batch-byte-native-compile-for-bootstrap" 
"lisp/emacs-lisp/comp.el"))
  command-line()
  normal-top-level()
==============