Hoopl: remove dependency on Hoopl package
[ghc.git] / compiler / cmm / CmmCommonBlockElim.hs
index 8c82fce..3c23e70 100644 (file)
@@ -13,7 +13,10 @@ import CmmContFlowOpt
 -- import PprCmm ()
 import Prelude hiding (iterate, succ, unzip, zip)
 
-import Hoopl hiding (ChangeFlag)
+import Hoopl.Block
+import Hoopl.Graph
+import Hoopl.Label
+import Hoopl.Collections
 import Data.Bits
 import Data.Maybe (mapMaybe)
 import qualified Data.List as List
@@ -21,6 +24,8 @@ import Data.Word
 import qualified Data.Map as M
 import Outputable
 import UniqFM
+import UniqDFM
+import qualified TrieMap as TM
 import Unique
 import Control.Arrow (first, second)
 
@@ -64,7 +69,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
@@ -132,12 +137,11 @@ hash_block block =
 
         hash_node :: CmmNode O x -> Word32
         hash_node n | dont_care n = 0 -- don't care
-        hash_node (CmmUnwind _ e) = hash_e e
         hash_node (CmmAssign r e) = hash_reg r + hash_e e
         hash_node (CmmStore e e') = hash_e e + hash_e e'
         hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as
         hash_node (CmmBranch _) = 23 -- NB. ignore the label
-        hash_node (CmmCondBranch p _ _) = hash_e p
+        hash_node (CmmCondBranch p _ _ _) = hash_e p
         hash_node (CmmCall e _ _ _ _ _) = hash_e e
         hash_node (CmmForeignCall t _ _ _ _ _ _) = hash_tgt t
         hash_node (CmmSwitch e _) = hash_e e
@@ -179,14 +183,15 @@ hash_block block =
 dont_care :: CmmNode O x -> Bool
 dont_care CmmComment {}  = True
 dont_care CmmTick {}     = True
+dont_care CmmUnwind {}   = True
 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
@@ -247,8 +252,8 @@ eqBlockBodyWith eqBid block block'
 
 eqLastWith :: (BlockId -> BlockId -> Bool) -> CmmNode O C -> CmmNode O C -> Bool
 eqLastWith eqBid (CmmBranch bid1) (CmmBranch bid2) = eqBid bid1 bid2
-eqLastWith eqBid (CmmCondBranch c1 t1 f1) (CmmCondBranch c2 t2 f2) =
-  c1 == c2 && eqBid t1 t2 && eqBid f1 f2
+eqLastWith eqBid (CmmCondBranch c1 t1 f1 l1) (CmmCondBranch c2 t2 f2 l2) =
+  c1 == c2 && l1 == l2 && eqBid t1 t2 && eqBid f1 f2
 eqLastWith eqBid (CmmCall t1 c1 g1 a1 r1 u1) (CmmCall t2 c2 g2 a2 r2 u2) =
   t1 == t2 && eqMaybeWith eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2
 eqLastWith eqBid (CmmSwitch e1 ids1) (CmmSwitch e2 ids2) =
@@ -264,7 +269,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
@@ -285,15 +290,16 @@ copyTicks env g
 
 -- Group by [Label]
 groupByLabel :: [(Key, a)] -> [(Key, [a])]
-groupByLabel = go M.empty
+groupByLabel = go (TM.emptyTM :: TM.ListMap UniqDFM a)
   where
-    go !m [] = M.elems m
-    go !m ((k,v) : entries) = go (M.alter adjust k' m) entries
+    go !m [] = TM.foldTM (:) m []
+    go !m ((k,v) : entries) = go (TM.alterTM k' adjust m) entries
       where k' = map getUnique k
             adjust Nothing       = Just (k,[v])
             adjust (Just (_,vs)) = Just (k,v:vs)
 
 
 groupByInt :: (a -> Int) -> [a] -> [[a]]
-groupByInt f xs = eltsUFM $ List.foldl' go emptyUFM xs
+groupByInt f xs = nonDetEltsUFM $ List.foldl' go emptyUFM xs
+  -- See Note [Unique Determinism and code generation]
   where go m x = alterUFM (Just . maybe [x] (x:)) m (f x)