X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLive.hs;h=ed659776a8e7bbff11e6a75a48514124f2029867;hb=2bb3a439c106935d97fae7f7a0b60c21493d1bef;hp=93372fc461fb301550221bbe7dc7e19008e061af;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 93372fc..ed65977 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -1,10 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module CmmLive (
         CmmLive,
         BlockEntryLiveness,
@@ -20,7 +13,6 @@ import Dataflow
 
 import Maybes
 import Panic
-import UniqFM
 import UniqSet
 
 -----------------------------------------------------------------------------
@@ -47,13 +39,13 @@ cmmLiveness blocks =
     fixedpoint (cmmBlockDependants sources)
                (cmmBlockUpdate blocks')
                (map blockId blocks)
-               (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
+               (mkBlockEnv [(blockId b, emptyUniqSet) | b <- blocks])
     where
       sources :: BlockSources
       sources = cmmBlockSources blocks
 
       blocks' :: BlockStmts
-      blocks' = listToUFM $ map block_name blocks
+      blocks' = mkBlockEnv $ map block_name blocks
 
       block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
       block_name b = (blockId b, blockStmts b)
@@ -75,7 +67,7 @@ cmmLivenessComment live (BasicBlock ident stmts) =
 -- need updating after a given block is updated in the liveness analysis
 -----------------------------------------------------------------------------
 cmmBlockSources :: [CmmBasicBlock] -> BlockSources
-cmmBlockSources blocks = foldr aux emptyUFM blocks
+cmmBlockSources blocks = foldr aux emptyBlockEnv blocks
     where
       aux :: CmmBasicBlock
           -> BlockSources
@@ -89,7 +81,7 @@ cmmBlockSources blocks = foldr aux emptyUFM blocks
                        -> BlockSources
                        -> BlockSources
       add_source_edges source target ufm =
-          addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
+          addToBEnv_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
 
       branch_targets :: [CmmStmt] -> UniqSet BlockId
       branch_targets stmts =
@@ -107,7 +99,7 @@ cmmBlockSources blocks = foldr aux emptyUFM blocks
 -----------------------------------------------------------------------------
 cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
 cmmBlockDependants sources ident =
-    uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
+    uniqSetToList $ lookupWithDefaultBEnv sources emptyUniqSet ident
 
 -----------------------------------------------------------------------------
 -- | Given the table of type 'BlockStmts' and a block that was updated,
@@ -122,14 +114,14 @@ cmmBlockUpdate ::
 cmmBlockUpdate blocks node _ state =
     if (sizeUniqSet old_live) == (sizeUniqSet new_live)
       then Nothing
-      else Just $ addToUFM state node new_live
+      else Just $ extendBlockEnv state node new_live
     where
       new_live, old_live :: CmmLive
       new_live = cmmStmtListLive state block_stmts
-      old_live = lookupWithDefaultUFM state missing_live node
+      old_live = lookupWithDefaultBEnv state missing_live node
 
       block_stmts :: [CmmStmt]
-      block_stmts = lookupWithDefaultUFM blocks missing_block node
+      block_stmts = lookupWithDefaultBEnv blocks missing_block node
 
       missing_live = panic "unknown block id during liveness analysis"
       missing_block = panic "unknown block id during liveness analysis"
@@ -187,14 +179,14 @@ cmmStmtLive _ (CmmCall target results arguments _ _) =
               (CmmCallee target _) -> cmmExprLive target
               (CmmPrim _) -> id
 cmmStmtLive other_live (CmmBranch target) =
-    addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
+    addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
 cmmStmtLive other_live (CmmCondBranch expr target) =
     cmmExprLive expr .
-    addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
+    addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
 cmmStmtLive other_live (CmmSwitch expr targets) =
     cmmExprLive expr .
     (foldr ((.) . (addLive .
-                   lookupWithDefaultUFM other_live emptyUniqSet))
+                   lookupWithDefaultBEnv other_live emptyUniqSet))
            id
            (mapCatMaybes id targets))
 cmmStmtLive _ (CmmJump expr params) =
@@ -213,6 +205,7 @@ cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
     expr_liveness (CmmReg reg) = reg_liveness reg
     expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
     expr_liveness (CmmRegOff reg _) = reg_liveness reg
+    expr_liveness (CmmStackSlot _ _) = panic "cmmExprLive CmmStackSlot"
 
     reg_liveness :: CmmReg -> [LocalReg]
     reg_liveness (CmmLocal reg) = [reg]