BlockId: remove BlockMap and BlockSet synonyms

This continues removal of `BlockId` module in favor of Hoopl's `Label`.
Most of the changes here are mechanical, apart from the orphan
`Outputable` instances for `LabelMap` and `LabelSet`.  For now I've
moved them to `cmm/Hoopl`, since it's already trying to manage all
imports from Hoopl (to avoid any collisions).

Signed-off-by: Michal Terepeta <michal.terepeta@gmail.com>

Test Plan: validate

Reviewers: bgamari, austin, simonmar

Reviewed By: simonmar

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2800

14 files changed, 32 insertions, 23 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index ad897abc0f..0a15638cc4 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -162,7 +162,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgExpandTop              :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgAllocMoreStack         :: Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr),
-    ncgMakeFarBranches        :: BlockEnv CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
+    ncgMakeFarBranches        :: LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
     }
 
 --------------------
@@ -761,7 +761,7 @@ sequenceTop ncgImpl (CmmProc info lbl live (ListGraph blocks)) =
 
 sequenceBlocks
         :: Instruction instr
-        => BlockEnv i
+        => LabelMap i
         -> [NatBasicBlock instr]
         -> [NatBasicBlock instr]
 
@@ -796,7 +796,7 @@ mkNode :: (Instruction t)
        -> (GenBasicBlock t, BlockId, [BlockId])
 mkNode block@(BasicBlock id instrs) = (block, id, getOutEdges instrs)
 
-seqBlocks :: BlockEnv i -> [(GenBasicBlock t1, BlockId, [BlockId])]
+seqBlocks :: LabelMap i -> [(GenBasicBlock t1, BlockId, [BlockId])]
                         -> [GenBasicBlock t1]
 seqBlocks infos blocks = placeNext pullable0 todo0
   where
@@ -864,8 +864,8 @@ shortcutBranches dflags ncgImpl tops
     mapping = foldr plusUFM emptyUFM mappings
 
 build_mapping :: NcgImpl statics instr jumpDest
-              -> GenCmmDecl d (BlockEnv t) (ListGraph instr)
-              -> (GenCmmDecl d (BlockEnv t) (ListGraph instr), UniqFM jumpDest)
+              -> GenCmmDecl d (LabelMap t) (ListGraph instr)
+              -> (GenCmmDecl d (LabelMap t) (ListGraph instr), UniqFM jumpDest)
 build_mapping _ top@(CmmData _ _) = (top, emptyUFM)
 build_mapping _ (CmmProc info lbl live (ListGraph []))
   = (CmmProc info lbl live (ListGraph []), emptyUFM)
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index 8ecd2eb304..ff05cbd111 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -17,6 +17,7 @@ where
 import Reg
 
 import BlockId
+import Hoopl
 import DynFlags
 import Cmm hiding (topInfoTable)
 import Platform
@@ -43,13 +44,13 @@ noUsage  = RU [] []
 type NatCmm instr
         = GenCmmGroup
                 CmmStatics
-                (BlockEnv CmmStatics)
+                (LabelMap CmmStatics)
                 (ListGraph instr)
 
 type NatCmmDecl statics instr
         = GenCmmDecl
                 statics
-                (BlockEnv CmmStatics)
+                (LabelMap CmmStatics)
                 (ListGraph instr)
 
 
@@ -59,7 +60,7 @@ type NatBasicBlock instr
 
 -- | Returns the info table associated with the CmmDecl's entry point,
 -- if any.
-topInfoTable :: GenCmmDecl a (BlockEnv i) (ListGraph b) -> Maybe i
+topInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
 topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
   = mapLookup (blockId b) infos
 topInfoTable _
@@ -67,7 +68,7 @@ topInfoTable _
 
 -- | Return the list of BlockIds in a CmmDecl that are entry points
 -- for this proc (i.e. they may be jumped to from outside this proc).
-entryBlocks :: GenCmmDecl a (BlockEnv i) (ListGraph b) -> [BlockId]
+entryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
 entryBlocks (CmmProc info _ _ (ListGraph code)) = entries
   where
         infos = mapKeys info
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index b790d97bd1..ca5bafe63a 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -42,6 +42,7 @@ import Format
 import TargetReg
 
 import BlockId
+import Hoopl
 import CLabel           ( CLabel, mkAsmTempLabel )
 import Debug
 import FastString       ( FastString )
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 5dc0325dff..ae7d6bf260 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -33,6 +33,7 @@ import Reg
 
 import CodeGen.Platform
 import BlockId
+import Hoopl
 import DynFlags
 import Cmm
 import CmmInfo
@@ -117,7 +118,7 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do
         alloc   = mkStackAllocInstr   platform delta
         dealloc = mkStackDeallocInstr platform delta
 
-        new_blockmap :: BlockEnv BlockId
+        new_blockmap :: LabelMap BlockId
         new_blockmap = mapFromList (zip entries (map mkBlockId uniqs))
 
         insert_stack_insns (BasicBlock id insns)
@@ -655,7 +656,7 @@ ppc_takeRegRegMoveInstr _  = Nothing
 -- big, we have to work around this limitation.
 
 makeFarBranches
