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

27 files changed, 96 insertions, 98 deletions

diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs
index 9e96b979b4..d59cbd08e4 100644
--- a/compiler/cmm/BlockId.hs
+++ b/compiler/cmm/BlockId.hs
@@ -5,9 +5,6 @@
 module BlockId
   ( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet
   , newBlockId
-  , BlockSet, BlockEnv
-  , IsSet(..)
-  , IsMap(..)
   , blockLbl, infoTblLbl
   ) where
 
@@ -52,15 +49,3 @@ blockLbl label = mkEntryLabel (mkFCallName (getUnique label) "block") NoCafRefs
 
 infoTblLbl :: BlockId -> CLabel
 infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs
-
--- Block environments: Id blocks
-type BlockEnv a = Hoopl.LabelMap a
-
-instance Outputable a => Outputable (BlockEnv a) where
-  ppr = ppr . mapToList
-
--- Block sets
-type BlockSet = Hoopl.LabelSet
-
-instance Outputable BlockSet where
-  ppr = ppr . setElems
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 3195935fa2..39c2d390d5 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -57,7 +57,7 @@ type CmmProgram = [CmmGroup]
 
 type GenCmmGroup d h g = [GenCmmDecl d h g]
 type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
-type RawCmmGroup = GenCmmGroup CmmStatics (BlockEnv CmmStatics) CmmGraph
+type RawCmmGroup = GenCmmGroup CmmStatics (LabelMap CmmStatics) CmmGraph
 
 -----------------------------------------------------------------------------
 --  CmmDecl, GenCmmDecl
@@ -94,7 +94,7 @@ type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
 type RawCmmDecl
    = GenCmmDecl
         CmmStatics
-        (BlockEnv CmmStatics)
+        (LabelMap CmmStatics)
         CmmGraph
 
 -----------------------------------------------------------------------------
@@ -114,7 +114,7 @@ type CmmBwdRewrite f = BwdRewrite UniqSM CmmNode f
 --     Info Tables
 -----------------------------------------------------------------------------
 
-data CmmTopInfo   = TopInfo { info_tbls  :: BlockEnv CmmInfoTable
+data CmmTopInfo   = TopInfo { info_tbls  :: LabelMap CmmInfoTable
                             , stack_info :: CmmStackInfo }
 
 topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index c4ec95cf1c..af3a092a93 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -9,7 +9,6 @@ where
 
 import Hoopl
 import Digraph
-import BlockId
 import Bitmap
 import CLabel
 import PprCmmDecl ()
@@ -83,7 +82,7 @@ This is what flattenCAFSets is doing.
 -- Finding the CAFs used by a procedure
 
 type CAFSet = Set CLabel
-type CAFEnv = BlockEnv CAFSet
+type CAFEnv = LabelMap CAFSet
 
 cafLattice :: DataflowLattice CAFSet
 cafLattice = DataflowLattice Set.empty add
@@ -292,7 +291,7 @@ flatten env cafset = foldSet (lookup env) Set.empty cafset
 bundle :: Map CLabel CAFSet
        -> (CAFEnv, CmmDecl)
        -> (CAFSet, Maybe CLabel)
-       -> (BlockEnv CAFSet, CmmDecl)
+       -> (LabelMap CAFSet, CmmDecl)
 bundle flatmap (env, decl@(CmmProc infos _lbl _ g)) (closure_cafs, mb_lbl)
   = ( mapMapWithKey get_cafs (info_tbls infos), decl )
  where
@@ -316,7 +315,7 @@ bundle _flatmap (_, decl) _
   = ( mapEmpty, decl )
 
 
-flattenCAFSets :: [(CAFEnv, [CmmDecl])] -> [(BlockEnv CAFSet, CmmDecl)]
+flattenCAFSets :: [(CAFEnv, [CmmDecl])] -> [(LabelMap CAFSet, CmmDecl)]
 flattenCAFSets cpsdecls = zipWith (bundle flatmap) zipped localCAFs
    where
      zipped    = [ (env,decl) | (env,decls) <- cpsdecls, decl <- decls ]
@@ -342,8 +341,8 @@ doSRTs dflags topSRT tops
     setSRT (topSRT, rst) (_, decl) =
       return (topSRT, decl : rst)
 
-buildSRTs :: DynFlags -> TopSRT -> BlockEnv CAFSet
-          -> UniqSM (TopSRT, [CmmDecl], BlockEnv C_SRT)
+buildSRTs :: DynFlags -> TopSRT -> LabelMap CAFSet
+          -> UniqSM (TopSRT, [CmmDecl], LabelMap C_SRT)
 buildSRTs dflags top_srt caf_map
   = foldM doOne (top_srt, [], mapEmpty) (mapToList caf_map)
   where
@@ -359,7 +358,7 @@ buildSRTs dflags top_srt caf_map
 - Each one needs an SRT.
 - We get the CAFSet for each one from the CAFEnv
 - flatten gives us
-    [(BlockEnv CAFSet, CmmDecl)]
+    [(LabelMap CAFSet, CmmDecl)]
 -
 -}
 
