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.

6 files changed, 30 insertions, 22 deletions

diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index a4dbbe8771..72e4649eca 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -51,7 +51,7 @@ import Control.Monad	( mapAndUnzipM )
 -- | Top level code generation
 cmmTopCodeGen 
 	:: RawCmmTop 
-	-> NatM [NatCmmTop Instr]
+	-> NatM [NatCmmTop CmmStatics Instr]
 
 cmmTopCodeGen
 	(CmmProc info lab (ListGraph blocks)) 
@@ -75,7 +75,7 @@ cmmTopCodeGen (CmmData sec dat) = do
 basicBlockCodeGen 
 	:: CmmBasicBlock
 	-> NatM ( [NatBasicBlock Instr]
-		, [NatCmmTop Instr])
+		, [NatCmmTop CmmStatics Instr])
 
 basicBlockCodeGen cmm@(BasicBlock id stmts) = do
   instrs <- stmtsToInstrs stmts
@@ -313,8 +313,8 @@ genSwitch expr ids
 			, JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label
 			, NOP ]
 
-generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop CmmStatics Instr)
 generateJumpTableForInstr (JMP_TBL _ ids label) =
 	let jumpTable = map jumpTableEntry ids
-	in Just (CmmData ReadOnlyData (CmmDataLabel label : jumpTable))
+	in Just (CmmData ReadOnlyData (Statics label jumpTable))
 generateJumpTableForInstr _ = Nothing
diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
index d4500e8a8e..3e49f5c025 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
@@ -21,7 +21,7 @@ import Outputable
 import OrdList
 
 -- | Expand out synthetic instructions in this top level thing
-expandTop :: NatCmmTop Instr -> NatCmmTop Instr
+expandTop :: NatCmmTop CmmStatics Instr -> NatCmmTop CmmStatics Instr
 expandTop top@(CmmData{})
 	= top
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
index 9d6aa5e646..ddeed0508b 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
@@ -83,9 +83,8 @@ getRegister (CmmLit (CmmFloat f W32)) = do
 
     let code dst = toOL [
             -- the data area         
-	    LDATA ReadOnlyData
-	                [CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat f W32)],
+	    LDATA ReadOnlyData $ Statics lbl
+			 [CmmStaticLit (CmmFloat f W32)],
 
             -- load the literal
 	    SETHI (HI (ImmCLbl lbl)) tmp,
@@ -97,9 +96,8 @@ getRegister (CmmLit (CmmFloat d W64)) = do
     lbl <- getNewLabelNat
     tmp <- getNewRegNat II32
     let code dst = toOL [
-	    LDATA ReadOnlyData
-	                [CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat d W64)],
+	    LDATA ReadOnlyData $ Statics lbl
+			 [CmmStaticLit (CmmFloat d W64)],
 	    SETHI (HI (ImmCLbl lbl)) tmp,
 	    LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst] 
     return (Any FF64 code)
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 93f4d27444..816af9ba2a 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -112,7 +112,7 @@ data Instr
 
 	-- some static data spat out during code generation.
 	-- Will be extracted before pretty-printing.
-	| LDATA   Section [CmmStatic]	
+	| LDATA   Section CmmStatics	
 
 	-- Start a new basic block.  Useful during codegen, removed later.
 	-- Preceding instruction should be a jump, as per the invariants
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index d78d1a760e..8563aab4fe 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -47,9 +47,9 @@ import Data.Word
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmTop :: NatCmmTop Instr -> Doc
+pprNatCmmTop :: NatCmmTop CmmStatics Instr -> Doc
 pprNatCmmTop (CmmData section dats) = 
-  pprSectionHeader section $$ vcat (map pprData dats)
+  pprSectionHeader section $$ pprDatas dats
 
  -- special case for split markers:
 pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
@@ -91,6 +91,9 @@ pprBasicBlock (BasicBlock blockid instrs) =
   vcat (map pprInstr instrs)
 
 
+pprDatas :: CmmStatics -> Doc
+pprDatas (Statics lbl dats) = vcat (map pprData (CmmDataLabel lbl:dats))
+
 pprData :: CmmStatic -> Doc
 pprData (CmmAlign bytes)         = pprAlign bytes
 pprData (CmmDataLabel lbl)       = pprLabel lbl
diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs
index 30e48bb377..10e2e9fbaa 100644
--- a/compiler/nativeGen/SPARC/ShortcutJump.hs
+++ b/compiler/nativeGen/SPARC/ShortcutJump.hs
@@ -3,7 +3,7 @@ module SPARC.ShortcutJump (
 	JumpDest(..), getJumpDestBlockId,
 	canShortcut,
 	shortcutJump,
-	shortcutStatic,
+	shortcutStatics,
 	shortBlockId
 )
 
@@ -38,16 +38,23 @@ shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
 shortcutJump _ other = other
 
 
-shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
 
-shortcutStatic fn (CmmStaticLit (CmmLabel lab))
-	| Just uq <- maybeAsmTemp lab 
-	= CmmStaticLit (CmmLabel (shortBlockId fn (mkBlockId uq)))
+shortcutStatics :: (BlockId -> Maybe JumpDest) -> CmmStatics -> CmmStatics
+shortcutStatics fn (Statics lbl statics)
+  = Statics lbl $ map (shortcutStatic fn) statics
+  -- we need to get the jump tables, so apply the mapping to the entries
+  -- of a CmmData too.
 
-shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
-	| Just uq <- maybeAsmTemp lbl1
-	= CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (mkBlockId uq)) lbl2 off)
+shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
+shortcutLabel fn lab
+  | Just uq <- maybeAsmTemp lab = shortBlockId fn (mkBlockId uq)
+  | otherwise                   = lab
 
+shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
+shortcutStatic fn (CmmStaticLit (CmmLabel lab))
+	= CmmStaticLit (CmmLabel (shortcutLabel fn lab))
+shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
+	= CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off)
 -- slightly dodgy, we're ignoring the second label, but this
 -- works with the way we use CmmLabelDiffOff for jump tables now.
 shortcutStatic _ other_static