-        :: BlockEnv CmmStatics
+        :: LabelMap CmmStatics
         -> [NatBasicBlock Instr]
         -> [NatBasicBlock Instr]
 makeFarBranches info_env blocks
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index f0dd73e7a1..fcd084b8ae 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -20,7 +20,7 @@ import RegClass
 import TargetReg
 
 import Cmm hiding (topInfoTable)
-import BlockId
+import Hoopl
 
 import CLabel
 
@@ -104,7 +104,7 @@ pprFunctionPrologue lab =  pprGloblDecl lab
                         $$ text "\t.localentry\t" <> ppr lab
                         <> text ",.-" <> ppr lab
 
-pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
     pprLabel (mkAsmTempLabel (getUnique blockid)) $$
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 445f416187..0704e53102 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -12,6 +12,7 @@ import Instruction
 import Reg
 import Cmm hiding (RegSet)
 import BlockId
+import Hoopl
 
 import MonadUtils
 import State
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index c75bcebb7b..03da772819 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -33,6 +33,7 @@ import Instruction
 import Reg
 
 import BlockId
+import Hoopl
 import Cmm
 import UniqSet
 import UniqFM
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 198be622e1..efa1cd11e2 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -20,7 +20,7 @@ import Reg
 
 import GraphBase
 
-import BlockId
+import Hoopl (mapLookup)
 import Cmm
 import UniqFM
 import UniqSet
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 294608a04e..0b655374a5 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -17,6 +17,7 @@ import Instruction
 import Reg
 
 import BlockId
+import Hoopl
 import Digraph
 import DynFlags
 import Outputable
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index cec08a2f3f..4db02d6dee 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -118,6 +118,7 @@ import Instruction
 import Reg
 
 import BlockId
+import Hoopl
 import Cmm hiding (RegSet)
 
 import Digraph
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 98b9659748..a904202ba7 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -39,6 +39,7 @@ import Reg
 import Instruction
 
 import BlockId
+import Hoopl
 import Cmm hiding (RegSet)
 import PprCmm()
 
@@ -65,7 +66,7 @@ type RegMap a = UniqFM a
 emptyRegMap :: UniqFM a
 emptyRegMap = emptyUFM
 
-type BlockMap a = BlockEnv a
+type BlockMap a = LabelMap a
 
 
 -- | A top level thing which carries liveness information.
@@ -167,7 +168,7 @@ data Liveness
 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
 data LiveInfo
         = LiveInfo
-                (BlockEnv CmmStatics)     -- cmm info table static stuff
+                (LabelMap CmmStatics)     -- cmm info table static stuff
                 [BlockId]                 -- entry points (first one is the
                                           -- entry point for the proc).
                 (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
@@ -685,7 +686,7 @@ sccBlocks blocks entries = map (fmap get_node) sccs
 
         g1 = graphFromEdgedVerticesUniq nodes
 
-        reachable :: BlockSet
+        reachable :: LabelSet
         reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ]
 
         g2 = graphFromEdgedVerticesUniq [ node | node@(_,id,_) <- nodes
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 35d18b1e90..6763061dd3 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -39,7 +39,7 @@ import PprBase
 import Cmm hiding (topInfoTable)
 import PprCmm()
 import CLabel
-import BlockId
+import Hoopl
 
 import Unique           ( Uniquable(..), pprUnique )
 import Outputable
@@ -87,7 +87,7 @@ dspSection :: Section
 dspSection = Section Text $
     panic "subsections-via-symbols doesn't combine with split-sections"
 
-pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
     pprLabel (mkAsmTempLabel (getUnique blockid)) $$
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 40f3b822dd..0fabf71cfd 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -26,6 +26,7 @@ import Reg
 import TargetReg
 
 import BlockId
+import Hoopl
 import CodeGen.Platform
 import Cmm
 import FastString
@@ -964,7 +965,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
       alloc   = mkStackAllocInstr   platform delta
       dealloc = mkStackDeallocInstr platform delta
 
-      new_blockmap :: BlockEnv BlockId
+      new_blockmap :: LabelMap BlockId
       new_blockmap = mapFromList (zip entries (map mkBlockId uniqs))
 
       insert_stack_insns (BasicBlock id insns)
@@ -1002,7 +1003,7 @@ canShortcut _                    = Nothing
 -- This helper shortcuts a sequence of branches.
 -- The blockset helps avoid following cycles.
 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
-shortcutJump fn insn = shortcutJump' fn (setEmpty :: BlockSet) insn
+shortcutJump fn insn = shortcutJump' fn (setEmpty :: LabelSet) insn
   where shortcutJump' fn seen insn@(JXX cc id) =
           if setMember id seen then insn
           else case fn id of
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 6261aad5ca..f4ca20987a 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -32,7 +32,7 @@ import Reg
 import PprBase
 
 
-import BlockId
+import Hoopl
 import BasicTypes       (Alignment)
 import DynFlags
 import Cmm              hiding (topInfoTable)
@@ -116,7 +116,7 @@ pprSizeDecl lbl
    then text "\t.size" <+> ppr lbl <> ptext (sLit ", .-") <> ppr lbl
    else empty
 
-pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = sdocWithDynFlags $ \dflags ->
     maybe_infotable $$