@@ -372,7 +371,7 @@ buildSRTs dflags top_srt caf_map
    instructions for forward refs.  --SDM
 -}
 
-updInfoSRTs :: BlockEnv C_SRT -> CmmDecl -> CmmDecl
+updInfoSRTs :: LabelMap C_SRT -> CmmDecl -> CmmDecl
 updInfoSRTs srt_env (CmmProc top_info top_l live g) =
   CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l live g
   where updInfoTbl l info_tbl
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index 80acae11d4..989eb2fb18 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -66,7 +66,7 @@ elimCommonBlocks g = replaceLabels env $ copyTicks env g
 -- (so avoid comparing them again)
 type DistinctBlocks = [CmmBlock]
 type Key = [Label]
-type Subst = BlockEnv BlockId
+type Subst = LabelMap BlockId
 
 -- The outer list groups by hash. We retain this grouping throughout.
 iterate :: Subst -> [[(Key, DistinctBlocks)]] -> Subst
@@ -186,9 +186,9 @@ dont_care _other         = False
 -- Utilities: equality and substitution on the graph.
 
 -- Given a map ``subst'' from BlockID -> BlockID, we define equality.
-eqBid :: BlockEnv BlockId -> BlockId -> BlockId -> Bool
+eqBid :: LabelMap BlockId -> BlockId -> BlockId -> Bool
 eqBid subst bid bid' = lookupBid subst bid == lookupBid subst bid'
-lookupBid :: BlockEnv BlockId -> BlockId -> BlockId
+lookupBid :: LabelMap BlockId -> BlockId -> BlockId
 lookupBid subst bid = case mapLookup bid subst of
                         Just bid  -> lookupBid subst bid
                         Nothing -> bid
@@ -266,7 +266,7 @@ eqMaybeWith _ _ _ = False
 -- the same ticks as the respective "source" blocks. This not only
 -- means copying ticks, but also adjusting tick scopes where
 -- necessary.
-copyTicks :: BlockEnv BlockId -> CmmGraph -> CmmGraph
+copyTicks :: LabelMap BlockId -> CmmGraph -> CmmGraph
 copyTicks env g
   | mapNull env = g
   | otherwise   = ofBlockMap (g_entry g) $ mapMap copyTo blockMap
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index b825f86275..d8740df3f2 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -74,7 +74,7 @@ import Prelude hiding (succ, unzip, zip)
 -- Note [Shortcut call returns]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
--- We are going to maintain the "current" graph (BlockEnv CmmBlock) as
+-- We are going to maintain the "current" graph (LabelMap CmmBlock) as
 -- we go, and also a mapping from BlockId to BlockId, representing
 -- continuation labels that we have renamed.  This latter mapping is
 -- important because we might shortcut a CmmCall continuation.  For
@@ -153,7 +153,7 @@ cmmCfgOptsProc split (CmmProc info lbl live g) = CmmProc info' lbl live g'
 cmmCfgOptsProc _ top = top
 
 
