guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 15/58: Fix eta-conversion edge cases in peval.


From: Andy Wingo
Subject: [Guile-commits] 15/58: Fix eta-conversion edge cases in peval.
Date: Tue, 7 Aug 2018 06:58:30 -0400 (EDT)

wingo pushed a commit to branch lightning
in repository guile.

commit 6708acbf66fb7e92b81853b34a183e93aebbbd2a
Author: Mark H Weaver <address@hidden>
Date:   Thu Mar 15 23:22:26 2018 -0400

    Fix eta-conversion edge cases in peval.
    
    Fixes <https://bugs.gnu.org/29520>.
    Reported by Stefan Israelsson Tampe <address@hidden>.
    
    * module/language/tree-il/peval.scm (peval)[lift-applied-lambda]: Before
    performing eta-conversion, check that the variable(s) passed to the
    inner 'apply' are not referenced from the inner lambda, and that the
    number of required arguments would not be reduced by the conversion.
---
 module/language/tree-il/peval.scm | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index c3df1a7..b8a0fe9 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1591,11 +1591,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))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]