X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FCoreMonad.lhs;h=d821d407367192f13c024aa38c01bd584f5ec79b;hp=00dedffa38129353305a4f0ce985594359a1a8d0;hb=94bf0d3604ff0d2ecab246924af712bdd1c29a40;hpb=e95ee1f718c6915c478005aad8af81705357d6ab

diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 00dedff..d821d40 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -79,6 +79,7 @@ import Bag
 import Maybes
 import UniqSupply
 import UniqFM       ( UniqFM, mapUFM, filterUFM )
+import MonadUtils
 
 import Util		( split )
 import Data.List	( intersperse )
@@ -304,8 +305,10 @@ data SimplifierSwitch
 \begin{code}
 data FloatOutSwitches = FloatOutSwitches {
         floatOutLambdas :: Bool,     -- ^ True <=> float lambdas to top level
-        floatOutConstants :: Bool    -- ^ True <=> float constants to top level,
+        floatOutConstants :: Bool,   -- ^ True <=> float constants to top level,
                                      --            even if they do not escape a lambda
+        floatOutPartialApplications :: Bool -- ^ True <=> float out partial applications
+                                            --            based on arity information.
     }
 instance Outputable FloatOutSwitches where
     ppr = pprFloatOutSwitches
@@ -320,10 +323,6 @@ pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
 -- | Switches that specify the minimum amount of floating out
 -- gentleFloatOutSwitches :: FloatOutSwitches
 -- gentleFloatOutSwitches = FloatOutSwitches False False
-
--- | Switches that do not specify floating out of lambdas, just of constants
-constantsOnlyFloatOutSwitches :: FloatOutSwitches
-constantsOnlyFloatOutSwitches = FloatOutSwitches False True
 \end{code}
 
 
@@ -420,14 +419,28 @@ getCoreToDo dflags
         -- so that overloaded functions have all their dictionary lambdas manifest
         runWhen do_specialise CoreDoSpecialising,
 
-        runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
+        runWhen full_laziness $
+           CoreDoFloatOutwards FloatOutSwitches {
+                                 floatOutLambdas   = False,
+                                 floatOutConstants = True,
+                                 floatOutPartialApplications = False },
       		-- Was: gentleFloatOutSwitches	
-		-- I have no idea why, but not floating constants to top level is
-		-- very bad in some cases. 
+                --
+		-- I have no idea why, but not floating constants to
+		-- top level is very bad in some cases.
+                --
 		-- Notably: p_ident in spectral/rewrite
-		-- 	    Changing from "gentle" to "constantsOnly" improved
-		-- 	    rewrite's allocation by 19%, and made  0.0% difference
-		-- 	    to any other nofib benchmark
+		-- 	    Changing from "gentle" to "constantsOnly"
+		-- 	    improved rewrite's allocation by 19%, and
+		-- 	    made 0.0% difference to any other nofib
+		-- 	    benchmark
+                --
+                -- Not doing floatOutPartialApplications yet, we'll do
+                -- that later on when we've had a chance to get more
+                -- accurate arity information.  In fact it makes no
+                -- difference at all to performance if we do it here,
+                -- but maybe we save some unnecessary to-and-fro in
+                -- the simplifier.
 
         runWhen do_float_in CoreDoFloatInwards,
 
@@ -452,8 +465,11 @@ getCoreToDo dflags
                 simpl_phase 0 ["post-worker-wrapper"] max_iter
                 ]),
 
-        runWhen full_laziness
-          (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
+        runWhen full_laziness $
+           CoreDoFloatOutwards FloatOutSwitches {
+                                 floatOutLambdas   = False,
+                                 floatOutConstants = True,
+                                 floatOutPartialApplications = True },
                 -- nofib/spectral/hartel/wang doubles in speed if you
                 -- do full laziness late in the day.  It only happens
                 -- after fusion and other stuff, so the early pass doesn't