bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

retitle 29520 peval leaves behind dangling lexical reference
thanks

Stefan Israelsson Tampe <address@hidden> writes:

> Consider the code at the end of this post. un-commenting f-scope
> reveals the compiler error:
>
> ;;; ERROR: unbound lexical #<tree-il (lexical x #{x 190}#)>

Indeed, I can confirm that 'peval' has a faulty optimization that leaves
behind a dangling lexical reference to 'x' with no definition.

Here's the relevant excerpt of Stefan's example code, indented:

  (define-syntax-rule (<p-lambda> (c) code ...) (lambda (a b cc d c) code ...))
  (define-syntax ..
    (syntax-rules ()
      ((.. (f a ...))
       (f x y z a ...))
      ((.. (s ...) (f a ...))
       (f x y z a ...))))
  
  (define (f-scope f)
    (define (g f x3)
      (define (h x2 n m)
        (lambda xx (apply (f-skip n m) x2)))
      (<p-lambda> (c)
        (.. (c2) (f c))
        (let ((n N) (m M))
          (.. ((h x3 n m) c2)))))
  
    (lambda x (apply (g f x) x)))

When 'peval' optimizes 'f-scope', it inlines the calls to 'g' and 'h',
but somewhere along the way the binding for 'x' gets lost, although a
reference to 'x' still remains within the inlined instances of 'g' and
'h'.  This error in the result of 'peval' is detected by
'verify-tree-il'.  See below for a debugging transcript.

--8<---------------cut here---------------start------------->8---
address@hidden ~$ guile
GNU Guile 2.2.2
Copyright (C) 1995-2017 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (define-syntax-rule (<p-lambda> (c) code ...) (lambda (a b 
cc d c) code ...))
scheme@(guile-user)> (define-syntax ..
                       (syntax-rules ()
                         ((.. (f a ...))
                          (f x y z a ...))
                         ((.. (s ...) (f a ...))
                          (f x y z a ...))))
scheme@(guile-user)> (define (f-scope f)
                       (define (g f x3)
                         (define (h x2 n m)
                           (lambda xx (apply (f-skip n m) x2)))
                         (<p-lambda> (c)
                                     (.. (c2) (f c))
                                     (let ((n N) (m M))
                                       (.. ((h x3 n m) c2)))))
                     
                       (lambda x (apply (g f x) x)))
;;; <stdin>:11:45: warning: possibly unbound variable `f-skip'
;;; <stdin>:13:37: warning: possibly unbound variable `x'
;;; <stdin>:13:37: warning: possibly unbound variable `y'
;;; <stdin>:13:37: warning: possibly unbound variable `z'
;;; <stdin>:14:37: warning: possibly unbound variable `N'
;;; <stdin>:14:37: warning: possibly unbound variable `M'
;;; <stdin>:15:39: warning: possibly unbound variable `x'
;;; <stdin>:15:39: warning: possibly unbound variable `y'
;;; <stdin>:15:39: warning: possibly unbound variable `z'
;;; <stdin>:15:39: warning: possibly unbound variable `c2'
While compiling expression:
ERROR: unbound lexical #<tree-il (lexical x #{x 504}#)>
scheme@(guile-user)> (use-modules (system base compile)
                                  (language tree-il)
                                  (language tree-il primitives)
                                  (language tree-il peval)
                                  (language tree-il debug))
scheme@(guile-user)> (compile '(define (f-scope f)
                                 (define (g f x3)
                                   (define (h x2 n m)
                                     (lambda xx (apply (f-skip n m) x2)))
                                   (<p-lambda> (c)
                                               (.. (c2) (f c))
                                               (let ((n N) (m M))
                                                 (.. ((h x3 n m) c2)))))
                               
                                 (lambda x (apply (g f x) x)))
                              #:to 'tree-il
                              #:env (current-module))
