diff options
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Stg/DepAnal.hs | 19 | ||||
| -rw-r--r-- | compiler/GHC/Stg/Pipeline.hs | 2 |
3 files changed, 14 insertions, 14 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 3eb00cd03c..5bc72c45ad 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -126,7 +126,6 @@ import GHC.Iface.Tidy import GHC.CoreToStg.Prep import GHC.CoreToStg ( coreToStg ) import GHC.Stg.Syntax -import GHC.Stg.FVs ( annTopBindingsFreeVars ) import GHC.Stg.Pipeline ( stg2stg ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) import GHC.Types.CostCentre @@ -1546,7 +1545,7 @@ This reduces residency towards the end of the CodeGen phase significantly doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs - -> [StgTopBinding] + -> [CgStgTopBinding] -> HpcInfo -> IO (Stream IO CmmGroupSRTs NameSet) -- Note we produce a 'Stream' of CmmGroups, so that the @@ -1556,7 +1555,7 @@ doCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info = do let dflags = hsc_dflags hsc_env - let stg_binds_w_fvs = annTopBindingsFreeVars stg_binds + let stg_binds_w_fvs = stg_binds dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) @@ -1592,7 +1591,7 @@ doCodeGen hsc_env this_mod data_tycons return (Stream.mapM dump2 pipeline_stream) myCoreToStg :: DynFlags -> Module -> CoreProgram - -> IO ( [StgTopBinding] -- output program + -> IO ( [CgStgTopBinding] -- output program , CollectedCCs ) -- CAF cost centre info (declared and used) myCoreToStg dflags this_mod prepd_binds = do let (stg_binds, cost_centre_info) diff --git a/compiler/GHC/Stg/DepAnal.hs b/compiler/GHC/Stg/DepAnal.hs index 90eec24f74..5947006e0e 100644 --- a/compiler/GHC/Stg/DepAnal.hs +++ b/compiler/GHC/Stg/DepAnal.hs @@ -4,6 +4,7 @@ module GHC.Stg.DepAnal (depSortStgPgm) where import GhcPrelude +import GHC.Stg.FVs import GHC.Stg.Syntax import GHC.Types.Id import GHC.Types.Name (Name, nameIsLocalOrFrom) @@ -35,15 +36,15 @@ type FVs = VarSet -- variables (FVs) back. We ignore imported FVs as they do not change the -- ordering but it improves performance. -- -annTopBindingsDeps :: Module -> [StgTopBinding] -> [(StgTopBinding, FVs)] -annTopBindingsDeps this_mod bs = zip bs (map top_bind bs) +annTopBindingsDeps :: Module -> [StgTopBinding] -> [(CgStgTopBinding, FVs)] +annTopBindingsDeps this_mod bs = map top_bind bs where - top_bind :: StgTopBinding -> FVs - top_bind StgTopStringLit{} = - emptyVarSet + top_bind :: StgTopBinding -> (CgStgTopBinding, FVs) + top_bind (StgTopStringLit id bs) = + (StgTopStringLit id bs, emptyVarSet) top_bind (StgTopLifted bs) = - binding emptyVarSet bs + (StgTopLifted (annBindingFreeVars bs), binding emptyVarSet bs) binding :: BVs -> StgBinding -> FVs binding bounds (StgNonRec _ r) = @@ -115,17 +116,17 @@ annTopBindingsDeps this_mod bs = zip bs (map top_bind bs) -- * Dependency sorting -- | Dependency sort a STG program so that dependencies come before uses. -depSortStgPgm :: Module -> [StgTopBinding] -> [StgTopBinding] +depSortStgPgm :: Module -> [StgTopBinding] -> [CgStgTopBinding] depSortStgPgm this_mod = {-# SCC "STG.depSort" #-} map fst . depSort . annTopBindingsDeps this_mod -- | Sort free-variable-annotated STG bindings so that dependencies come before -- uses. -depSort :: [(StgTopBinding, FVs)] -> [(StgTopBinding, FVs)] +depSort :: [(CgStgTopBinding, FVs)] -> [(CgStgTopBinding, FVs)] depSort = concatMap get_binds . depAnal defs uses where - uses, defs :: (StgTopBinding, FVs) -> [Name] + uses, defs :: (CgStgTopBinding, FVs) -> [Name] -- TODO (osa): I'm unhappy about two things in this code: -- diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs index 4b463cb95e..58ac584980 100644 --- a/compiler/GHC/Stg/Pipeline.hs +++ b/compiler/GHC/Stg/Pipeline.hs @@ -48,7 +48,7 @@ runStgM mask (StgM m) = evalStateT m mask stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do -> Module -- module being compiled -> [StgTopBinding] -- input program - -> IO [StgTopBinding] -- output program + -> IO [CgStgTopBinding] -- output program stg2stg dflags this_mod binds = do { dump_when Opt_D_dump_stg "STG:" binds |