From 3de583c7afcc4109995cb13be50d19ca86ddee62 Mon Sep 17 00:00:00 2001 From: sof Date: Tue, 4 Dec 2001 09:45:49 +0000 Subject: [PATCH] [project @ 2001-12-04 09:45:49 by sof] minor tidyup - move CollectedCCs tysyn to CostCentre (from SCCFinal), and make use of it where that cost-centre info triple is being passed&returned. --- ghc/compiler/codeGen/CodeGen.lhs | 48 +++++++++++++++------------------ ghc/compiler/profiling/CostCentre.lhs | 9 +++++++ ghc/compiler/profiling/SCCfinal.lhs | 4 --- ghc/compiler/simplStg/SimplStg.lhs | 15 +++++------ 4 files changed, 36 insertions(+), 40 deletions(-) diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 7db7948..c9d3522 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -38,7 +38,7 @@ import CgConTbls ( genStaticConBits ) import ClosureInfo ( mkClosureLFInfo ) import CmdLineOpts ( DynFlags, DynFlag(..), opt_SccProfilingOn, opt_EnsureSplittableC ) -import CostCentre ( CostCentre, CostCentreStack ) +import CostCentre ( CollectedCCs ) import Id ( Id, idName, setIdName ) import Name ( nameSrcLoc, nameOccName, nameUnique, isLocalName, mkGlobalName ) import OccName ( mkLocalOcc ) @@ -59,9 +59,7 @@ import Outputable codeGen :: DynFlags -> Module -- Module name -> [Module] -- Import names - -> ([CostCentre], -- Local cost-centres needing declaring/registering - [CostCentre], -- "extern" cost-centres needing declaring - [CostCentreStack]) -- Pre-defined "singleton" cost centre stacks + -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [Id] -- foreign-exported binders -> [TyCon] -- Local tycons, including ones from classes -> [(StgBinding,[Id])] -- Bindings to convert, with SRTs @@ -70,30 +68,28 @@ codeGen :: DynFlags codeGen dflags mod_name imported_modules cost_centre_info fe_binders tycons stg_binds = do { showPass dflags "CodeGen" - ; fl_uniqs <- mkSplitUniqSupply 'f' - ; let - datatype_stuff = genStaticConBits cinfo data_tycons - code_stuff = initC cinfo (mapCs cgTopBinding stg_binds) - init_stuff = mkModuleInit fe_binders mod_name imported_modules - cost_centre_info - - abstractC = mkAbstractCs [ maybeSplitCode, - init_stuff, - code_stuff, - datatype_stuff] - -- Put datatype_stuff after code_stuff, because the - -- datatype closure table (for enumeration types) - -- to (say) PrelBase_True_closure, which is defined in code_stuff - - flat_abstractC = flattenAbsC fl_uniqs abstractC - ; dumpIfSet_dyn dflags Opt_D_dump_absC "Abstract C" (dumpRealC abstractC) + ; let flat_abstractC = flattenAbsC fl_uniqs abstractC ; return flat_abstractC } where - data_tycons = filter isDataTyCon tycons - cinfo = MkCompInfo mod_name + data_tycons = filter isDataTyCon tycons + cinfo = MkCompInfo mod_name + + datatype_stuff = genStaticConBits cinfo data_tycons + code_stuff = initC cinfo (mapCs cgTopBinding stg_binds) + init_stuff = mkModuleInit fe_binders mod_name imported_modules + cost_centre_info + + abstractC = mkAbstractCs [ maybeSplitCode, + init_stuff, + code_stuff, + datatype_stuff] + -- Put datatype_stuff after code_stuff, because the + -- datatype closure table (for enumeration types) + -- to (say) PrelBase_True_closure, which is defined in code_stuff + \end{code} %************************************************************************ @@ -107,9 +103,7 @@ mkModuleInit :: [Id] -- foreign exported functions -> Module -- module name -> [Module] -- import names - -> ([CostCentre], -- cost centre info - [CostCentre], - [CostCentreStack]) + -> CollectedCCs -- cost centre info -> AbstractC mkModuleInit fe_binders mod imps cost_centre_info = let @@ -282,4 +276,4 @@ maybeGlobaliseId id maybeSplitCode | opt_EnsureSplittableC = CSplitMarker | otherwise = AbsCNop -\end{code} \ No newline at end of file +\end{code} diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs index 85c36be..506783d 100644 --- a/ghc/compiler/profiling/CostCentre.lhs +++ b/ghc/compiler/profiling/CostCentre.lhs @@ -9,6 +9,7 @@ module CostCentre ( -- All abstract except to friend: ParseIface.y CostCentreStack, + CollectedCCs, noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS, noCostCentre, noCCAttached, noCCSAttached, isCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS, @@ -138,6 +139,14 @@ data IsDupdCC -- "dupd". data IsCafCC = CafCC | NotCafCC + +-- synonym for triple which describes the cost centre info in the generated +-- code for a module. +type CollectedCCs + = ( [CostCentre] -- local cost-centres that need to be decl'd + , [CostCentre] -- "extern" cost-centres + , [CostCentreStack] -- pre-defined "singleton" cost centre stacks + ) \end{code} WILL: Would there be any merit to recording ``I am now using a diff --git a/ghc/compiler/profiling/SCCfinal.lhs b/ghc/compiler/profiling/SCCfinal.lhs index 2cd96d4..38ca2bd 100644 --- a/ghc/compiler/profiling/SCCfinal.lhs +++ b/ghc/compiler/profiling/SCCfinal.lhs @@ -43,10 +43,6 @@ infixr 9 `thenMM`, `thenMM_` \end{code} \begin{code} -type CollectedCCs = ([CostCentre], -- locally defined ones - [CostCentre], -- ones needing "extern" decls - [CostCentreStack]) -- singleton stacks (for CAFs) - stgMassageForProfiling :: Module -- module name -> UniqSupply -- unique supply diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs index f8652ed..cc918b7 100644 --- a/ghc/compiler/simplStg/SimplStg.lhs +++ b/ghc/compiler/simplStg/SimplStg.lhs @@ -10,7 +10,7 @@ module SimplStg ( stg2stg ) where import StgSyn -import CostCentre ( CostCentre, CostCentreStack ) +import CostCentre ( CollectedCCs ) import SCCfinal ( stgMassageForProfiling ) import StgLint ( lintStgBindings ) import StgStats ( showStgStats ) @@ -27,14 +27,11 @@ 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,[Id])], -- output program... - ([CostCentre], -- local cost-centres that need to be decl'd - [CostCentre], -- "extern" cost-centres - [CostCentreStack])) -- pre-defined "singleton" cost centre stacks +stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do + -> Module -- module name (profiling only) + -> [StgBinding] -- input... + -> IO ( [(StgBinding,[Id])] -- output program... + , CollectedCCs) -- cost centre information (declared and used) stg2stg dflags module_name binds = do { showPass dflags "Stg2Stg" -- 1.7.10.4