bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Richard Copley]

Assuming RCS is installed and on the path, `vc-annotate' fails (for
files under RCS).

Recipe:
SET RCSINIT=-x,v
SET TZ=Europe/London
runemacs -Q

Visit a file under RCS version control and invoke `vc-annotate'.
Result: error "Symbol's function definition is void: sw" (at
vc-rcs.el, line 1309).

In GNU Emacs 24.1.50.1 (i386-mingw-nt5.1.2600)
 of 2012-06-25 on 57172UHB
Bzr revision: 108731 eggert@cs.ucla.edu-20120625075445-j1o6zbn9ln77b7tk
Windowing system distributor `Microsoft Corp.', version 5.1.2600
Configured using:
 `configure --with-gcc (4.6) --enable-checking --cflags
 -fno-omit-frame-pointer -L c:/gnuwin32/lib -I c:/gnuwin32/include'

Recent input:
C-x C-f c : \ t e m p \ x . t x t <return> C-x v g
M-x r e p o r t - e m a c s - b u g <return>

Recent messages:
For information about GNU Emacs and the GNU system, type C-h C-a.
Note: file is write protected
Annotating...
vc-rcs-annotate-command: Symbol's function definition is void: sw

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Eli Zaretskii]

> Date: Mon, 25 Jun 2012 18:24:50 +0100
> From: Richard Copley <rcopley@gmail.com>
> 
> Assuming RCS is installed and on the path, `vc-annotate' fails (for
> files under RCS).
> 
> Recipe:
> SET RCSINIT=-x,v
> SET TZ=Europe/London
> runemacs -Q

I get the error even without setting RCSINIT and TZ.

> Visit a file under RCS version control and invoke `vc-annotate'.
> Result: error "Symbol's function definition is void: sw" (at
> vc-rcs.el, line 1309).

And here's the Lisp backtrace:

> Debugger entered--Lisp error: (void-function sw)
>   vc-rcs-parse()
>   vc-rcs-annotate-command("d:/foo/bar/baz.c" #<buffer *Annotate baz.c (rev 0.93)*> "0.93")
>   apply(vc-rcs-annotate-command ("d:/foo/bar/baz.c" #<buffer *Annotate baz.c (rev 0.93)*> "0.93"))
>   vc-call-backend(RCS annotate-command "d:/foo/bar/baz.c" #<buffer *Annotate baz.c (rev 0.93)*> "0.93")
>   vc-annotate("d:/foo/bar/baz.c" "0.93" fullscale)
>   call-interactively(vc-annotate nil nil)

Emacs 24.1 doesn't have this problem.

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Richard Copley]

On 25 June 2012 19:48, Eli Zaretskii  wrote:
> I get the error even without setting RCSINIT and TZ.
They are indeed not relevant, I shouldn't have implied otherwise. (All
our RCS master files are made with those settings so for me, RCS
"doesn't work" without them.)

> And here's the Lisp backtrace:
That's the one, thanks.

> Emacs 24.1 doesn't have this problem.
I'm having fun following the trunk, though of course it's less stable
now after the release. In particular I gather that Stefan has replaced
the `flet' machinery.

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Glenn Morris]

Here's what the expansion of

(flet ((sw () (skip-chars-forward " \t\n")))
  (sw))

looks like in 24.1:

(let*
    ((--cl-letf-bound--
      (fboundp 'sw))
     (--cl-letf-save--
      (and --cl-letf-bound--
         (symbol-function 'sw))))
  (unwind-protect
      (progn
      (fset 'sw
            (function*
                   (lambda nil
                            (block sw
                                      (skip-chars-forward "  \n")))))
                                      (sw))
    (if --cl-letf-bound--
    (fset 'sw --cl-letf-save--)
      (fmakunbound 'sw))))

whereas in the current trunk it looks like this:


(let*
    ((x
      (cl-function
       (lambda nil
        (cl-block sw
           (skip-chars-forward "    \n")))))
     (x
      (symbol-function 'sw)))
  (unwind-protect
      (progn
      (fset 'sw x)
      (sw))
    (fset 'sw x)))

So there's a couple of things wrong with the new version:
`x' used twice as a local variable.
(symbol-function 'sw) not guarded by an (fboundp 'sw) check.

The latter is the immediate source of the error AFAICS.

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Stefan Monnier]

> So there's a couple of things wrong with the new version:
> `x' used twice as a local variable.

That's an illusion: these are two different uninterned symbols (of the
same name).

> (symbol-function 'sw) not guarded by an (fboundp 'sw) check.

Indeed.

> The latter is the immediate source of the error AFAICS.

Does the patch below fix things?


        Stefan


=== modified file 'lisp/vc/vc-rcs.el'
--- lisp/vc/vc-rcs.el	2012-06-06 01:28:08 +0000
+++ lisp/vc/vc-rcs.el	2012-06-27 00:52:54 +0000
@@ -679,7 +679,7 @@
     ;; Apply reverse-chronological edits on the trunk, computing and
     ;; accumulating forward-chronological edits after some point, for
     ;; later.
-    (flet ((r/d/a () (vector pre
+    (cl-flet ((r/d/a () (vector pre
                              (cdr (assq 'date meta))
                              (cdr (assq 'author meta)))))
       (while (when (setq pre cur cur (cdr (assq 'next meta)))

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Glenn Morris]

Stefan Monnier wrote:

> Does the patch below fix things?

Well no, because there are multiple `flet's in the file and that's not
the one giving the immediate error. Even if I replace every flet with
cl-flet, it still fails. (void-function tok+val) in vc-rcs-parse when
trying to define k-semi. Test case:

(cl-flet ((f1 (a) (+ a 1))
          (f2 (b) (+ (f1 b) 2)))
  (f2 1))

> --- lisp/vc/vc-rcs.el	2012-06-06 01:28:08 +0000
> +++ lisp/vc/vc-rcs.el	2012-06-27 00:52:54 +0000
> @@ -679,7 +679,7 @@
>      ;; Apply reverse-chronological edits on the trunk, computing and
>      ;; accumulating forward-chronological edits after some point, for
>      ;; later.
> -    (flet ((r/d/a () (vector pre
> +    (cl-flet ((r/d/a () (vector pre
>                               (cdr (assq 'date meta))
>                               (cdr (assq 'author meta)))))
>        (while (when (setq pre cur cur (cdr (assq 'next meta)))

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Stefan Monnier]

>> Does the patch below fix things?
> Well no, because there are multiple `flet's in the file and that's not
> the one giving the immediate error.

Duh, right.  I have a patch to make flet behave as before, but that
behavior is a real horror, so I'd really prefer to move away from it:
cl-flet implements the Common-Lisp semantics, which is a lot saner.

Does the patch below fix things, this time?


        Stefan


=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- lisp/emacs-lisp/cl-macs.el	2012-06-23 04:24:06 +0000
+++ lisp/emacs-lisp/cl-macs.el	2012-06-27 12:58:16 +0000
@@ -1570,7 +1570,6 @@
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
-;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make temporary function definitions.
@@ -1596,6 +1595,18 @@
              (cons (cons 'function #'cl--labels-convert) newenv)))))))
 
 ;;;###autoload
+(defmacro cl-flet* (bindings &rest body)
+  "Make temporary function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
+  (cond
+   ((null bindings) (macroexp-progn body))
+   ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+   (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
+
+;;;###autoload
 (defmacro cl-labels (bindings &rest body)
   "Make temporary function bindings.
 The bindings can be recursive.  Assumes the use of `lexical-binding'.

=== modified file 'lisp/vc/vc-rcs.el'
--- lisp/vc/vc-rcs.el	2012-06-06 01:28:08 +0000
+++ lisp/vc/vc-rcs.el	2012-06-27 13:06:53 +0000
@@ -679,7 +679,7 @@
     ;; Apply reverse-chronological edits on the trunk, computing and
     ;; accumulating forward-chronological edits after some point, for
     ;; later.
-    (flet ((r/d/a () (vector pre
+    (cl-flet ((r/d/a () (vector pre
                              (cdr (assq 'date meta))
                              (cdr (assq 'author meta)))))
       (while (when (setq pre cur cur (cdr (assq 'next meta)))
@@ -769,7 +769,7 @@
                  ht)
         (setq maxw (max w maxw))))
     (let ((padding (make-string maxw 32)))
-      (flet ((pad (w) (substring-no-properties padding w))
+      (cl-flet ((pad (w) (substring-no-properties padding w))
              (render (rda &rest ls)
                      (propertize
                       (apply 'concat
@@ -1306,7 +1306,8 @@
         ;; to "de-@@-format" the printed representation as the first step
         ;; to translating it into some value.  See internal func `gather'.
         @-holes)
-    (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
+    (cl-flet*
+        ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
            (at (tag) (save-excursion (eq tag (read buffer))))
            (to-eol () (buffer-substring-no-properties
                        (point) (progn (forward-line 1)
@@ -1331,7 +1332,7 @@
                     (cons tok (if proc
                                   (funcall proc)
                                 (buffer-substring-no-properties b e))))
-           (k-semi (name &optional proc) (tok+val 'to-semi name proc))
+         (k-semi (name &optional proc) (tok+val #'to-semi name proc))
            (gather () (let ((pairs `(,e ,@@-holes ,b))
                             acc)
                         (while pairs
@@ -1340,15 +1341,15 @@
                                 acc)
                           (setq pairs (cddr pairs)))
                         (apply 'concat acc)))
-           (k-one@ (name &optional later) (tok+val 'to-one@ name
+         (k-one@ (name &optional later) (tok+val #'to-one@ name
                                                    (if later
                                                        (lambda () t)
-                                                     'gather))))
+                                                   #'gather))))
       (save-excursion
         (goto-char (point-min))
         ;; headers
         (setq context 'headers)
-        (flet ((hpush (name &optional proc)
+        (cl-flet ((hpush (name &optional proc)
                       (push (k-semi name proc) headers)))
           (hpush 'head)
           (when (at 'branch)
@@ -1391,7 +1392,7 @@
                                (when (< (car ls) 100)
                                  (setcar ls (+ 1900 (car ls))))
                                (apply 'encode-time (nreverse ls)))))
-                  ,@(mapcar 'k-semi '(author state))
+                  ,@(mapcar #'k-semi '(author state))
                   ,(k-semi 'branches
                            (lambda ()
                              (split-string
@@ -1421,7 +1422,8 @@
               ;; only the former since it behaves identically to the
               ;; latter in the absence of "@@".)
               sub)
-          (flet ((incg (beg end) (let ((b beg) (e end) @-holes)
+          (cl-flet ((incg (beg end)
+                          (let ((b beg) (e end) @-holes)
                                    (while (and asc (< (car asc) e))
                                      (push (pop asc) @-holes))
                                    ;; Self-deprecate when work is done.
@@ -1429,7 +1431,7 @@
                                    ;; Thanks B.Mandelbrot, for complex sum.
                                    ;; O beauteous math! --the Unvexed Bum
                                    (unless asc
-                                     (setq sub 'buffer-substring-no-properties))
+                              (setq sub #'buffer-substring-no-properties))
                                    (gather))))
             (while (and (sw)
                         (not (eobp))
@@ -1449,8 +1451,8 @@
                   (setcdr (cadr rev) (gather))
                 (if @-holes
                     (setq asc (nreverse @-holes)
-                          sub 'incg)
-                  (setq sub 'buffer-substring-no-properties))
+                          sub #'incg)
+                  (setq sub #'buffer-substring-no-properties))
                 (goto-char b)
                 (setq acc nil)
                 (while (< (point) e)

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Glenn Morris]

Stefan Monnier wrote:

> Does the patch below fix things, this time?

Works for me, thanks.

bug#11780: 24.1.50; vc-annotate fails for files in RCS. ("cl.el" `flet' problem?)

[Stefan Monnier]

>> Does the patch below fix things, this time?
> Works for me, thanks.

Thanks,


        Stefan