GNU bug report logs - #78056
31.0.50; bug in `cl-eval-when` with symbols with positions

Previous Next

Full log

Message #8 received at 78056 <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: David Ponce <da_vid <at> orange.fr>
Cc: 78056 <at> debbugs.gnu.org
Subject: Re: bug#78056: 31.0.50; bug in `cl-eval-when` with symbols with
 positions
Date: Sun, 27 Apr 2025 01:13:32 -0400

[Message part 1 (text/plain, inline)]

>>> (cl-typep '(foo) 'cons-car-foo)
>>> => (invalid-function #<symbol lambda at 125>)
>>>
>>> Without compile in the `cl-eval-when' in `cl-deftype', there is no side effect.

To fix this problem, `cl-eval-when` would need to do the same kind of
`byte-run-strip-symbol-positions` dance as is done for
`eval-when-compile` and `eval-and-compile`.

But I suggest the patch below instead, which starts by acknowledging
that `cl-eval-when` doesn't actually distinguish if it's used at
top-level (it has an ugly hack which tries to do that, but only for those
`cl-eval-when` nested inside another `cl-eval-when`, which his
extremely rare, and even in those cases it's right only some of the
time).

So the patch throws away the ugly hack and just reduces `cl-eval-when`
to one of `eval-when-compile`, `eval-and-compile`, `progn`, or nil.

It might be worthwhile to improve our macro-expansion machinery to let
(compiler-)macros know if they're used at top-level or not, but that's
a larger undertaking and it will be easy to retro-fit it into this macro
if/when we do that.

Comments, objections?


        Stefan

[cl-when.patch (text/x-diff, inline)]

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index a966ec5eaf6..0f748e01791 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -724,8 +724,6 @@ cl-destructuring-bind
 
 ;;; The `cl-eval-when' form.
 
-(defvar cl--not-toplevel nil)
-
 ;;;###autoload
 (defmacro cl-eval-when (when &rest body)
   "Control when BODY is evaluated.
@@ -733,31 +731,22 @@ cl-eval-when
 If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
 If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
 
+Beware: the implementation currently fails to correctly distinguish top-level
+from non-top-level uses.  Among other things, this means that `load' and `eval'
+are conflated.
+
 \(fn (WHEN...) BODY...)"
   (declare (indent 1) (debug (sexp body)))
-  (if (and (macroexp-compiling-p)
-	   (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge.
-      (let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
-	    (cl--not-toplevel t))
-	(if (or (memq 'load when) (memq :load-toplevel when))
-	    (if comp (cons 'progn (mapcar #'cl--compile-time-too body))
-	      `(if nil nil ,@body))
-	  (progn (if comp (eval (cons 'progn body) lexical-binding)) nil)))
-    (and (or (memq 'eval when) (memq :execute when))
-	 (cons 'progn body))))
-
-(defun cl--compile-time-too (form)
-  (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
-      (setq form (macroexpand
-		  form (cons '(cl-eval-when) macroexpand-all-environment))))
-  (cond ((eq (car-safe form) 'progn)
-	 (cons 'progn (mapcar #'cl--compile-time-too (cdr form))))
-	((eq (car-safe form) 'cl-eval-when)
-	 (let ((when (nth 1 form)))
-	   (if (or (memq 'eval when) (memq :execute when))
-	       `(cl-eval-when (compile ,@when) ,@(cddr form))
-	     form)))
-	(t (eval form lexical-binding) form)))
+  (let ((when-comp (or (memq 'compile when) (memq :compile-toplevel when)))
+        (when-eval (or (memq 'eval when) (memq :execute when)
+                       (memq 'load when) (memq :load-toplevel when))))
+    (cond
+     ((and (macroexp-compiling-p) when-comp)
+      (if when-eval
+          `(eval-and-compile . ,body)
+        `(eval-when-compile . ,body)))
+     (when-eval
+      (macroexp-progn body)))))
 
 ;;;###autoload
 (defmacro cl-load-time-value (form &optional _read-only)

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.