compiler.tree.finalization: undo a change that resulted in a compile time regression

diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index 49a07de1e4ef761ea53283cf8a545a40a3a5c102..1af0fcbc53df6392a425711b23aa1413a0361a9a 100644 (file)
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -28,6 +28,7 @@ SYMBOL: check-optimizer?
     ! Note that compute-predecessors has to be called several times.
     ! The passes that need this document it.
     [
+        optimize-tail-calls
         delete-useless-conditionals
         compute-predecessors
         split-branches
@@ -41,6 +42,5 @@ SYMBOL: check-optimizer?
         eliminate-dead-code
         eliminate-write-barriers
         eliminate-phis
-        optimize-tail-calls
         ?check
     ] with-scope ;

diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor
index d1dd4e39a4b8adc4c41dd140f36476da9fcd74b4..9b278dde9bc476a08a5b617e7ad69cdb272a82cc 100644 (file)
--- a/basis/compiler/tree/finalization/finalization.factor
+++ b/basis/compiler/tree/finalization/finalization.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences words memoize combinators
 classes classes.builtin classes.tuple math.partial-dispatch
-fry assocs
+fry assocs combinators.short-circuit
 compiler.tree
 compiler.tree.combinators
 compiler.tree.propagation.info
@@ -17,12 +17,25 @@ IN: compiler.tree.finalization
 ! propagation since we need to see 'fixnum?' instead of
 ! 'tag 0 eq?' and so on, for semantic reasoning.
 
+! We also delete empty stack shuffles and copies to facilitate
+! tail call optimization in the code generator.
+
 GENERIC: finalize* ( node -- nodes )
 
 : finalize ( nodes -- nodes' ) [ finalize* ] map-nodes ;
 
 : splice-final ( quot -- nodes ) splice-quot finalize ;
 
+M: #copy finalize* drop f ;
+
+M: #shuffle finalize*
+    dup {
+        [ [ in-d>> length ] [ out-d>> length ] bi = ]
+        [ [ in-r>> length ] [ out-r>> length ] bi = ]
+        [ [ in-d>> ] [ out-d>> ] [ mapping>> ] tri '[ _ at = ] 2all? ]
+        [ [ in-r>> ] [ out-r>> ] [ mapping>> ] tri '[ _ at = ] 2all? ]
+    } 1&& [ drop f ] when ;
+
 MEMO: cached-expansion ( word -- nodes )
     def>> splice-final ;