implement RegSet by Set, not UniqSet

4 files changed, 47 insertions, 30 deletions

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 73afdc325b..5aed63b7a2 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -16,7 +16,8 @@ module CmmExpr
     , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
     , DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed
     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
-            , plusRegSet, minusRegSet, timesRegSet
+            , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
+            , regSetToList
     , regUsedIn, regSlot
     , Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
     , module CmmMachOp
@@ -31,9 +32,10 @@ import CmmMachOp
 import BlockId
 import CLabel
 import Unique
-import UniqSet
 
 import Data.Map (Map)
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 -----------------------------------------------------------------------------
 --		CmmExpr
@@ -194,22 +196,35 @@ localRegType (LocalReg _ rep) = rep
 -----------------------------------------------------------------------------
 
 -- | Sets of local registers
-type RegSet              =  UniqSet LocalReg
+
+-- These are used for dataflow facts, and a common operation is taking
+-- the union of two RegSets and then asking whether the union is the
+-- same as one of the inputs.  UniqSet isn't good here, because
+-- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
+-- Sets.
+
+type RegSet              =  Set LocalReg
 emptyRegSet             :: RegSet
+nullRegSet              :: RegSet -> Bool
 elemRegSet              :: LocalReg -> RegSet -> Bool
 extendRegSet            :: RegSet -> LocalReg -> RegSet
 deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
 mkRegSet                :: [LocalReg] -> RegSet
 minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
-
-emptyRegSet      = emptyUniqSet
-elemRegSet       = elementOfUniqSet
-extendRegSet     = addOneToUniqSet
-deleteFromRegSet = delOneFromUniqSet
-mkRegSet         = mkUniqSet
-minusRegSet      = minusUniqSet
-plusRegSet       = unionUniqSets
-timesRegSet      = intersectUniqSets
+sizeRegSet              :: RegSet -> Int
+regSetToList            :: RegSet -> [LocalReg]
+
+emptyRegSet      = Set.empty
+nullRegSet       = Set.null
+elemRegSet       = Set.member
+extendRegSet     = flip Set.insert
+deleteFromRegSet = flip Set.delete
+mkRegSet         = Set.fromList
+minusRegSet      = Set.difference
+plusRegSet       = Set.union
+timesRegSet      = Set.intersection
+sizeRegSet       = Set.size
+regSetToList     = Set.toList
 
 class UserOfLocalRegs a where
   foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
@@ -237,7 +252,7 @@ instance DefinerOfLocalRegs LocalReg where
     foldRegsDefd f z r = f z r
 
 instance UserOfLocalRegs RegSet where
-    foldRegsUsed f = foldUniqSet (flip f)
+    foldRegsUsed f = Set.fold (flip f)
 
 instance UserOfLocalRegs CmmExpr where
   foldRegsUsed f z e = expr z e
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 50b2bf6ec2..d927dfe12f 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -33,8 +33,10 @@ type CmmLive = RegSet
 -- | The dataflow lattice
 liveLattice :: DataflowLattice CmmLive
 liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
-    where add _ (OldFact old) (NewFact new) = case unionUniqSets old new of
-            join -> (changeIf $ sizeUniqSet join > sizeUniqSet old, join)
+    where add _ (OldFact old) (NewFact new) =
+               (changeIf $ sizeRegSet join > sizeRegSet old, join)
+              where !join = plusRegSet old new
+
 
 -- | A mapping from block labels to the variables live on entry
 type BlockEntryLiveness = BlockEnv CmmLive
@@ -52,7 +54,7 @@ cmmLiveness graph =
 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
 noLiveOnEntry :: BlockId -> CmmLive -> a -> a
 noLiveOnEntry bid in_fact x =
-  if isEmptyUniqSet in_fact then x
+  if nullRegSet in_fact then x
   else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
 
 -- | The transfer equations use the traditional 'gen' and 'kill'
@@ -60,7 +62,7 @@ noLiveOnEntry bid in_fact x =
 gen  :: UserOfLocalRegs a    => a -> RegSet -> RegSet
 gen  a live = foldRegsUsed extendRegSet      live a
 kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