-blockConcat :: Bool -> CmmGraph -> (CmmGraph, BlockEnv BlockId)
+blockConcat :: Bool -> CmmGraph -> (CmmGraph, LabelMap BlockId)
 blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
   = (replaceLabels shortcut_map $ ofBlockMap new_entry new_blocks, shortcut_map')
   where
@@ -188,8 +188,8 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
      initialBackEdges = incPreds entry_id (predMap blocks)
 
      maybe_concat :: CmmBlock
-                  -> (BlockEnv CmmBlock, BlockEnv BlockId, BlockEnv Int)
-                  -> (BlockEnv CmmBlock, BlockEnv BlockId, BlockEnv Int)
+                  -> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int)
+                  -> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int)
      maybe_concat block (blocks, shortcut_map, backEdges)
         -- If:
         --   (1) current block ends with unconditional branch to b' and
@@ -313,7 +313,7 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
 -- that invariant, but calling replaceLabels may introduce unreachable blocks.
 -- We rely on subsequent passes in the Cmm pipeline to remove unreachable
 -- blocks.
-incPreds, decPreds :: BlockId -> BlockEnv Int -> BlockEnv Int
+incPreds, decPreds :: BlockId -> LabelMap Int -> LabelMap Int
 incPreds bid edges = mapInsertWith (+) bid 1 edges
 decPreds bid edges = case mapLookup bid edges of
                        Just preds | preds > 1 -> mapInsert bid (preds - 1) edges
@@ -352,8 +352,8 @@ callContinuation_maybe _ = Nothing
 
 
 -- Map over the CmmGraph, replacing each label with its mapping in the
--- supplied BlockEnv.
-replaceLabels :: BlockEnv BlockId -> CmmGraph -> CmmGraph
+-- supplied LabelMap.
+replaceLabels :: LabelMap BlockId -> CmmGraph -> CmmGraph
 replaceLabels env g
   | mapNull env = g
   | otherwise   = replace_eid $ mapGraphNodes1 txnode g
@@ -383,7 +383,7 @@ mkCmmCondBranch p t f l =
   if t == f then CmmBranch t else CmmCondBranch p t f l
 
 -- Build a map from a block to its set of predecessors.
-predMap :: [CmmBlock] -> BlockEnv Int
+predMap :: [CmmBlock] -> LabelMap Int
 predMap blocks = foldr add_preds mapEmpty blocks
   where
     add_preds block env = foldr add env (successors block)
@@ -401,10 +401,10 @@ removeUnreachableBlocksProc proc@(CmmProc info lbl live g)
      info' = info { info_tbls = keep_used (info_tbls info) }
              -- Remove any info_tbls for unreachable
 
-     keep_used :: BlockEnv CmmInfoTable -> BlockEnv CmmInfoTable
+     keep_used :: LabelMap CmmInfoTable -> LabelMap CmmInfoTable
      keep_used bs = mapFoldWithKey keep mapEmpty bs
 
-     keep :: Label -> CmmInfoTable -> BlockEnv CmmInfoTable -> BlockEnv CmmInfoTable
+     keep :: Label -> CmmInfoTable -> LabelMap CmmInfoTable -> LabelMap CmmInfoTable
      keep l i env | l `setMember` used_lbls = mapInsert l i env
                   | otherwise               = env
 
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index d1e7eae90b..db3e8c7218 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -187,7 +187,7 @@ instance Outputable StackMap where
 
 
 cmmLayoutStack :: DynFlags -> ProcPointSet -> ByteOff -> CmmGraph
-               -> UniqSM (CmmGraph, BlockEnv StackMap)
+               -> UniqSM (CmmGraph, LabelMap StackMap)
 cmmLayoutStack dflags procpoints entry_args
                graph@(CmmGraph { g_entry = entry })
   = do
@@ -206,18 +206,18 @@ cmmLayoutStack dflags procpoints entry_args
 
 
 layout :: DynFlags
-       -> BlockSet                      -- proc points
-       -> BlockEnv CmmLocalLive         -- liveness
+       -> LabelSet                      -- proc points
+       -> LabelMap CmmLocalLive         -- liveness
        -> BlockId                       -- entry
        -> ByteOff                       -- stack args on entry
 
-       -> BlockEnv StackMap             -- [final] stack maps
+       -> LabelMap StackMap             -- [final] stack maps
        -> ByteOff                       -- [final] Sp high water mark
 
        -> [CmmBlock]                    -- [in] blocks
 
        -> UniqSM
