import Maybes
import UniqSupply
import UniqFM ( UniqFM, mapUFM, filterUFM )
-import FiniteMap
+import MonadUtils
import Util ( split )
import Data.List ( intersperse )
import Data.Dynamic
import Data.IORef
+import Data.Map (Map)
+import qualified Data.Map as Map
import Data.Word
import Control.Monad
\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
-- | 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}
-- 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,
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
-- recent history reasonably efficiently
}
-type TickCounts = FiniteMap Tick Int
+type TickCounts = Map Tick Int
simplCountN :: SimplCount -> Int
simplCountN (VerySimplCount n) = n
-- This is where we decide whether to do
-- the VerySimpl version or the full-stats version
| dopt Opt_D_dump_simpl_stats dflags
- = SimplCount {ticks = 0, details = emptyFM,
+ = SimplCount {ticks = 0, details = Map.empty,
n_log = 0, log1 = [], log2 = []}
| otherwise
= VerySimplCount 0
doSimplTick _ (VerySimplCount n) = VerySimplCount (n+1)
--- Don't use plusFM_C because that's lazy, and we want to
+-- Don't use Map.unionWith because that's lazy, and we want to
-- be pretty strict here!
addTick :: TickCounts -> Tick -> TickCounts
-addTick fm tick = case lookupFM fm tick of
- Nothing -> addToFM fm tick 1
- Just n -> n1 `seq` addToFM fm tick n1
+addTick fm tick = case Map.lookup tick fm of
+ Nothing -> Map.insert tick 1 fm
+ Just n -> n1 `seq` Map.insert tick n1 fm
where
n1 = n+1
plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })
sc2@(SimplCount { ticks = tks2, details = dts2 })
- = log_base { ticks = tks1 + tks2, details = plusFM_C (+) dts1 dts2 }
+ = log_base { ticks = tks1 + tks2, details = Map.unionWith (+) dts1 dts2 }
where
-- A hackish way of getting recent log info
log_base | null (log1 sc2) = sc1 -- Nothing at all in sc2
pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
= vcat [ptext (sLit "Total ticks: ") <+> int tks,
blankLine,
- pprTickCounts (fmToList dts),
+ pprTickCounts (Map.toList dts),
if verboseSimplStats then
vcat [blankLine,
ptext (sLit "Log (most recent first)"),
projects / ghc-hetmet.git / blobdiff