From 64b89e3e84dd0efcbef2e72a61dbacfc40a40761 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 10 Sep 2005 04:55:46 +0000
Subject: [PATCH] fixes

---
 library/compiler/linearizer.factor      | 18 ++++++++++++++----
 library/compiler/vops.factor            |  2 +-
 library/inference/optimizer.factor      |  5 ++++-
 library/inference/print-dataflow.factor |  3 ++-
 4 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index 1cc69f06ba..6d686e29a9 100644
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -46,8 +46,20 @@ M: #label linearize* ( node -- )
         dup <label> [ %return-to , simple-label ] keep %label ,
     ] ifte linearize-next ;
 
+: tail-call? ( node -- ? )
+    #! A #call to some other label or word, followed by a
+    #! #return from a simple label is not allowed to be
+    #! tail-call-optimized; indeed, that #return will not be
+    #! generated at all.
+    dup node-successor dup #return? [
+        swap node-param swap node-param
+        dup simple-labels get memq? not >r eq? r> or
+    ] [
+        2drop f
+    ] ifte ;
+
 : ?tail-call ( node caller jumper -- next )
-    >r >r dup node-successor #return? [
+    >r >r dup tail-call? [
         node-param r> drop r> execute ,
     ] [
         dup node-param r> execute , r> drop linearize-next
@@ -104,6 +116,4 @@ M: #dispatch linearize* ( vtable -- )
 M: #return linearize* ( node -- )
     #! Simple label returns do not count, since simple labels do
     #! not push a stack frame on the C stack.
-    dup node-param simple-labels get memq? [
-        f %return ,
-    ] unless drop ;
+    node-param simple-labels get memq? [ %return , ] unless ;
diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
index 52011bb08c..948416cbda 100644
--- a/library/compiler/vops.factor
+++ b/library/compiler/vops.factor
@@ -75,7 +75,7 @@ C: %label make-vop ;
 ! simplifier.
 TUPLE: %return ;
 C: %return make-vop ;
-: %return ( label) label-vop <%return> ;
+: %return empty-vop <%return> ;
 
 TUPLE: %return-to ;
 C: %return-to make-vop ;
diff --git a/library/inference/optimizer.factor b/library/inference/optimizer.factor
index d7a3768a7d..b4bbb83614 100644
--- a/library/inference/optimizer.factor
+++ b/library/inference/optimizer.factor
@@ -63,7 +63,10 @@ M: #shuffle optimize-node*  ( node -- node/t )
     dup node-successor dup #shuffle? [
         compose-shuffle-nodes
     ] [
-        drop [ node-values empty? ] prune-if
+        drop [
+            dup node-in-d over node-out-d =
+            >r dup node-in-r swap node-out-r = r> and
+        ] prune-if
     ] ifte ;
 
 ! #ifte
diff --git a/library/inference/print-dataflow.factor b/library/inference/print-dataflow.factor
index 23ce62424a..015b334b3c 100644
--- a/library/inference/print-dataflow.factor
+++ b/library/inference/print-dataflow.factor
@@ -57,7 +57,8 @@ M: #dispatch node>quot ( ? node -- )
     [ "#dispatch" comment, ] 2keep
     node-children [ swap dataflow>quot ] map-with , \ dispatch , ;
 
-M: #return node>quot ( ? node -- ) "#return" comment, ;
+M: #return node>quot ( ? node -- )
+    dup node-param unparse "#return " swap append comment, ;
 
 M: #values node>quot ( ? node -- ) "#values" comment, ;