-          ( BlockEnv StackMap           -- [out] stack maps
+          ( LabelMap StackMap           -- [out] stack maps
           , ByteOff                     -- [out] Sp high water mark
           , [CmmBlock]                  -- [out] new blocks
           )
@@ -316,7 +316,7 @@ isGcJump _something_else = False
 -- unnecessarily pessimistic, but probably not in the code we
 -- generate.
 
-collectContInfo :: [CmmBlock] -> (ByteOff, BlockEnv ByteOff)
+collectContInfo :: [CmmBlock] -> (ByteOff, LabelMap ByteOff)
 collectContInfo blocks
   = (maximum ret_offs, mapFromList (catMaybes mb_argss))
  where
@@ -344,7 +344,7 @@ collectContInfo blocks
 -- on the stack and need to be immediately saved across a call, we
 -- want to just leave them where they are on the stack.
 --
-procMiddle :: BlockEnv StackMap -> CmmNode e x -> StackMap -> StackMap
+procMiddle :: LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap
 procMiddle stackmaps node sm
   = case node of
      CmmAssign (CmmLocal r) (CmmLoad (CmmStackSlot area off) _)
@@ -355,7 +355,7 @@ procMiddle stackmaps node sm
      _other
        -> sm
 
-getStackLoc :: Area -> ByteOff -> BlockEnv StackMap -> StackLoc
+getStackLoc :: Area -> ByteOff -> LabelMap StackMap -> StackLoc
 getStackLoc Old       n _         = n
 getStackLoc (Young l) n stackmaps =
   case mapLookup l stackmaps of
@@ -383,8 +383,8 @@ getStackLoc (Young l) n stackmaps =
 -- extra code that goes *after* the Sp adjustment.
 
 handleLastNode
-   :: DynFlags -> ProcPointSet -> BlockEnv CmmLocalLive -> BlockEnv ByteOff
-   -> BlockEnv StackMap -> StackMap -> CmmTickScope
+   :: DynFlags -> ProcPointSet -> LabelMap CmmLocalLive -> LabelMap ByteOff
+   -> LabelMap StackMap -> StackMap -> CmmTickScope
    -> Block CmmNode O O
    -> CmmNode O C
    -> UniqSM
@@ -392,7 +392,7 @@ handleLastNode
       , ByteOff            -- amount to adjust Sp
       , CmmNode O C        -- new last node
       , [CmmBlock]         -- new blocks
-      , BlockEnv StackMap  -- stackmaps for the continuations
+      , LabelMap StackMap  -- stackmaps for the continuations
       )
 
 handleLastNode dflags procpoints liveness cont_info stackmaps
@@ -424,7 +424,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
                  , ByteOff
                  , CmmNode O C
                  , [CmmBlock]
-                 , BlockEnv StackMap
+                 , LabelMap StackMap
                  )
      lastCall lbl cml_args cml_ret_args cml_ret_off
       =  ( assignments
@@ -457,7 +457,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
                                 , ByteOff
                                 , CmmNode O C
                                 , [CmmBlock]
-                                , BlockEnv StackMap )
+                                , LabelMap StackMap )
 
      handleBranches
          -- Note [diamond proc point]
@@ -561,7 +561,7 @@ fixupStack old_stack new_stack = concatMap move new_locs
 setupStackFrame
              :: DynFlags
              -> BlockId                 -- label of continuation
-             -> BlockEnv CmmLocalLive   -- liveness
+             -> LabelMap CmmLocalLive   -- liveness
              -> ByteOff      -- updfr
              -> ByteOff      -- bytes of return values on stack
              -> StackMap     -- current StackMap
@@ -772,7 +772,7 @@ allocate dflags ret_off live stackmap@StackMap{ sm_sp = sp0
 --
 manifestSp
    :: DynFlags
-   -> BlockEnv StackMap  -- StackMaps for other blocks
+   -> LabelMap StackMap  -- StackMaps for other blocks
    -> StackMap           -- StackMap for this block
    -> ByteOff            -- Sp on entry to the block
    -> ByteOff            -- SpHigh
@@ -813,7 +813,7 @@ manifestSp dflags stackmaps stack0 sp0 sp_high
     fixup_blocks' = map (mapBlock3' (id, adj_post_sp, id)) fixup_blocks
 
 
