Refactoring: use a structured CmmStatics type rather than [CmmStatic]

I observed that the [CmmStatics] within CmmData uses the list in a very stylised way.
The first item in the list is almost invariably a CmmDataLabel. Many parts of the
compiler pattern match on this list and fail if this is not true.

This patch makes the invariant explicit by introducing a structured type CmmStatics
that holds the label and the list of remaining [CmmStatic].

There is one wrinkle: the x86 backend sometimes wants to output an alignment directive just
before the label. However, this can be easily fixed up by parameterising the native codegen
over the type of CmmStatics (though the GenCmmTop parameterisation) and using a pair
(Alignment, CmmStatics) there instead.

As a result, I think we will be able to remove CmmAlign and CmmDataLabel from the CmmStatic
data type, thus nuking a lot of code and failing pattern matches. This change will come as part
of my next patch.

8 files changed, 26 insertions, 27 deletions

diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index 48756505c3..a134f00067 100644
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -12,6 +12,7 @@ import OldCmm
 import CLabel
 import Module
 import OldCmmUtils
+import CgUtils
 import CgMonad
 import HscTypes
 
@@ -30,9 +31,8 @@ cgTickBox mod n = do
 
 hpcTable :: Module -> HpcInfo -> Code
 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
-                        emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
-                                        ] ++
-                                        [ CmmStaticLit (CmmInt 0 W64)
+                        emitDataLits (mkHpcTicksLabel this_mod) $
+                                        [ CmmInt 0 W64
                                         | _ <- take hpc_tickCount [0::Int ..]
                                         ]
 
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 9b195bfab2..273c1bf16e 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -736,7 +736,7 @@ emitCgStmt stmt
 	; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
 	}
 
-emitData :: Section -> [CmmStatic] -> Code
+emitData :: Section -> CmmStatics -> Code
 emitData sect lits
   = do 	{ state <- getState
 	; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 63d99a629f..effa7a42d6 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -545,26 +545,26 @@ baseRegOffset _			  = panic "baseRegOffset:other"
 emitDataLits :: CLabel -> [CmmLit] -> Code
 -- Emit a data-segment data block
 emitDataLits lbl lits
-  = emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+  = emitData Data (Statics lbl $ map CmmStaticLit lits)
 
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info graph
 -- Emit a data-segment data block
 mkDataLits lbl lits
-  = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+  = CmmData Data (Statics lbl $ map CmmStaticLit lits)
 
 emitRODataLits :: String -> CLabel -> [CmmLit] -> Code
 -- Emit a read-only data block
 emitRODataLits caller lbl lits
-  = emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
+  = emitData section (Statics lbl $ map CmmStaticLit lits)
     where section | any needsRelocation lits = RelocatableReadOnlyData
                   | otherwise                = ReadOnlyData
           needsRelocation (CmmLabel _)      = True
           needsRelocation (CmmLabelOff _ _) = True
           needsRelocation _                 = False
 
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info graph
 mkRODataLits lbl lits
-  = CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
+  = CmmData section (Statics lbl $ map CmmStaticLit lits)
   where section | any needsRelocation lits = RelocatableReadOnlyData
                 | otherwise                = ReadOnlyData
         needsRelocation (CmmLabel _)      = True
@@ -580,7 +580,7 @@ mkByteStringCLit :: [Word8] -> FCode CmmLit
 mkByteStringCLit bytes
   = do 	{ uniq <- newUnique
 	; let lbl = mkStringLitLabel uniq
-	; emitData ReadOnlyData [CmmDataLabel lbl, CmmString bytes]
+	; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
 	; return (CmmLabel lbl) }
 
 -------------------------------------------------------------------------
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 7a7bf48b92..1825c97256 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -105,7 +105,7 @@ mkModuleInit dflags cost_centre_info this_mod hpc_info
 
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
+        ; emitData Data $ Statics (mkPlainModuleInitLabel this_mod) []
 
         ; whenC (this_mod == mainModIs dflags) $
              emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 2bfe1876ba..0404258446 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -182,7 +182,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
         ; initCostCentres cost_centre_info
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
+        ; emitData Data $ Statics (mkPlainModuleInitLabel this_mod) []
         }
 
 ---------------------------------------------------------------
diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs
index fae3bef016..4465e30b04 100644
--- a/compiler/codeGen/StgCmmHpc.hs
+++ b/compiler/codeGen/StgCmmHpc.hs
@@ -11,11 +11,11 @@ module StgCmmHpc ( initHpc, mkTickBox ) where
 import StgCmmMonad
 
 import MkGraph
-import CmmDecl
 import CmmExpr
 import CLabel
 import Module
 import CmmUtils
+import StgCmmUtils
 import HscTypes
 import StaticFlags
 
@@ -36,9 +36,8 @@ initHpc _ (NoHpcInfo {})
   = return ()
 initHpc this_mod (HpcInfo tickCount _hashNo)
   = whenC opt_Hpc $
-    do  { emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
-              ] ++
-              [ CmmStaticLit (CmmInt 0 W64)
-              | _ <- take tickCount [0::Int ..]
-              ]
+    do  { emitDataLits (mkHpcTicksLabel this_mod)
+                       [ (CmmInt 0 W64)
+                       | _ <- take tickCount [0::Int ..]
+                       ]
        }
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index f92b3cde27..d06b581f26 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -593,7 +593,7 @@ emit ag
   = do	{ state <- getState
 	; setState $ state { cgs_stmts = cgs_stmts state <*> ag } }
 
-emitData :: Section -> [CmmStatic] -> FCode ()
+emitData :: Section -> CmmStatics -> FCode ()
 emitData sect lits
   = do 	{ state <- getState
 	; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 558b7fdeaa..74da7317d4 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -508,26 +508,26 @@ baseRegOffset reg		  = pprPanic "baseRegOffset:" (ppr reg)
 emitDataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a data-segment data block
 emitDataLits lbl lits
-  = emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+  = emitData Data (Statics lbl $ map CmmStaticLit lits)
 
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
 -- Emit a data-segment data block
 mkDataLits lbl lits
-  = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+  = CmmData Data (Statics lbl $ map CmmStaticLit lits)
 
 emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a read-only data block
 emitRODataLits lbl lits
-  = emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
+  = emitData section (Statics lbl $ map CmmStaticLit lits)
   where section | any needsRelocation lits = RelocatableReadOnlyData
                 | otherwise                = ReadOnlyData
         needsRelocation (CmmLabel _)      = True
         needsRelocation (CmmLabelOff _ _) = True
         needsRelocation _                 = False
 
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
 mkRODataLits lbl lits
-  = CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
+  = CmmData section (Statics lbl $ map CmmStaticLit lits)
   where section | any needsRelocation lits = RelocatableReadOnlyData
                 | otherwise                = ReadOnlyData
         needsRelocation (CmmLabel _)      = True
@@ -543,7 +543,7 @@ mkByteStringCLit :: [Word8] -> FCode CmmLit
 mkByteStringCLit bytes
   = do 	{ uniq <- newUnique
 	; let lbl = mkStringLitLabel uniq
-	; emitData ReadOnlyData [CmmDataLabel lbl, CmmString bytes]
+	; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
 	; return (CmmLabel lbl) }
 
 -------------------------------------------------------------------------