-kill a live = foldRegsDefd delOneFromUniqSet live a
+kill a live = foldRegsDefd deleteFromRegSet live a
 
 gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
 gen_kill a = gen a . kill a
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 691fbd8eeb..07ead008e7 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -318,7 +318,7 @@ pass_live_vars_as_args _liveness procPoints protos = protos'
               Nothing -> let live = emptyRegSet
                                     --lookupBlockEnv _liveness id `orElse`
                                     --panic ("no liveness at block " ++ show id)
-                             formals = uniqSetToList live
+                             formals = regSetToList live
                              prot = Protocol Private formals $ CallArea $ Young id
                          in  mapInsert id prot protos
 
diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs
index 2610e2cb6e..fbe4db0333 100644
--- a/compiler/cmm/CmmSpillReload.hs
+++ b/compiler/cmm/CmmSpillReload.hs
@@ -65,8 +65,8 @@ dualLiveLattice = DataflowLattice "variables live in registers and on stack" emp
           add _ (OldFact old) (NewFact new) = (changeIf $ change1 || change2, DualLive stack regs)
             where (change1, stack) = add1 (on_stack old) (on_stack new)
                   (change2, regs)  = add1 (in_regs old)  (in_regs new)
-          add1 old new = if sizeUniqSet join > sizeUniqSet old then (True, join) else (False, old)
-            where join = unionUniqSets old new
+          add1 old new = if sizeRegSet join > sizeRegSet old then (True, join) else (False, old)
+            where join = plusRegSet old new
 
 dualLivenessWithInsertion :: BlockSet -> CmmGraph -> FuelUniqSM CmmGraph
 dualLivenessWithInsertion procPoints g =
@@ -120,16 +120,16 @@ dualLiveTransfers entry procPoints = mkBTransfer3 first middle last
                   keep_stack_only k = DualLive (on_stack (lkp k)) emptyRegSet
 
 insertSpillsAndReloads :: CmmGraph -> BlockSet -> CmmBwdRewrite DualLive
-insertSpillsAndReloads graph procPoints = deepBwdRw3 first middle nothing
+insertSpillsAndReloads graph procPoints = mkBRewrite3 first middle nothing
   -- Beware: deepBwdRw with one polymorphic function seems more reasonable here,
   -- but GHC miscompiles it, see bug #4044.
     where first :: CmmNode C O -> Fact O DualLive -> CmmReplGraph C O
-          first e@(CmmEntry id) live = return $
+          first e@(CmmEntry id) live =
             if id /= (g_entry graph) && setMember id procPoints then
-              case map reload (uniqSetToList (in_regs live)) of
-                [] -> Nothing
-                is -> Just $ mkFirst e <*> mkMiddles is
-            else Nothing
+              case map reload (regSetToList (in_regs live)) of
+                [] -> return Nothing
+                is -> return $ Just $ mkFirst e <*> mkMiddles is
+            else return Nothing
           -- EZY: There was some dead code for handling the case where
           -- we were not splitting procedures.  Check Git history if
           -- you're interested (circa e26ea0f41).
@@ -152,15 +152,15 @@ reload r = CmmAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r)
 -- prettyprinting
 
 ppr_regs :: String -> RegSet -> SDoc
-ppr_regs s regs = text s <+> commafy (map ppr $ uniqSetToList regs)
+ppr_regs s regs = text s <+> commafy (map ppr $ regSetToList regs)
   where commafy xs = hsep $ punctuate comma xs
 
 instance Outputable DualLive where
   ppr (DualLive {in_regs = regs, on_stack = stack}) =
-      if isEmptyUniqSet regs && isEmptyUniqSet stack then
+      if nullRegSet regs && nullRegSet stack then
           text "<nothing-live>"
       else
-          nest 2 $ fsep [if isEmptyUniqSet regs then PP.empty
+          nest 2 $ fsep [if nullRegSet regs then PP.empty
                          else (ppr_regs "live in regs =" regs),
-                         if isEmptyUniqSet stack then PP.empty
+                         if nullRegSet stack then PP.empty
                          else (ppr_regs "live on stack =" stack)]