[commit: ghc] ghc-8.6: Revert "Comments and refactoring only" (b0f06f5)

git at git.haskell.org git at git.haskell.org
Thu Sep 13 21:00:41 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/b0f06f53761820167e8b2cda61bc8c3137a83f92/ghc

>---------------------------------------------------------------

commit b0f06f53761820167e8b2cda61bc8c3137a83f92
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Sep 12 15:07:44 2018 -0400

    Revert "Comments and refactoring only"
    
    This reverts commit f2d27c1ad69321872a87a37144fe41e815301f5b.


>---------------------------------------------------------------

b0f06f53761820167e8b2cda61bc8c3137a83f92
 compiler/cmm/Cmm.hs                | 12 ------------
 compiler/cmm/CmmBuildInfoTables.hs | 30 ++++++++++++------------------
 compiler/codeGen/StgCmmClosure.hs  |  2 +-
 3 files changed, 13 insertions(+), 31 deletions(-)

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index eb34618..4c8e528 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -143,18 +143,6 @@ 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 bef4d98..d9408df 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -463,16 +463,15 @@ 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 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]
+getStaticFuns :: CmmDecl -> [(BlockId, CLabel)]
+getStaticFuns (CmmData _ _) = []
+getStaticFuns (CmmProc top_info _ _ g)
+  | Just info <- mapLookup (g_entry g) (info_tbls top_info)
   , let rep = cit_rep info
-  , isStaticRep rep && isFunRep rep
+  , Just (id, _) <- cit_clo info
   , 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
@@ -528,7 +527,7 @@ doSRTs
   -> [(CAFEnv, [CmmDecl])]
   -> IO (ModuleSRTInfo, [CmmDecl])
 
-doSRTs dflags moduleSRTInfo tops = do
+doSRTs dflags topSRT tops = do
   us <- mkSplitUniqSupply 'u'
 
   -- Ignore the original grouping of decls, and combine all the
@@ -536,7 +535,7 @@ doSRTs dflags moduleSRTInfo tops = do
   let (cafEnvs, declss) = unzip tops
       cafEnv = mapUnions cafEnvs
       decls = concat declss
-      staticFuns = mapFromList (getStaticFuns decls)
+      staticFuns = mapFromList (concatMap 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
@@ -548,14 +547,9 @@ doSRTs dflags moduleSRTInfo tops = do
 
   -- On each strongly-connected group of decls, construct the SRT
   -- closures and the SRT fields for info tables.
-  let result ::
-        [ ( [CmmDecl]              -- generated SRTs
-          , [(Label, CLabel)]      -- SRT fields for info tables
-          , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
-          ) ]
-      ((result, _srtMap), moduleSRTInfo') =
+  let ((result, _srtMap), topSRT') =
         initUs_ us $
-        flip runStateT moduleSRTInfo $
+        flip runStateT topSRT $
         flip runStateT Map.empty $
         mapM (doSCC dflags staticFuns) sccs
 
@@ -567,7 +561,7 @@ doSRTs dflags moduleSRTInfo tops = do
     funSRTMap = mapFromList (concat funSRTs)
     decls' = concatMap (updInfoSRTs dflags srtFieldMap funSRTMap) decls
 
-  return (moduleSRTInfo', concat declss ++ decls')
+  return (topSRT', concat declss ++ decls')
 
 
 -- | Build the SRT for a strongly-connected component of blocks
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 6f0feaa..b598059 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -1040,7 +1040,7 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
                 , cit_rep  = sm_rep
                 , cit_prof = prof
                 , cit_srt  = Nothing
-                , cit_clo  = Nothing }
+                , cit_clo = Nothing }
  where
    name = dataConName data_con
    info_lbl = mkConInfoTableLabel name NoCafRefs



More information about the ghc-commits mailing list