diff options
author | Simon Marlow <marlowsd@gmail.com> | 2018-05-16 14:03:55 +0100 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2018-05-17 08:54:55 +0100 |
commit | f2d27c1ad69321872a87a37144fe41e815301f5b (patch) | |
tree | e579648c6360411911767fbe36c402c59694890a /compiler/cmm | |
parent | 0c7db226012b5cfafc9a38bfe372661672ec8900 (diff) | |
download | haskell-f2d27c1ad69321872a87a37144fe41e815301f5b.tar.gz |
Comments and refactoring only
Addressing review comments on D4637
Diffstat (limited to 'compiler/cmm')
-rw-r--r-- | compiler/cmm/Cmm.hs | 12 | ||||
-rw-r--r-- | compiler/cmm/CmmBuildInfoTables.hs | 30 |
2 files changed, 30 insertions, 12 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 4c8e528250..eb34618e38 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -143,6 +143,18 @@ data CmmInfoTable cit_clo :: Maybe (Id, CostCentreStack) -- Just (id,ccs) <=> build a static closure later -- Nothing <=> don't build a static closure + -- + -- Static closures for FUNs and THUNKs are *not* generated by + -- the code generator, because we might want to add SRT + -- entries to them later (for FUNs at least; THUNKs are + -- treated the same for consistency). See Note [SRTs] in + -- CmmBuildInfoTables, in particular the [FUN] optimisation. + -- + -- This is strictly speaking not a part of the info table that + -- will be finally generated, but it's the only convenient + -- place to convey this information from the code generator to + -- where we build the static closures in + -- CmmBuildInfoTables.doSRTs. } data ProfilingInfo diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index d9408df202..bef4d9867f 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -463,15 +463,16 @@ getCAFs (CmmProc top_info topLbl _ g) -- | Get the list of blocks that correspond to the entry points for -- FUN_STATIC closures. These are the blocks for which if we have an -- SRT we can merge it with the static closure. [FUN] -getStaticFuns :: CmmDecl -> [(BlockId, CLabel)] -getStaticFuns (CmmData _ _) = [] -getStaticFuns (CmmProc top_info _ _ g) - | Just info <- mapLookup (g_entry g) (info_tbls top_info) +getStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)] +getStaticFuns decls = + [ (g_entry g, lbl) + | CmmProc top_info _ _ g <- decls + , Just info <- [mapLookup (g_entry g) (info_tbls top_info)] + , Just (id, _) <- [cit_clo info] , let rep = cit_rep info - , Just (id, _) <- cit_clo info + , isStaticRep rep && isFunRep rep , let lbl = mkLocalClosureLabel (idName id) (idCafInfo id) - , isStaticRep rep && isFunRep rep = [(g_entry g, lbl)] - | otherwise = [] + ] -- | Put the labelled blocks that we will be annotating with SRTs into @@ -527,7 +528,7 @@ doSRTs -> [(CAFEnv, [CmmDecl])] -> IO (ModuleSRTInfo, [CmmDecl]) -doSRTs dflags topSRT tops = do +doSRTs dflags moduleSRTInfo tops = do us <- mkSplitUniqSupply 'u' -- Ignore the original grouping of decls, and combine all the @@ -535,7 +536,7 @@ doSRTs dflags topSRT tops = do let (cafEnvs, declss) = unzip tops cafEnv = mapUnions cafEnvs decls = concat declss - staticFuns = mapFromList (concatMap getStaticFuns decls) + staticFuns = mapFromList (getStaticFuns decls) -- Put the decls in dependency order. Why? So that we can implement -- [Shortcut] and [Filter]. If we need to refer to an SRT that has @@ -547,9 +548,14 @@ doSRTs dflags topSRT tops = do -- On each strongly-connected group of decls, construct the SRT -- closures and the SRT fields for info tables. - let ((result, _srtMap), topSRT') = + let result :: + [ ( [CmmDecl] -- generated SRTs + , [(Label, CLabel)] -- SRT fields for info tables + , [(Label, [SRTEntry])] -- SRTs to attach to static functions + ) ] + ((result, _srtMap), moduleSRTInfo') = initUs_ us $ - flip runStateT topSRT $ + flip runStateT moduleSRTInfo $ flip runStateT Map.empty $ mapM (doSCC dflags staticFuns) sccs @@ -561,7 +567,7 @@ doSRTs dflags topSRT tops = do funSRTMap = mapFromList (concat funSRTs) decls' = concatMap (updInfoSRTs dflags srtFieldMap funSRTMap) decls - return (topSRT', concat declss ++ decls') + return (moduleSRTInfo', concat declss ++ decls') -- | Build the SRT for a strongly-connected component of blocks |