-getAreaOff :: BlockEnv StackMap -> (Area -> StackLoc)
+getAreaOff :: LabelMap StackMap -> (Area -> StackLoc)
 getAreaOff _ Old = 0
 getAreaOff stackmaps (Young l) =
   case mapLookup l stackmaps of
@@ -918,7 +918,7 @@ optStackCheck n = -- Note [Always false stack check]
 -- StackMap will invalidate its mapping there.
 --
 elimStackStores :: StackMap
-                -> BlockEnv StackMap
+                -> LabelMap StackMap
                 -> (Area -> ByteOff)
                 -> [CmmNode O O]
                 -> [CmmNode O O]
@@ -940,7 +940,7 @@ elimStackStores stackmap stackmaps area_off nodes
 -- Update info tables to include stack liveness
 
 
-setInfoTableStackMap :: DynFlags -> BlockEnv StackMap -> CmmDecl -> CmmDecl
+setInfoTableStackMap :: DynFlags -> LabelMap StackMap -> CmmDecl -> CmmDecl
 setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l v g)
   = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l v g
   where
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index c009112d4b..12c884a710 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -16,7 +16,6 @@ import CmmUtils
 import CmmLive
 import CmmSwitch (switchTargetsToList)
 import PprCmm ()
-import BlockId
 import Outputable
 import DynFlags
 
@@ -64,7 +63,7 @@ lintCmmGraph dflags g =
        labels = setFromList (map entryLabel blocks)
 
 
-lintCmmBlock :: BlockSet -> CmmBlock -> CmmLint ()
+lintCmmBlock :: LabelSet -> CmmBlock -> CmmLint ()
 lintCmmBlock labels block
   = addLintInfo (text "in basic block " <> ppr (entryLabel block)) $ do
         let (_, middle, last) = blockSplit block
@@ -157,7 +156,7 @@ lintCmmMiddle node = case node of
             mapM_ lintCmmExpr actuals
 
 
-lintCmmLast :: BlockSet -> CmmNode O C -> CmmLint ()
+lintCmmLast :: LabelSet -> CmmNode O C -> CmmLint ()
 lintCmmLast labels node = case node of
   CmmBranch id -> checkTarget id
 
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 7d77948c77..b7a8dd6eec 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -40,7 +40,7 @@ liveLattice = DataflowLattice emptyRegSet add
         in changedIf (sizeRegSet join > sizeRegSet old) join
 
 -- | A mapping from block labels to the variables live on entry
-type BlockEntryLiveness r = BlockEnv (CmmLive r)
+type BlockEntryLiveness r = LabelMap (CmmLive r)
 
 -----------------------------------------------------------------------------
 -- | Calculated liveness info for a CmmGraph
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 40810a59da..608654f4f7 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -112,7 +112,7 @@ if a proc-point does not exist anymore then we will get compiler panic.
 See #8205.
 -}
 
-type ProcPointSet = BlockSet
+type ProcPointSet = LabelSet
 
 data Status
   = ReachedBy ProcPointSet  -- set of proc points that directly reach the block
@@ -131,7 +131,7 @@ instance Outputable Status where
 -- Once you know what the proc-points are, figure out
 -- what proc-points each block is reachable from
 -- See Note [Proc-point analysis]
-procPointAnalysis :: ProcPointSet -> CmmGraph -> UniqSM (BlockEnv Status)
+procPointAnalysis :: ProcPointSet -> CmmGraph -> UniqSM (LabelMap Status)
 procPointAnalysis procPoints cmmGraph@(CmmGraph {g_graph = graph}) =
     return $
         analyzeCmmFwd procPointLattice procPointTransfer cmmGraph initProcPoints
@@ -176,7 +176,7 @@ procPointLattice = DataflowLattice unreached add_to
 -- Extract the set of Continuation BlockIds, see Note [Continuation BlockIds].
 callProcPoints      :: CmmGraph -> ProcPointSet
 callProcPoints g = foldGraphBlocks add (setSingleton (g_entry g)) g
