Don't wrap the entry map for LiveInfo in Maybe.

It never really encoded a invariant.

* The linear register allocator just did partial pattern matches
* The graph allocator just set it to (Just mapEmpty) for Nothing

So I changed LiveInfo to directly contain the map.

Further natCmmTopToLive which filled in Nothing is no longer exported.
Instead we know call cmmTopLiveness which changes the type AND fills
in the map.

6 files changed, 27 insertions, 26 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 8c62a15429..4672415ec5 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -587,9 +587,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
         let (withLiveness, usLive) =
                 {-# SCC "regLiveness" #-}
                 initUs usGen
-                        $ mapM (regLiveness platform)
-                        -- TODO: Only use CFG for x86
-                        $ map (natCmmTopToLive livenessCfg) native
+                        $ mapM (cmmTopLiveness livenessCfg platform) native
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_liveness "Liveness annotations added"
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 146f88a8b6..c7875cfaea 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -89,7 +89,8 @@ regAlloc dflags regsFree slotsFree slotsCount code cfg
 --   and try to colour it again. After `maxSpinCount` iterations we give up.
 --
 regAlloc_spin
-        :: (Instruction instr,
+        :: forall instr statics.
+           (Instruction instr,
             Outputable instr,
             Outputable statics)
         => DynFlags
@@ -180,7 +181,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
                 | otherwise
                 = reg
 
-        let code_coalesced
+        let (code_coalesced :: [LiveCmmDecl statics instr])
                 = map (patchEraseLive patchF) code
 
         -- Check whether we've found a coloring.
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 2e1879926e..bc26a663a5 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -105,12 +105,8 @@ regSpill_top platform regSlotMap cmm
          -> return cmm
 
         CmmProc info label live sccs
-         |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
+         |  LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry <- info
          -> do
-                -- We should only passed Cmms with the liveness maps filled in,
-                -- but we'll create empty ones if they're not there just in case.
-                let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry
-
                 -- The liveVRegsOnEntry contains the set of vregs that are live
                 -- on entry to each basic block. If we spill one of those vregs
                 -- we remove it from that set and add the corresponding slot
@@ -124,7 +120,7 @@ regSpill_top platform regSlotMap cmm
 
                 let info'
                         = LiveInfo static firstId
-                                (Just liveVRegsOnEntry)
+                                liveVRegsOnEntry
                                 liveSlotsOnEntry'
 
                 -- Apply the spiller to all the basic blocks in the CmmProc.
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 4d5f44a8d3..b62c44fa81 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -94,7 +94,7 @@ slurpSpillCostInfo platform cfg cmm
         -- Lookup the regs that are live on entry to this block in
         --      the info table from the CmmProc.
         countBlock info (BasicBlock blockId instrs)
-                | LiveInfo _ _ (Just blockLive) _ <- info
+                | LiveInfo _ _ blockLive _ <- info
                 , Just rsLiveEntry  <- mapLookup blockId blockLive
                 , rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
                 = countLIs (loopMember blockId) rsLiveEntry_virt instrs
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index bcac084c5f..a9337b0044 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -162,7 +162,7 @@ regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl live [])
                  , Nothing )
 
 regAlloc dflags (CmmProc static lbl live sccs)
-        | LiveInfo info entry_ids@(first_id:_) (Just block_live) _ <- static
+        | LiveInfo info entry_ids@(first_id:_) block_live _ <- static
         = do
                 -- do register allocation on each component.
                 (final_blocks, stats, stack_use)
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index b7f8d1c871..065231faf3 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -33,7 +33,7 @@ module RegAlloc.Liveness (
         patchRegsLiveInstr,
         reverseBlocksInTops,
         regLiveness,
-        natCmmTopToLive
+        cmmTopLiveness
   ) where
 import GhcPrelude
 