$1 = #<tree-il (define f-scope (lambda ((name . f-scope)) (lambda-case (((f) #f 
#f #f () (f-1dff1b83541ce327-4f)) (letrec* (g) (g-1dff1b83541ce327-52) ((lambda 
((name . g)) (lambda-case (((f x3) #f #f #f () (f-1dff1b83541ce327-53 
x3-1dff1b83541ce327-54)) (letrec* (h) (h-1dff1b83541ce327-58) ((lambda ((name . 
h)) (lambda-case (((x2 n m) #f #f #f () (x2-1dff1b83541ce327-5a 
n-1dff1b83541ce327-5b m-1dff1b83541ce327-5c)) (lambda () (lambda-case ((() #f 
xx #f () (xx-1dff1b83541ce327-60)) (call (toplevel apply) (call (toplevel 
f-skip) (lexical n n-1dff1b83541ce327-5b) (lexical m m-1dff1b83541ce327-5c)) 
(lexical x2 x2-1dff1b83541ce327-5a))))))))) (lambda () (lambda-case (((a b cc d 
c) #f #f #f () (a-1dff1b83541ce327-62 b-1dff1b83541ce327-63 
cc-1dff1b83541ce327-64 d-1dff1b83541ce327-65 c-1dff1b83541ce327-66)) (seq (call 
(lexical f f-1dff1b83541ce327-53) (toplevel x) (toplevel y) (toplevel z) 
(lexical c c-1dff1b83541ce327-66)) (let (n m) (n-1dff1b83541ce327-6f 
m-1dff1b83541ce327-70) ((toplevel N) (toplevel M)) (call (call (lexical h 
h-1dff1b83541ce327-58) (lexical x3 x3-1dff1b83541ce327-54) (lexical n 
n-1dff1b83541ce327-6f) (lexical m m-1dff1b83541ce327-70)) (toplevel x) 
(toplevel y) (toplevel z) (toplevel c2)))))))))))) (lambda () (lambda-case ((() 
#f x #f () (x-1dff1b83541ce327-72)) (call (toplevel apply) (call (lexical g 
g-1dff1b83541ce327-52) (lexical f f-1dff1b83541ce327-4f) (lexical x 
x-1dff1b83541ce327-72)) (lexical x x-1dff1b83541ce327-72))))))))))>
scheme@(guile-user)> (expand-primitives (resolve-primitives $1 
(current-module)))
$2 = #<tree-il (define f-scope (lambda ((name . f-scope)) (lambda-case (((f) #f 
#f #f () (f-1dff1b83541ce327-4f)) (letrec* (g) (g-1dff1b83541ce327-52) ((lambda 
((name . g)) (lambda-case (((f x3) #f #f #f () (f-1dff1b83541ce327-53 
x3-1dff1b83541ce327-54)) (letrec* (h) (h-1dff1b83541ce327-58) ((lambda ((name . 
h)) (lambda-case (((x2 n m) #f #f #f () (x2-1dff1b83541ce327-5a 
n-1dff1b83541ce327-5b m-1dff1b83541ce327-5c)) (lambda () (lambda-case ((() #f 
xx #f () (xx-1dff1b83541ce327-60)) (primcall apply (call (toplevel f-skip) 
(lexical n n-1dff1b83541ce327-5b) (lexical m m-1dff1b83541ce327-5c)) (lexical 
x2 x2-1dff1b83541ce327-5a))))))))) (lambda () (lambda-case (((a b cc d c) #f #f 
#f () (a-1dff1b83541ce327-62 b-1dff1b83541ce327-63 cc-1dff1b83541ce327-64 
d-1dff1b83541ce327-65 c-1dff1b83541ce327-66)) (seq (call (lexical f 
f-1dff1b83541ce327-53) (toplevel x) (toplevel y) (toplevel z) (lexical c 
c-1dff1b83541ce327-66)) (let (n m) (n-1dff1b83541ce327-6f 
m-1dff1b83541ce327-70) ((toplevel N) (toplevel M)) (call (call (lexical h 
h-1dff1b83541ce327-58) (lexical x3 x3-1dff1b83541ce327-54) (lexical n 
n-1dff1b83541ce327-6f) (lexical m m-1dff1b83541ce327-70)) (toplevel x) 
(toplevel y) (toplevel z) (toplevel c2)))))))))))) (lambda () (lambda-case ((() 
#f x #f () (x-1dff1b83541ce327-72)) (primcall apply (call (lexical g 
g-1dff1b83541ce327-52) (lexical f f-1dff1b83541ce327-4f) (lexical x 
x-1dff1b83541ce327-72)) (lexical x x-1dff1b83541ce327-72))))))))))>
scheme@(guile-user)> ,pp (decompile $2 #:env (current-module))
$3 = (define (f-scope f)
  (define (g f x3)
    (define (h x2 n m)
      (lambda xx (apply (f-skip n m) x2)))
    (lambda (a b cc d c)
      (f x y z c)
      (let ((n N) (m M)) ((h x3 n m) x y z c2))))
  (lambda x (apply (g f x) x)))
$4 = #<directory (guile-user) 1be3140>
scheme@(guile-user)> (peval $2)
$5 = #<tree-il (define f-scope (lambda ((name . f-scope)) (lambda-case (((f) #f 
#f #f () (#{f 943}#)) (lambda () (lambda-case (((a b cc d c) #f #f #f () (#{a 
949}# #{b 950}# #{cc 951}# #{d 952}# #{c 953}#)) (seq (call (lexical f #{f 
943}#) (toplevel x) (toplevel y) (toplevel z) (lexical c #{c 953}#)) (let (n m) 
(#{n 954}# #{m 955}#) ((toplevel N) (toplevel M)) (seq (seq (toplevel x) (seq 
(toplevel y) (seq (toplevel z) (seq (toplevel c2) (void))))) (primcall apply 
(call (toplevel f-skip) (lexical n #{n 954}#) (lexical m #{m 955}#)) (lexical x 
#{x 945}#))))))))))))>
scheme@(guile-user)> (verify-tree-il $5)
ERROR: In procedure scm-error:
ERROR: unbound lexical #<tree-il (lexical x #{x 945}#)>

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,q
scheme@(guile-user)> (make-let #f '(x) '(#{x 945}#) (list (make-const #f 
'DUMMY)) $5)
$6 = #<tree-il (let (x) (#{x 945}#) ((const DUMMY)) (define f-scope (lambda 
((name . f-scope)) (lambda-case (((f) #f #f #f () (#{f 943}#)) (lambda () 
(lambda-case (((a b cc d c) #f #f #f () (#{a 949}# #{b 950}# #{cc 951}# #{d 
952}# #{c 953}#)) (seq (call (lexical f #{f 943}#) (toplevel x) (toplevel y) 
(toplevel z) (lexical c #{c 953}#)) (let (n m) (#{n 954}# #{m 955}#) ((toplevel 
N) (toplevel M)) (seq (seq (toplevel x) (seq (toplevel y) (seq (toplevel z) 
(seq (toplevel c2) (void))))) (primcall apply (call (toplevel f-skip) (lexical 
n #{n 954}#) (lexical m #{m 955}#)) (lexical x #{x 945}#)))))))))))))>
scheme@(guile-user)> (verify-tree-il $6)
$7 = #<tree-il (let (x) (#{x 945}#) ((const DUMMY)) (define f-scope (lambda 
((name . f-scope)) (lambda-case (((f) #f #f #f () (#{f 943}#)) (lambda () 
(lambda-case (((a b cc d c) #f #f #f () (#{a 949}# #{b 950}# #{cc 951}# #{d 
952}# #{c 953}#)) (seq (call (lexical f #{f 943}#) (toplevel x) (toplevel y) 
(toplevel z) (lexical c #{c 953}#)) (let (n m) (#{n 954}# #{m 955}#) ((toplevel 
N) (toplevel M)) (seq (seq (toplevel x) (seq (toplevel y) (seq (toplevel z) 
(seq (toplevel c2) (void))))) (primcall apply (call (toplevel f-skip) (lexical 
n #{n 954}#) (lexical m #{m 955}#)) (lexical x #{x 945}#)))))))))))))>
scheme@(guile-user)> ,pp (decompile $6 #:env (current-module))
$8 = (let ((x-1 'DUMMY))
  (define (f-scope f)
    (lambda (a b cc d c)
      (f x y z c)
      (let ((n N) (m M))
        (begin x y z c2 (if #f #f))
        (apply (f-skip n m) x-1)))))
$9 = #<directory (guile-user) 1be3140>
scheme@(guile-user)> 
--8<---------------cut here---------------end--------------->8---

Above, I wrapped the faulty code with an extra 'let' to bind the
dangling reference, to allow the decompiler to run.

So, peval is optimizing this:

  (define (f-scope f)
    (define (g f x3)
      (define (h x2 n m)
        (lambda xx (apply (f-skip n m) x2)))
      (lambda (a b cc d c)
        (f x y z c)
        (let ((n N) (m M)) ((h x3 n m) x y z c2))))
    (lambda x (apply (g f x) x)))

into this:

  (define (f-scope f)
    (lambda (a b cc d c)
      (f x y z c)
      (let ((n N) (m M))
        (begin x y z c2 (if #f #f))
        (apply (f-skip n m) x-1))))

To be continued...

       Mark