Refactor CmmStatics

In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils
and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype
(before SRT generation) and `RawCmmStatics` datatype (after SRT
generation).

This patch removes this redundant code by using a single GADT for
(Raw)CmmStatics.

4 files changed, 17 insertions, 52 deletions

diff --git a/compiler/GHC/StgToCmm/Hpc.hs b/compiler/GHC/StgToCmm/Hpc.hs
index 1b7305da4e..4feb81217b 100644
--- a/compiler/GHC/StgToCmm/Hpc.hs
+++ b/compiler/GHC/StgToCmm/Hpc.hs
@@ -35,15 +35,15 @@ mkTickBox platform mod n
                         (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
                         n
 
+-- | Emit top-level tables for HPC and return code to initialise
 initHpc :: Module -> HpcInfo -> FCode ()
--- Emit top-level tables for HPC and return code to initialise
 initHpc _ (NoHpcInfo {})
   = return ()
 initHpc this_mod (HpcInfo tickCount _hashNo)
   = do dflags <- getDynFlags
        when (gopt Opt_Hpc dflags) $
-           emitRawDataLits (mkHpcTicksLabel this_mod)
-                           [ (CmmInt 0 W64)
-                           | _ <- take tickCount [0 :: Int ..]
-                           ]
+           emitDataLits (mkHpcTicksLabel this_mod)
+                        [ (CmmInt 0 W64)
+                        | _ <- take tickCount [0 :: Int ..]
+                        ]
 
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index 54e49eee87..578dbc1318 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -236,7 +236,7 @@ emitCostCentreDecl cc = do
               is_caf,         -- StgInt is_caf
               zero platform   -- struct _CostCentre *link
             ]
-  ; emitRawDataLits (mkCCLabel cc) lits
+  ; emitDataLits (mkCCLabel cc) lits
   }
 
 emitCostCentreStackDecl :: CostCentreStack -> FCode ()
@@ -253,7 +253,7 @@ emitCostCentreStackDecl ccs
                 -- layouts of structs containing long-longs, simply
                 -- pad out the struct with zero words until we hit the
                 -- size of the overall struct (which we get via DerivedConstants.h)
-           emitRawDataLits (mkCCSLabel ccs) (mk_lits cc)
+           emitDataLits (mkCCSLabel ccs) (mk_lits cc)
     Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
 
 zero :: Platform -> CmmLit
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index d6cea4206c..48f2e99bd6 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -243,7 +243,7 @@ emitTickyCounter cloType name args
 
         ; fun_descr_lit <- newStringCLit $ showSDocDebug dflags ppr_for_ticky_name
         ; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . fromNonVoid) args
-        ; emitRawDataLits ctr_lbl
+        ; emitDataLits ctr_lbl
         -- Must match layout of includes/rts/Ticky.h's StgEntCounter
         --
         -- krc: note that all the fields are I32 now; some were I16
@@ -256,7 +256,7 @@ emitTickyCounter cloType name args
               arg_descr_lit,
               zeroCLit platform,          -- Entries into this thing
               zeroCLit platform,          -- Heap allocated by this thing
-              zeroCLit platform                   -- Link to next StgEntCounter
+              zeroCLit platform           -- Link to next StgEntCounter
             ]
         }
 
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index bc9c4ac22f..de59cf3be9 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -11,8 +11,7 @@
 
 module GHC.StgToCmm.Utils (
         cgLit, mkSimpleLit,
-        emitRawDataLits, mkRawDataLits,
-        emitRawRODataLits, mkRawRODataLits,
+        emitDataLits, emitRODataLits,
         emitDataCon,
         emitRtsCall, emitRtsCallWithResult, emitRtsCallGen,
         assignTemp, newTemp,
@@ -38,7 +37,6 @@ module GHC.StgToCmm.Utils (
         cmmUntag, cmmIsTagged,
 
         addToMem, addToMemE, addToMemLblE, addToMemLbl,
-        mkWordCLit, mkByteStringCLit, mkFileEmbedLit,
         newStringCLit, newByteStringCLit,
         blankWord,
 
@@ -60,7 +58,7 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.Graph as CmmGraph
 import GHC.Platform.Regs
 import GHC.Cmm.CLabel
-import GHC.Cmm.Utils hiding (mkDataLits, mkRODataLits, mkByteStringCLit)
+import GHC.Cmm.Utils
 import GHC.Cmm.Switch
 import GHC.StgToCmm.CgUtils
 
@@ -83,7 +81,6 @@ import GHC.Types.CostCentre
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS8
-import qualified Data.ByteString as BS
 import qualified Data.Map as M
 import Data.Char
 import Data.List
@@ -276,45 +273,13 @@ callerSaveVolatileRegs dflags = (caller_save, caller_load)
 --
 -------------------------------------------------------------------------
 
-mkRawDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
--- Build a data-segment data block
-mkRawDataLits section lbl lits
-  = CmmData section (CmmStaticsRaw lbl (map CmmStaticLit lits))
+-- | Emit a data-segment data block
+emitDataLits :: CLabel -> [CmmLit] -> FCode ()
+emitDataLits lbl lits = emitDecl (mkDataLits (Section Data lbl) lbl lits)
 
-mkRawRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
--- Build a read-only data block
-mkRawRODataLits lbl lits
-  = mkRawDataLits section lbl lits
-  where
-    section | any needsRelocation lits = Section RelocatableReadOnlyData lbl
-            | otherwise                = Section ReadOnlyData lbl
-    needsRelocation (CmmLabel _)      = True
-    needsRelocation (CmmLabelOff _ _) = True
-    needsRelocation _                 = False
-
--- | We make a top-level decl for the string, and return a label pointing to it
-mkByteStringCLit
-  :: CLabel -> ByteString -> (CmmLit, GenCmmDecl CmmStatics info stmt)
-mkByteStringCLit lbl bytes
-  = (CmmLabel lbl, CmmData (Section sec lbl) (CmmStaticsRaw lbl [CmmString bytes]))
-  where
-    -- This can not happen for String literals (as there \NUL is replaced by
-    -- C0 80). However, it can happen with Addr# literals.
-    sec = if 0 `BS.elem` bytes then ReadOnlyData else CString
-
--- | We make a top-level decl for the embedded binary file, and return a label pointing to it
-mkFileEmbedLit
-  :: CLabel -> FilePath -> (CmmLit, GenCmmDecl CmmStatics info stmt)
-mkFileEmbedLit lbl path
-  = (CmmLabel lbl, CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmFileEmbed path]))
-
-emitRawDataLits :: CLabel -> [CmmLit] -> FCode ()
--- Emit a data-segment data block
-emitRawDataLits lbl lits = emitDecl (mkRawDataLits (Section Data lbl) lbl lits)
-
-emitRawRODataLits :: CLabel -> [CmmLit] -> FCode ()
--- Emit a read-only data block
-emitRawRODataLits lbl lits = emitDecl (mkRawRODataLits lbl lits)
+-- | Emit a read-only data block
+emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
+emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)
 
 emitDataCon :: CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
 emitDataCon lbl itbl ccs payload = emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload))