[Chicken-hackers] [PATCH] copy-propagation breaks beta-contraction invariant

[Felix]

Copy propagation of local procedure names may re-introduce references
to contracted procedures, and thus breaks the invariant that
contracted procedures are only referenced once. With certain code
patterns (for example in srfi-14-tests.scm as reported by Mario) this
could cause the compiler to contract infinitely (if the contracted
code contains propagated references to other contractions).

Now contraction is disabled for variables that are "replacing" (i.e.
propagated). Once the propagation has taken place a later optimization
pass will do the contraction.

This should fix #874. This means the srfi-14 tests should compile and
run properly, so it would be a good idea to add them to the test
suite.


cheers,
felix

>From 57b5fee811b9e4b29d54c5610115b67208f33cbe Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 6 Jul 2012 08:50:29 +0200
Subject: [PATCH] Copy propagation of local procedure names may re-introduce 
references
 to contracted procedures, and thus breaks the invariant that
 contracted procedures are only referenced once. With certain code
 patterns (for example in srfi-14-tests.scm as reported by Mario) this
 could cause the compiler to contract infinitely (if the contracted
 code contains propagated references to other contractions).

Now contraction is disabled for variables that are "replacing" (i.e.
propagated). Once the propagation has taken place a later optimization
pass will do the contraction.
---
 optimizer.scm |    8 ++++++--
 1 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/optimizer.scm b/optimizer.scm
index 2ce577d..d904246 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -249,7 +249,8 @@
          ((let)
           (let ((var (first params)))
             (cond ((or (test var 'removable)
-                       (and (test var 'contractable) (not (test var 
'replacing))) )
+                       (and (test var 'contractable) 
+                            (not (test var 'replacing))))
                    (touch)
                    (set! removed-lets (add1 removed-lets))
                    (walk (second subs) fids gae) )
@@ -312,7 +313,10 @@
                                  (or (test var 'value)
                                      (test var 'local-value))))
                       (args (cdr subs)) )
-                 (cond ((test var 'contractable)
+                 (cond ((and (test var 'contractable)
+                             (not (test var 'replacing))
+                             ;; inlinable procedure has changed
+                             (not (test (first (node-parameters lval)) 
'inline-target)))
                         ;; only called once
                         (let* ([lparams (node-parameters lval)]
                                [llist (third lparams)] )
-- 
1.6.0.4