Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4d4797de8b5772167e12b0e47761826affa7cbf0 >--------------------------------------------------------------- commit 4d4797de8b5772167e12b0e47761826affa7cbf0 Author: Ian Lynagh <[email protected]> Date: Tue Oct 16 13:23:12 2012 +0100 Whitespace only in simplStg/SimplStg.lhs >--------------------------------------------------------------- compiler/simplStg/SimplStg.lhs | 101 ++++++++++++++++++--------------------- 1 files changed, 47 insertions(+), 54 deletions(-) diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs index 6b2f322..bf9a217 100644 --- a/compiler/simplStg/SimplStg.lhs +++ b/compiler/simplStg/SimplStg.lhs @@ -4,13 +4,6 @@ \section[SimplStg]{Driver for simplifying @STG@ programs} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SimplStg ( stg2stg ) where #include "HsVersions.h" @@ -18,44 +11,44 @@ module SimplStg ( stg2stg ) where import StgSyn import CostCentre ( CollectedCCs ) -import SCCfinal ( stgMassageForProfiling ) -import StgLint ( lintStgBindings ) -import StgStats ( showStgStats ) +import SCCfinal ( stgMassageForProfiling ) +import StgLint ( lintStgBindings ) +import StgStats ( showStgStats ) import UnariseStg ( unarise ) -import DynFlags ( DynFlags(..), GeneralFlag(..), dopt, StgToDo(..), - getStgToDo ) +import DynFlags ( DynFlags(..), GeneralFlag(..), dopt, StgToDo(..), + getStgToDo ) import Module ( Module ) import ErrUtils import SrcLoc -import UniqSupply ( mkSplitUniqSupply, splitUniqSupply ) +import UniqSupply ( mkSplitUniqSupply, splitUniqSupply ) import Outputable \end{code} \begin{code} -stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do - -> Module -- module name (profiling only) - -> [StgBinding] -- input... - -> IO ( [StgBinding] -- output program... - , CollectedCCs) -- cost centre information (declared and used) +stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do + -> Module -- module name (profiling only) + -> [StgBinding] -- input... + -> IO ( [StgBinding] -- output program... + , CollectedCCs) -- cost centre information (declared and used) stg2stg dflags module_name binds - = do { showPass dflags "Stg2Stg" - ; us <- mkSplitUniqSupply 'g' + = do { showPass dflags "Stg2Stg" + ; us <- mkSplitUniqSupply 'g' - ; doIfSet_dyn dflags Opt_D_verbose_stg2stg - (log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (text "VERBOSE STG-TO-STG:")) + ; doIfSet_dyn dflags Opt_D_verbose_stg2stg + (log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (text "VERBOSE STG-TO-STG:")) - ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds + ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds - -- Do the main business! + -- Do the main business! ; let (us0, us1) = splitUniqSupply us' - ; (processed_binds, _, cost_centres) - <- foldl_mn do_stg_pass (binds', us0, ccs) (getStgToDo dflags) + ; (processed_binds, _, cost_centres) + <- foldl_mn do_stg_pass (binds', us0, ccs) (getStgToDo dflags) ; let un_binds = unarise us1 processed_binds - ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" + ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" (pprStgBindings un_binds) ; return (un_binds, cost_centres) @@ -63,41 +56,41 @@ stg2stg dflags module_name binds where stg_linter = if dopt Opt_DoStgLinting dflags - then lintStgBindings - else ( \ _whodunnit binds -> binds ) + then lintStgBindings + else ( \ _whodunnit binds -> binds ) ------------------------------------------- do_stg_pass (binds, us, ccs) to_do - = let - (us1, us2) = splitUniqSupply us - in - case to_do of - D_stg_stats -> - trace (showStgStats binds) - end_pass us2 "StgStats" ccs binds - - StgDoMassageForProfiling -> - {-# SCC "ProfMassage" #-} - let - (collected_CCs, binds3) - = stgMassageForProfiling dflags module_name us1 binds - in - end_pass us2 "ProfMassage" collected_CCs binds3 + = let + (us1, us2) = splitUniqSupply us + in + case to_do of + D_stg_stats -> + trace (showStgStats binds) + end_pass us2 "StgStats" ccs binds + + StgDoMassageForProfiling -> + {-# SCC "ProfMassage" #-} + let + (collected_CCs, binds3) + = stgMassageForProfiling dflags module_name us1 binds + in + end_pass us2 "ProfMassage" collected_CCs binds3 end_pass us2 what ccs binds2 = do -- report verbosely, if required - dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what - (vcat (map ppr binds2)) - let linted_binds = stg_linter what binds2 - return (linted_binds, us2, ccs) - -- return: processed binds - -- UniqueSupply for the next guy to use - -- cost-centres to be declared/registered (specialised) - -- add to description of what's happened (reverse order) + dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what + (vcat (map ppr binds2)) + let linted_binds = stg_linter what binds2 + return (linted_binds, us2, ccs) + -- return: processed binds + -- UniqueSupply for the next guy to use + -- cost-centres to be declared/registered (specialised) + -- add to description of what's happened (reverse order) -- here so it can be inlined... foldl_mn :: (b -> a -> IO b) -> b -> [a] -> IO b foldl_mn _ z [] = return z -foldl_mn f z (x:xs) = f z x >>= \ zz -> - foldl_mn f zz xs +foldl_mn f z (x:xs) = f z x >>= \ zz -> + foldl_mn f zz xs \end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