-  where add :: CmmBlock -> BlockSet -> BlockSet
+  where add :: CmmBlock -> LabelSet -> LabelSet
         add b set = case lastNode b of
                       CmmCall {cml_cont = Just k} -> setInsert k set
                       CmmForeignCall {succ=k}     -> setInsert k set
@@ -238,7 +238,7 @@ extendPPSet platform g blocks procPoints =
 -- Input invariant: A block should only be reachable from a single ProcPoint.
 -- ToDo: use the _ret naming convention that the old code generator
 -- used. -- EZY
-splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> BlockEnv Status ->
+splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status ->
                      CmmDecl -> UniqSM [CmmDecl]
 splitAtProcPoints dflags entry_label callPPs procPoints procMap
                   (CmmProc (TopInfo {info_tbls = info_tbls})
@@ -388,7 +388,7 @@ splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
 
 -- Only called from CmmProcPoint.splitAtProcPoints. NB. does a
 -- recursive lookup, see comment below.
-replaceBranches :: BlockEnv BlockId -> CmmGraph -> CmmGraph
+replaceBranches :: LabelMap BlockId -> CmmGraph -> CmmGraph
 replaceBranches env cmmg
   = {-# SCC "replaceBranches" #-}
     ofBlockMap (g_entry cmmg) $ mapMap f $ toBlockMap cmmg
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index 7279013e60..acac1c1ede 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -5,7 +5,6 @@ module CmmSink (
 
 import Cmm
 import CmmOpt
-import BlockId
 import CmmLive
 import CmmUtils
 import Hoopl
@@ -154,7 +153,7 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
 
   join_pts = findJoinPoints blocks
 
-  sink :: BlockEnv Assignments -> [CmmBlock] -> [CmmBlock]
+  sink :: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
   sink _ [] = []
   sink sunk (b:bs) =
     -- pprTrace "sink" (ppr lbl) $
@@ -253,12 +252,12 @@ annotate dflags live nodes = snd $ foldr ann (live,[]) nodes
 --
 -- Find the blocks that have multiple successors (join points)
 --
-findJoinPoints :: [CmmBlock] -> BlockEnv Int
+findJoinPoints :: [CmmBlock] -> LabelMap Int
 findJoinPoints blocks = mapFilter (>1) succ_counts
  where
   all_succs = concatMap successors blocks
 
-  succ_counts :: BlockEnv Int
+  succ_counts :: LabelMap Int
   succ_counts = foldr (\l -> mapInsertWith (+) l 1) mapEmpty all_succs
 
 --
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 89d824ea69..f0bc0968c2 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -476,13 +476,13 @@ mkLiveness dflags (reg:regs)
 modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
 modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
 
-toBlockMap :: CmmGraph -> BlockEnv CmmBlock
+toBlockMap :: CmmGraph -> LabelMap CmmBlock
 toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
 
-ofBlockMap :: BlockId -> BlockEnv CmmBlock -> CmmGraph
+ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
 ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}
 
-insertBlock :: CmmBlock -> BlockEnv CmmBlock -> BlockEnv CmmBlock
+insertBlock :: CmmBlock -> LabelMap CmmBlock -> LabelMap CmmBlock
 insertBlock block map =
   ASSERT(isNothing $ mapLookup id map)
   mapInsert id block map
diff --git a/compiler/cmm/Hoopl.hs b/compiler/cmm/Hoopl.hs
index 732c1b7bd0..60cae8ab2b 100644
--- a/compiler/cmm/Hoopl.hs
+++ b/compiler/cmm/Hoopl.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Hoopl (
     module Compiler.Hoopl,
@@ -19,3 +20,10 @@ import Compiler.Hoopl hiding
   )
 
 import Hoopl.Dataflow
+import Outputable
+
+instance Outputable LabelSet where
+  ppr = ppr . setElems
+
+instance Outputable a => Outputable (LabelMap a) where
+  ppr = ppr . mapToList
diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index 3115aa0b58..b98c681a1b 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -30,7 +30,6 @@ module Hoopl.Dataflow
   )
 where
 
-import BlockId
 import Cmm
 
 import Data.Array
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 $$