Remove most functions from cmm/BlockId

It seems that `BlockId` module could simply go away in favor
of Hoopl's `Label`. This is the first step to do that.

In a few places I had to add some type signatures, but most of
them seem to help with code readability.

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

Test Plan: ./validate

Reviewers: austin, simonmar, bgamari

Reviewed By: bgamari

Subscribers: thomie

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

5 files changed, 12 insertions, 11 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index affb3e4e4a..ad897abc0f 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -877,7 +877,8 @@ build_mapping ncgImpl (CmmProc info lbl live (ListGraph (head:blocks)))
     -- find all the blocks that just consist of a jump that can be
     -- shorted.
     -- Don't completely eliminate loops here -- that can leave a dangling jump!
-    (_, shortcut_blocks, others) = foldl split (emptyBlockSet, [], []) blocks
+    (_, shortcut_blocks, others) =
+        foldl split (setEmpty :: LabelSet, [], []) blocks
     split (s, shortcut_blocks, others) b@(BasicBlock id [insn])
         | Just jd <- canShortcut ncgImpl insn,
           Just dest <- getJumpDestBlockId ncgImpl jd,
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index a9ea6e5728..445f416187 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -135,7 +135,7 @@ regSpill_top platform regSlotMap cmm
          = let
                 -- Slots that are already recorded as being live.
                 curSlotsLive    = fromMaybe IntSet.empty
-                                $ lookupBlockMap blockId slotMap
+                                $ mapLookup blockId slotMap
 
                 moreSlotsLive   = IntSet.fromList
                                 $ catMaybes
@@ -144,8 +144,8 @@ regSpill_top platform regSlotMap cmm
                     -- See Note [Unique Determinism and code generation]
 
                 slotMap'
-                 = insertBlockMap blockId (IntSet.union curSlotsLive moreSlotsLive)
-                                  slotMap
+                 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
+                             slotMap
 
            in   slotMap'
 
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 1df4b2570a..c75bcebb7b 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -381,7 +381,7 @@ cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
                 let slotsReloadedByTargets
                         = IntSet.unions
                         $ catMaybes
-                        $ map (flip lookupBlockMap liveSlotsOnEntry)
+                        $ map (flip mapLookup liveSlotsOnEntry)
                         $ targets
 
                 let noReloads'
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 0fe2592e60..cec08a2f3f 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -234,7 +234,7 @@ linearRegAlloc'
 linearRegAlloc' dflags initFreeRegs entry_ids block_live sccs
  = do   us      <- getUniqueSupplyM
         let (_, stack, stats, blocks) =
-                runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap dflags) us
+                runR dflags mapEmpty initFreeRegs emptyRegMap (emptyStackMap dflags) us
                     $ linearRA_SCCs entry_ids block_live [] sccs
         return  (blocks, stats, getStackUse stack)
 
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 988bda05a8..98b9659748 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -14,7 +14,7 @@
 module RegAlloc.Liveness (
         RegSet,
         RegMap, emptyRegMap,
-        BlockMap, emptyBlockMap,
+        BlockMap, mapEmpty,
         LiveCmmDecl,
         InstrSR   (..),
         LiveInstr (..),
@@ -646,7 +646,7 @@ natCmmTopToLive (CmmData i d)
         = CmmData i d
 
 natCmmTopToLive (CmmProc info lbl live (ListGraph []))
-        = CmmProc (LiveInfo info [] Nothing emptyBlockMap) lbl live []
+        = CmmProc (LiveInfo info [] Nothing mapEmpty) lbl live []
 
 natCmmTopToLive proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
  = let  first_id        = blockId first
@@ -657,7 +657,7 @@ natCmmTopToLive proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
                                         BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
                         $ sccs
 
-   in   CmmProc (LiveInfo info (first_id : entry_ids) Nothing emptyBlockMap)
+   in   CmmProc (LiveInfo info (first_id : entry_ids) Nothing mapEmpty)
                 lbl live sccsLive
 
 
@@ -723,7 +723,7 @@ regLiveness _ (CmmData i d)
 regLiveness _ (CmmProc info lbl live [])
         | LiveInfo static mFirst _ _    <- info
         = return $ CmmProc
-                        (LiveInfo static mFirst (Just mapEmpty) emptyBlockMap)
+                        (LiveInfo static mFirst (Just mapEmpty) mapEmpty)
                         lbl live []
 
 regLiveness platform (CmmProc info lbl live sccs)
@@ -805,7 +805,7 @@ computeLiveness
 
 computeLiveness platform sccs
  = case checkIsReverseDependent sccs of
-        Nothing         -> livenessSCCs platform emptyBlockMap [] sccs
+        Nothing         -> livenessSCCs platform mapEmpty [] sccs
         Just bad        -> pprPanic "RegAlloc.Liveness.computeLivenss"
                                 (vcat   [ text "SCCs aren't in reverse dependent order"
                                         , text "bad blockId" <+> ppr bad