bug#29520: Compilation error.

bug#29520: Compilation error.

[Stefan Israelsson Tampe]

[-- Attachment #1: Type: text/plain, Size: 943 bytes --]

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}#)>

But without it the globalified versoin f-scope2 comiles just fine
indicating an error in the compiler.

Regards
Stefan



(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)))

(define (h x2 n m)
  (lambda xx (apply (f-skip n m) x2)))

(define (g f x3)
  (<p-lambda> (c)
    (.. (c2) (f c))
    (let ((n N) (m M))
      (.. ((h x3 n m) c2)))))

(define (f-scope2 f)
  (lambda x (apply (g f x) x)))

[-- Attachment #2: Type: text/html, Size: 1811 bytes --]

bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

retitle 29520 peval leaves behind dangling lexical reference
thanks

Stefan Israelsson Tampe <stefan.itampe@gmail.com> 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---
mhw@jojen ~$ 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

bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> 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))))

I believe the problem is most likely in 'lift-applied-lambda' in
peval.scm.  When transforming:

  (lambda args (apply (lambda ...) args)) => (lambda ...)

it does not appear to check whether 'args' is referenced within the
inner lambda.

Assuming for the moment that it fails to do this check, here's an
example sequence of transformations that could lead to this situation:

Starting with:

  (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)))

inline the call to h:

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

inline the call to (lambda xx ...):

  (define (f-scope f)
    (define (g f x3)
      (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) x3))))
    (lambda x (apply (g f x) x)))

alpha-rename the 'x' to 'x-1' in the final lambda above:

  (define (f-scope f)
    (define (g f x3)
      (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) x3))))
    (lambda x-1 (apply (g f x-1) x-1)))

inline the call to g:

  (define (f-scope f)
    (lambda x-1
      (apply (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)))
             x-1)))

if we erroneously replace (lambda x-1 (apply FOO x-1)) with FOO here
(even though FOO contains a reference to x-1) then we would get:

  (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))))

which is what 'peval' returns, although I don't know if these were the
exact steps taken.

      Mark

bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> I believe the problem is most likely in 'lift-applied-lambda' in
> peval.scm.  When transforming:
>
>   (lambda args (apply (lambda ...) args)) => (lambda ...)
>
> it does not appear to check whether 'args' is referenced within the
> inner lambda.

Here's a proposed patch, which seems to fix compilation of the code
Stefan provided.

      Mark


diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 993fa0ad6..9f6c26520 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1589,6 +1589,9 @@ top-level bindings from ENV and return the resulting expression."
                      ($ <lexical-ref> _ _ sym)
                      ...))
                  (and (equal? sym gensyms)
+                      (every (lambda (s)
+                               (= (lexical-refcount s) 1))
+                             sym)
                       (not (lambda-case-alternate lcase))
                       lcase))
                 (_ #f))))

bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> I believe the problem is most likely in 'lift-applied-lambda' in
>> peval.scm.  When transforming:
>>
>>   (lambda args (apply (lambda ...) args)) => (lambda ...)
>>
>> it does not appear to check whether 'args' is referenced within the
>> inner lambda.

It occurs to me that there's another problem with this optimization:

  scheme@(guile-user)> ,optimize (lambda (x y . z) (apply (lambda x x) x y z))
  $1 = (lambda x x)

This optimization changes the arity of the procedure.  The original
version checks that at least 2 arguments are provided, and ensures that
at least 2 arguments are passed to the inner procedure, which the code
might depend on.  The optimization effectively removes this check.

I'll look into how to fix this.

       Mark

bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> It occurs to me that there's another problem with this optimization:
>
>   scheme@(guile-user)> ,optimize (lambda (x y . z) (apply (lambda x x) x y z))
>   $1 = (lambda x x)
>
> This optimization changes the arity of the procedure.  The original
> version checks that at least 2 arguments are provided, and ensures that
> at least 2 arguments are passed to the inner procedure, which the code
> might depend on.  The optimization effectively removes this check.

Here's an updated patch that fixes both issues.

      Mark


diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 993fa0ad6..13b7d9bc4 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1585,11 +1585,15 @@ top-level bindings from ENV and return the resulting expression."
          (and (not opt) rest (not kw)
               (match body
                 (($ <primcall> _ 'apply
-                    (($ <lambda> _ _ (and lcase ($ <lambda-case>)))
+                    (($ <lambda> _ _ (and lcase ($ <lambda-case> _ req1)))
                      ($ <lexical-ref> _ _ sym)
                      ...))
                  (and (equal? sym gensyms)
                       (not (lambda-case-alternate lcase))
+                      (<= (length req) (length req1))
+                      (every (lambda (s)
+                               (= (lexical-refcount s) 1))
+                             sym)
                       lcase))
                 (_ #f))))
        (let* ((vars (map lookup-var gensyms))

bug#29520: peval leaves behind dangling lexical reference

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
> index 993fa0ad6..13b7d9bc4 100644
> --- a/module/language/tree-il/peval.scm
> +++ b/module/language/tree-il/peval.scm
> @@ -1585,11 +1585,15 @@ top-level bindings from ENV and return the resulting expression."
>           (and (not opt) rest (not kw)
>                (match body
>                  (($ <primcall> _ 'apply
> -                    (($ <lambda> _ _ (and lcase ($ <lambda-case>)))
> +                    (($ <lambda> _ _ (and lcase ($ <lambda-case> _ req1)))
>                       ($ <lexical-ref> _ _ sym)
>                       ...))
>                   (and (equal? sym gensyms)
>                        (not (lambda-case-alternate lcase))
> +                      (<= (length req) (length req1))
> +                      (every (lambda (s)
> +                               (= (lexical-refcount s) 1))
> +                             sym)
>                        lcase))
>                  (_ #f))))
>         (let* ((vars (map lookup-var gensyms))

Applied in commit b56e084c77914a7fde558e8fd28a218759a4ddd7 on the
stable-2.2 branch.  I'm closing this bug now, but feel free to reopen if
you still see related problems.

     Thanks!
       Mark