Short out some more IND_STATIC during code generation.wip/andreask/ind-elim

When generating code for `f = g` use the cmm expression representing
`g` for all future references to `f`.

These would be eliminated via linker tricks anyway. But might save the
linker some work.

3 files changed, 22 insertions, 17 deletions

diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 4efcf69d18..481a81c558 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -166,14 +166,15 @@ cgTopBinding logger tmpfs cfg = \case
     StgTopLifted (StgNonRec id rhs) -> do
         let (info, fcode) = cgTopRhs cfg NonRecursive id rhs
         fcode
-        addBindC info
+        info >>= addBindC
 
     StgTopLifted (StgRec pairs) -> do
         let (bndrs, rhss) = unzip pairs
         let pairs' = zip bndrs rhss
             r = unzipWith (cgTopRhs cfg Recursive) pairs'
             (infos, fcodes) = unzip r
-        addBindsC infos
+        infos' <- sequence infos
+        addBindsC infos'
         sequence_ fcodes
 
     StgTopStringLit id str -> do
@@ -196,7 +197,7 @@ cgTopBinding logger tmpfs cfg = \case
         addBindC (litIdInfo (stgToCmmPlatform cfg) id mkLFStringLit lit)
 
 
-cgTopRhs :: StgToCmmConfig -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ())
+cgTopRhs :: StgToCmmConfig -> RecFlag -> Id -> CgStgRhs -> (FCode CgIdInfo, FCode ())
         -- The Id is passed along for setting up a binding...
 
 cgTopRhs cfg _rec bndr (StgRhsCon _cc con mn _ts args)
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 2ddba8ad18..08f530ba00 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -64,6 +64,7 @@ import GHC.Data.FastString
 import GHC.Data.List.SetOps
 
 import Control.Monad
+import GHC.Utils.Trace (pprTraceM)
 
 ------------------------------------------------------------------------
 --              Top-level bindings
@@ -79,13 +80,13 @@ cgTopRhsClosure :: Platform
                 -> UpdateFlag
                 -> [Id]                 -- Args
                 -> CgStgExpr
-                -> (CgIdInfo, FCode ())
+                -> (FCode CgIdInfo, FCode ())
 
-cgTopRhsClosure platform rec id ccs upd_flag args body =
+cgTopRhsClosure platform rec id ccs upd_flag args body = do
   let closure_label = mkClosureLabel (idName id) (idCafInfo id)
-      cg_id_info    = litIdInfo platform id lf_info (CmmLabel closure_label)
       lf_info       = mkClosureLFInfo platform id TopLevel [] upd_flag args
-  in (cg_id_info, gen_code lf_info closure_label)
+      cg_id_info    = litIdInfo platform id lf_info (CmmLabel closure_label)
+  gen_code cg_id_info closure_label
   where
   -- special case for a indirection (f = g).  We create an IND_STATIC
   -- closure pointing directly to the indirectee.  This is exactly
@@ -102,12 +103,15 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
   --
   gen_code _ closure_label
     | StgApp f [] <- body, null args, isNonRec rec
-    = do
-         cg_info <- getCgIdInfo f
-         emitDataCon closure_label indStaticInfoTable ccs [unLit (idInfoToAmode cg_info)]
-
-  gen_code lf_info _closure_label
-   = do { profile <- getProfile
+    = ( do
+          cg_info <- getCgIdInfo f
+          return cg_info { cg_id = id }
+      , do
+          cg_info <- getCgIdInfo f
+          emitDataCon closure_label indStaticInfoTable ccs [unLit (idInfoToAmode cg_info)])
+
+  gen_code cg_info@CgIdInfo { cg_lf = lf_info } _closure_label
+   = (pure cg_info, do { profile <- getProfile
         ; let name = idName id
         ; mod_name <- getModuleName
         ; let descr         = closureDescription mod_name name
@@ -125,7 +129,7 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
         ; forkClosureBody (closureCodeBody True id closure_info ccs
                                 args body fv_details)
 
-        ; return () }
+        ; return () })
 
   unLit (CmmLit l) = l
   unLit _ = panic "unLit"
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index 89bdb88058..8c6da534f1 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -64,7 +64,7 @@ cgTopRhsCon :: StgToCmmConfig
             -> DataCon          -- Id
             -> ConstructorNumber
             -> [NonVoid StgArg] -- Args
-            -> (CgIdInfo, FCode ())
+            -> (FCode CgIdInfo, FCode ())
 cgTopRhsCon cfg id con mn args
   | Just static_info <- precomputedStaticConInfo_maybe cfg id con args
   , let static_code | isInternalName name = pure ()
@@ -75,11 +75,11 @@ cgTopRhsCon cfg id con mn args
     -- since importing modules will refer to it by name;
     -- but for Internal ones we can drop it altogether
     -- See Note [About the NameSorts] in "GHC.Types.Name" for Internal/External
-    (static_info, static_code)
+    (pure static_info, static_code)
 
   -- Otherwise generate a closure for the constructor.
   | otherwise
-  = (id_Info, gen_code)
+  = (pure id_Info, gen_code)
 
   where
    platform      = stgToCmmPlatform cfg