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

[git at git.haskell.org]

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

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

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

commit 5e6c217d0b8786b4bd9c39e0da13e70a18166175
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Sep 18 11:45:25 2018 -0400

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


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

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

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 4c8e528..eb34618 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 d9408df..bef4d98 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
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index b598059..6f0feaa 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