@@ -178,7 +178,7 @@ data LiveInfo
                 (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
+                (BlockMap RegSet)         -- argument locals live on entry to this block
                 (BlockMap IntSet)         -- stack slots live on entry to this block
 
 
@@ -319,7 +319,7 @@ slurpConflicts live
                 = foldl'  (slurpBlock info) rs bs
 
         slurpBlock info rs (BasicBlock blockId instrs)
-                | LiveInfo _ _ (Just blockLive) _ <- info
+                | LiveInfo _ _ blockLive _        <- info
                 , Just rsLiveEntry                <- mapLookup blockId blockLive
                 , (conflicts, moves)              <- slurpLIs rsLiveEntry rs instrs
                 = (consBag rsLiveEntry conflicts, moves)
@@ -577,18 +577,15 @@ patchEraseLive patchF cmm
         patchCmm cmm@CmmData{}  = cmm
 
         patchCmm (CmmProc info label live sccs)
-         | LiveInfo static id (Just blockMap) mLiveSlots <- info
+         | LiveInfo static id blockMap mLiveSlots <- info
          = let
                 patchRegSet set = mkUniqSet $ map patchF $ nonDetEltsUFM set
                   -- See Note [Unique Determinism and code generation]
                 blockMap'       = mapMap (patchRegSet . getUniqSet) blockMap
 
-                info'           = LiveInfo static id (Just blockMap') mLiveSlots
+                info'           = LiveInfo static id blockMap' mLiveSlots
            in   CmmProc info' label live $ map patchSCC sccs
 
-         | otherwise
-         = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
-
         patchSCC (AcyclicSCC b)  = AcyclicSCC (patchBlock b)
         patchSCC (CyclicSCC  bs) = CyclicSCC  (map patchBlock bs)
 
@@ -644,7 +641,15 @@ patchRegsLiveInstr patchF li
 
 
 --------------------------------------------------------------------------------
--- | Convert a NatCmmDecl to a LiveCmmDecl, with empty liveness information
+-- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information
+
+cmmTopLiveness
+        :: (Outputable instr, Instruction instr)
+        => Maybe CFG -> Platform
+        -> NatCmmDecl statics instr
+        -> UniqSM (LiveCmmDecl statics instr)
+cmmTopLiveness cfg platform cmm
+        = regLiveness platform $ natCmmTopToLive cfg cmm
 
 natCmmTopToLive
         :: (Instruction instr, Outputable instr)
@@ -655,10 +660,10 @@ natCmmTopToLive _ (CmmData i d)
         = CmmData i d
 
 natCmmTopToLive _ (CmmProc info lbl live (ListGraph []))
-        = CmmProc (LiveInfo info [] Nothing mapEmpty) lbl live []
+        = CmmProc (LiveInfo info [] mapEmpty mapEmpty) lbl live []
 
 natCmmTopToLive mCfg proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
-        = CmmProc (LiveInfo info' (first_id : entry_ids) Nothing mapEmpty)
+        = CmmProc (LiveInfo info' (first_id : entry_ids) mapEmpty mapEmpty)
                 lbl live sccsLive
    where
         first_id        = blockId first
@@ -731,6 +736,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
 --------------------------------------------------------------------------------
 -- Annotate code with register liveness information
 --
+
 regLiveness
         :: (Outputable instr, Instruction instr)
         => Platform
@@ -743,14 +749,14 @@ regLiveness _ (CmmData i d)
 regLiveness _ (CmmProc info lbl live [])
         | LiveInfo static mFirst _ _    <- info
         = return $ CmmProc
-                        (LiveInfo static mFirst (Just mapEmpty) mapEmpty)
+                        (LiveInfo static mFirst mapEmpty mapEmpty)
                         lbl live []
 
 regLiveness platform (CmmProc info lbl live sccs)
         | LiveInfo static mFirst _ liveSlotsOnEntry     <- info
         = let   (ann_sccs, block_live)  = computeLiveness platform sccs
 
-          in    return $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
+          in    return $ CmmProc (LiveInfo static mFirst block_live liveSlotsOnEntry)
                            lbl live ann_sccs