From f8c99c864b05ac79a66dc77cca5c318970983c8a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 14 Feb 2008 15:17:01 -0600
Subject: [PATCH] Loop conversion work in progress

---
 core/optimizer/control/control.factor | 62 ++++++++++++++-------------
 core/optimizer/optimizer-tests.factor | 22 ++++++++++
 2 files changed, 55 insertions(+), 29 deletions(-)

diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor
index de3aeb220a..eed69f243b 100755
--- a/core/optimizer/control/control.factor
+++ b/core/optimizer/control/control.factor
@@ -135,15 +135,6 @@ M: #call-label detect-loops*
     r> [ set-node-successor ] keep ;
 
 ! ! ! Lifting code after a conditional if one branch throws
-: only-one ( seq -- elt/f )
-    dup length 1 = [ first ] [ drop f ] if ;
-
-: lift-throw-tail? ( #if -- tail/? )
-    dup node-successor #tail?
-    [ drop f ] [ active-children only-one ] if ;
-
-: clone-node ( node -- newnode )
-    clone dup [ clone ] modify-values ;
 
 ! BEFORE
 !
@@ -177,7 +168,17 @@ M: #call-label detect-loops*
 ! the same node as (***)
 !
 ! Note: if (**) is #return is is sound to put #terminate there,
-! but not if (**) is #values
+! but not if (**) is #
+
+: only-one ( seq -- elt/f )
+    dup length 1 = [ first ] [ drop f ] if ;
+
+: lift-throw-tail? ( #if -- tail/? )
+    dup node-successor #tail?
+    [ drop f ] [ active-children only-one ] if ;
+
+: clone-node ( node -- newnode )
+    clone dup [ clone ] modify-values ;
 
 : lift-branch
     over
@@ -196,20 +197,6 @@ M: #if optimize-node*
         ] if
     ] if ;
 
-: fold-dispatch-branch? dup node-in-d first tuck node-literal? ;
-
-: fold-dispatch-branch ( node value -- node' )
-    dupd node-literal
-    over drop-inputs >r fold-branch r>
-    [ set-node-successor ] keep ;
-
-M: #dispatch optimize-node*
-    dup fold-dispatch-branch? [
-        fold-dispatch-branch t
-    ] [
-        2drop t f
-    ] if ;
-
 ! Loop tail hoising: code after a loop can sometimes go in the
 ! non-recursive branch of the loop
 
@@ -247,6 +234,27 @@ M: #dispatch optimize-node*
 !     |
 !  #return 1
 
+: find-tail
+    dup node-successor #tail?
+    [ node-successor find-tail ] unless ;
+
+: child-tails ( node -- seq )
+    node-children [ find-tail ] map ;
+
+GENERIC: add-loop-exit* ( label node -- )
+
+M: #branch add-loop-exit*
+    child-tails [ add-loop-exit* ] with each ;
+
+M: #call-label add-loop-exit* drop ;
+
+M: node add-loop-exit* node-successor add-loop-exit* , ;
+
+: find-loop-exits ( label node -- seq )
+    [ add-loop-exit* ] { } make ;
+
+! ! ! !
+
 : find-final-if ( node -- #if/f )
     dup [
         dup #if? [
@@ -264,11 +272,7 @@ M: #dispatch optimize-node*
 : lift-loop-tail? ( #label -- tail/f )
     dup node-successor node-successor [
         dup node-param swap node-child find-final-if dup [
-            node-children [ penultimate-node ] map
-            [
-                dup #call-label?
-                [ node-param eq? not ] [ 2drop t ] if
-            ] with subset only-one
+            find-loop-exits only-one
         ] [ 2drop f ] if
     ] [ drop f ] if ;
 
diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor
index 6a76892246..c997a6eb51 100755
--- a/core/optimizer/optimizer-tests.factor
+++ b/core/optimizer/optimizer-tests.factor
@@ -329,3 +329,25 @@ TUPLE: silly-tuple a b ;
     10 [ ] lift-loop-tail-test-1 1 2 3 ;
 
 [ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
+
+! Make sure we don't lose
+GENERIC: generic-inline-test ( x -- y )
+M: integer generic-inline-test ;
+
+: generic-inline-test-1
+    1
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test
+    generic-inline-test ;
+
+[ { t f } ] [
+    \ generic-inline-test-1 word-def dataflow
+    [ optimize-1 , optimize-1 , drop ] { } make
+] unit-test