Code-size optimisation for top-level indirections (#7308)

Top-level indirections are often generated when there is a cast, e.g.

foo :: T
foo = bar `cast` (some coercion)

For these we were generating a full-blown CAF, which is a fair chunk
of code.

This patch makes these indirections generate a single IND_STATIC
closure (4 words) instead.  This is exactly what the CAF would
evaluate to eventually anyway, we're just shortcutting the whole
process.

1 files changed, 7 insertions, 6 deletions

diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 944f5aab76..6098e615ae 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -40,6 +40,7 @@ import Module
 import ErrUtils
 import Outputable
 import Stream
+import BasicTypes
 
 import OrdList
 import MkGraph
@@ -117,7 +118,7 @@ variable. -}
 cgTopBinding :: DynFlags -> StgBinding -> FCode ()
 cgTopBinding dflags (StgNonRec id rhs)
   = do  { id' <- maybeExternaliseId dflags id
-        ; (info, fcode) <- cgTopRhs id' rhs
+        ; (info, fcode) <- cgTopRhs NonRecursive id' rhs
         ; fcode
         ; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
                                      -- so we find it when we look up occurrences
@@ -127,23 +128,23 @@ cgTopBinding dflags (StgRec pairs)
   = do  { let (bndrs, rhss) = unzip pairs
         ; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs
         ; let pairs' = zip bndrs' rhss
-        ; r <- sequence $ unzipWith cgTopRhs pairs'
+        ; r <- sequence $ unzipWith (cgTopRhs Recursive) pairs'
         ; let (infos, fcodes) = unzip r
         ; addBindsC infos
         ; sequence_ fcodes
         }
 
 
-cgTopRhs :: Id -> StgRhs -> FCode (CgIdInfo, FCode ())
+cgTopRhs :: RecFlag -> Id -> StgRhs -> FCode (CgIdInfo, FCode ())
         -- The Id is passed along for setting up a binding...
         -- It's already been externalised if necessary
 
-cgTopRhs bndr (StgRhsCon _cc con args)
+cgTopRhs _rec bndr (StgRhsCon _cc con args)
   = forkStatics (cgTopRhsCon bndr con args)
 
-cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
+cgTopRhs rec bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
   = ASSERT(null fvs)    -- There should be no free variables
-    forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)
+    forkStatics (cgTopRhsClosure rec bndr cc bi upd_flag args body)
 
 
 ---------------------------------------------------------------