Merge FUN_STATIC closure with its SRT

Summary:
The idea here is to save a little code size and some work in the GC,
by collapsing FUN_STATIC closures and their SRTs.

This is (4) in a series; see D4632 for more details.

There's a tradeoff here: more complexity in the compiler in exchange
for a modest code size reduction (probably around 0.5%).

Results:
* GHC binary itself (statically linked) is 1% smaller
* -0.2% binary sizes in nofib (-0.5% module sizes)

Full nofib results comparing D4634 with this: P177 (ignore runtimes,
these aren't stable on my laptop)

Test Plan: validate, nofib

Reviewers: bgamari, niteria, simonpj, erikd

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D4637

2 files changed, 23 insertions, 18 deletions

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index b29394da6f..aa2b954a95 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -95,19 +95,17 @@ cgTopRhsClosure dflags rec id ccs _ upd_flag args body =
          emitDataLits closure_label closure_rep
          return ()
 
-  gen_code dflags lf_info closure_label
-   = do {     -- LAY OUT THE OBJECT
-          let name = idName id
+  gen_code dflags lf_info _closure_label
+   = do { let name = idName id
         ; mod_name <- getModuleName
         ; let descr         = closureDescription dflags mod_name name
               closure_info  = mkClosureInfo dflags True id lf_info 0 0 descr
 
-              caffy         = idCafInfo id
-              info_tbl      = mkCmmInfo closure_info -- XXX short-cut
-              closure_rep   = mkStaticClosureFields dflags info_tbl ccs caffy []
+        -- We don't generate the static closure here, because we might
+        -- want to add references to static closures to it later.  The
+        -- static closure is generated by CmmBuildInfoTables.updInfoSRTs,
+        -- See Note [SRTs], specifically the [FUN] optimisation.
 
-                 -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
-        ; emitDataLits closure_label closure_rep
         ; let fv_details :: [(NonVoid Id, ByteOff)]
               header = if isLFThunk lf_info then ThunkHeader else StdHeader
               (_, _, fv_details) = mkVirtHeapOffsets dflags header []
@@ -367,7 +365,7 @@ mkRhsClosure dflags bndr cc _ fvs upd_flag args body
         ; let use_cc = cccsExpr; blame_cc = cccsExpr
         ; emit (mkComment $ mkFastString "calling allocDynClosure")
         ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
-        ; let info_tbl = mkCmmInfo closure_info
+        ; let info_tbl = mkCmmInfo closure_info bndr currentCCS
         ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc
                                          (map toVarArg fv_details)
 
@@ -407,7 +405,7 @@ cgRhsStdThunk bndr lf_info payload
 
 
         -- BUILD THE OBJECT
-  ; let info_tbl = mkCmmInfo closure_info
+  ; let info_tbl = mkCmmInfo closure_info bndr currentCCS
   ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info
                                    use_cc blame_cc payload_w_offsets
 
@@ -463,7 +461,7 @@ closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details
       \(_, node, _) -> thunkCode cl_info fv_details cc node arity body
    where
      lf_info  = closureLFInfo cl_info
-     info_tbl = mkCmmInfo cl_info
+     info_tbl = mkCmmInfo cl_info bndr cc
 
 closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
   = -- Note: args may be [], if all args are Void
@@ -474,7 +472,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
 
         ; let
              lf_info  = closureLFInfo cl_info
-             info_tbl = mkCmmInfo cl_info
+             info_tbl = mkCmmInfo cl_info bndr cc
 
         -- Emit the main entry code
         ; emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args $
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index d58e9f6f88..e0306eeba3 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -73,6 +73,7 @@ import SMRep
 import Cmm
 import PprCmmExpr()
 
+import CostCentre
 import BlockId
 import CLabel
 import Id
@@ -750,12 +751,15 @@ data ClosureInfo
     }
 
 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
-mkCmmInfo :: ClosureInfo -> CmmInfoTable
-mkCmmInfo ClosureInfo {..}
+mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
+mkCmmInfo ClosureInfo {..} id ccs
   = CmmInfoTable { cit_lbl  = closureInfoLabel
                  , cit_rep  = closureSMRep
                  , cit_prof = closureProf
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = if isStaticRep closureSMRep
+                                then Just (id,ccs)
+                                else Nothing }
 
 --------------------------------------
 --        Building ClosureInfos
@@ -1040,7 +1044,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
  = CmmInfoTable { cit_lbl  = info_lbl
                 , cit_rep  = sm_rep
                 , cit_prof = prof
-                , cit_srt  = Nothing }
+                , cit_srt  = Nothing
+                , cit_clo = Nothing }
  where
    name = dataConName data_con
    info_lbl = mkConInfoTableLabel name NoCafRefs
@@ -1063,14 +1068,16 @@ cafBlackHoleInfoTable
   = CmmInfoTable { cit_lbl  = mkCAFBlackHoleInfoTableLabel
                  , cit_rep  = blackHoleRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 indStaticInfoTable :: CmmInfoTable
 indStaticInfoTable
   = CmmInfoTable { cit_lbl  = mkIndStaticInfoLabel
                  , cit_rep  = indStaticRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
 -- A static closure needs a link field to aid the GC when traversing