Subject: 29.0.50; named-let doesn't support dynamic binding

From: Tom Levy <[email-masked]>
Date: Fri, 25 Nov 2022 16:34:18 +0000

Is `named-let' supposed to work when dynamic binding is used (as
opposed to lexical binding)? Because if so, it is broken when the
recursion is not in tail position.

Example:

```
(eval
 '(named-let f ((x 10))
    (if (= 0 x)
        0
      (1+ (f (1- x)))))    ; note: recursion is *not* in tail position
 nil)    ; change to t to enable lexical binding (makes the code work)
```

Output:

```
Debugger entered--Lisp error: (void-variable --cl-f--)
  (funcall --cl-f-- (1- x))
  (1+ (funcall --cl-f-- (1- x)))
  (if (= 0 x) t (1+ (funcall --cl-f-- (1- x))))
  (lambda (x) (if (= 0 x) t (1+ (funcall --cl-f-- (1- x)))))(10)
  funcall((lambda (x) (if (= 0 x) t (1+ (funcall --cl-f-- (1- x))))) 10)
  (named-let f ((x 10)) (if (= 0 x) t (1+ (f (1- x)))))
  eval((named-let f ((x 10)) (if (= 0 x) t (1+ (f (1- x))))) nil)
  (progn (eval '(named-let f ((x 10)) (if (= 0 x) t (1+ (f (1- x))))) nil))
  eval((progn (eval '(named-let f ((x 10)) (if (= 0 x) t (1+ (f ...)))) nil)) t)
  elisp--eval-last-sexp(nil)
  eval-last-sexp(nil)
  funcall-interactively(eval-last-sexp nil)
  call-interactively(eval-last-sexp nil nil)
  command-execute(eval-last-sexp)
```

There is an easy fix. Currently `named-let' is defined as follows:

```
(defmacro named-let (name bindings &rest body)
  ;; ...
  (require 'cl-lib)
  (let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))
        (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)))
    ;; According to the Scheme semantics of named let, `name' is not in scope
    ;; while evaluating the expressions in `bindings', and for this reason, the
    ;; "initial" function call below needs to be outside of the `cl-labels'.
    ;; When the "self-tco" eliminates all recursive calls, the `cl-labels'
    ;; expands to a lambda which the byte-compiler then combines with the
    ;; funcall to make a `let' so we end up with a plain `while' loop and no
    ;; remaining `lambda' at all.
    `(funcall
      (cl-labels ((,name ,fargs . ,body)) #',name)
      . ,aargs)))
```

I believe the issue is with the following construct:

    (funcall (cl-labels ((,name ...)) #',name) ...)

The `funcall' to the lambda happens outside the scope of `cl-labels'.
As stated in the documentation of `cl-labels', closure capture only
works when lexical binding is in used. So any non-optimised recursive
calls in the body will fail, because `name' is not captured.

The easy fix is to move the `funcall' inside the scope of cl-labels.
However the bindings must be evaluated outside the `cl-labels' (as
explained in the existing comment). This can be achieved using a
simple `let' outside the `cl-labels'. (This actually simplifies the
code, because the bindings can be passed directly to `let' and the
variable `aargs' can be eliminated.)

Note that the generated bytecode with this fix is slightly different:
it looks like, when all recursive calls are in tail position, this fix
prevents the byte-compiler from inlining the outer function call. I am
not sure if that's a significant problem. I included an example with
disassembly below.

(I am not including a patch because I haven't completed the copyright
assignment process yet.)

Cheers,
Tom

------------

Disassembly example:

```
(let ((lexical-binding t))
  (disassemble
   (byte-compile
    '(named-let f ((x 100000))
       (if (= 0 x)
           0
         (f (1- x)))))))  ; note: here recursion *is* in tail position
```

Output with current `named-let' implementation:

```
byte code:
  args: nil
0       constant  100000
1       constant  nil
2:1     stack-ref 1
3       dup
4       constant  0
5       eqlsign
6       goto-if-nil 2
9       constant  0
10      stack-set 2
12      constant  nil
13      goto      3
16:2    stack-ref 2
17      sub1
18      stack-set 3
20      constant  :recurse
21:3    stack-set 1
23      goto-if-not-nil 1
26      return
```

Output with my proposed fix:

```
byte code:
  args: nil
0       constant  <compiled-function>
      doc:   ...
      args: (arg1)
    0       constant  nil
    1:1     stack-ref 1
    2       dup
    3       constant  0
    4       eqlsign
    5       goto-if-nil 2
    8       constant  0
    9       stack-set 2
    11      constant  nil
    12      goto      3
    15:2    stack-ref 2
    16      sub1
    17      stack-set 3
    19      constant  :recurse
    20:3    stack-set 1
    22      goto-if-not-nil 1
    25      return

1       dup
2       constant  100000
3       call      1
4       return
```

And here is a minimal example showing that the byte-compile is unable
to inline a `funcall' to a `let'-bound function:

```
(let ((lexical-binding t))
  (disassemble
   (byte-compile
    '(let ((f #'(lambda (x) (message "%S" x))))
       (funcall f 100000)))))
;; call to f is not inlined

(let ((lexical-binding t))
  (disassemble
   (byte-compile
    '(funcall #'(lambda (x) (message "%S" x)) 100000))))
;; call to lambda is inlined
```

------------

In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu) of 2022-11-25 built
 on ...
Repository revision: af545234314601ba3dcd8bf32e0d9b46e1917f79
Repository branch: master