Ensure runhaskell is rebuild in stage2

[ghc-hetmet.git] / compiler / cmm / CmmExpr.hs

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 78ff79a..1769a01 100644 (file)
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -1,14 +1,13 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 
 module CmmExpr
     ( CmmExpr(..), cmmExprRep, maybeInvertCmmExpr
     , CmmReg(..), cmmRegRep
     , CmmLit(..), cmmLitRep
-    , LocalReg(..), localRegRep, localRegGCFollow, Kind(..)
+    , LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
     , GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
-    , UserOfLocalRegs, foldRegsUsed
+    , UserOfLocalRegs, foldRegsUsed, filterRegsUsed
     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
-            , plusRegSet, minusRegSet
+            , plusRegSet, minusRegSet, timesRegSet
     )
 where
 
@@ -79,13 +78,13 @@ maybeInvertCmmExpr _ = Nothing
 -----------------------------------------------------------------------------
 
 -- | Whether a 'LocalReg' is a GC followable pointer
-data Kind = KindPtr | KindNonPtr deriving (Eq)
+data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
 
 data LocalReg
   = LocalReg
       !Unique   -- ^ Identifier
       MachRep   -- ^ Type
-      Kind      -- ^ Should the GC follow as a pointer
+      GCKind      -- ^ Should the GC follow as a pointer
 
 -- | Sets of local registers
 
@@ -95,7 +94,7 @@ elemRegSet              :: LocalReg -> RegSet -> Bool
 extendRegSet            :: RegSet -> LocalReg -> RegSet
 deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
 mkRegSet                :: [LocalReg] -> RegSet
-minusRegSet, plusRegSet :: RegSet -> RegSet -> RegSet
+minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
 
 emptyRegSet      = emptyUniqSet
 elemRegSet       = elementOfUniqSet
@@ -104,6 +103,7 @@ deleteFromRegSet = delOneFromUniqSet
 mkRegSet         = mkUniqSet
 minusRegSet      = minusUniqSet
 plusRegSet       = unionUniqSets
+timesRegSet      = intersectUniqSets
 
 -----------------------------------------------------------------------------
 --    Register-use information for expressions and other types 
@@ -112,6 +112,11 @@ plusRegSet       = unionUniqSets
 class UserOfLocalRegs a where
   foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
 
+filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
+filterRegsUsed p e =
+    foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
+                 emptyRegSet e
+
 instance UserOfLocalRegs CmmReg where
     foldRegsUsed f z (CmmLocal reg) = f z reg
     foldRegsUsed _ z (CmmGlobal _)  = z
@@ -119,6 +124,9 @@ instance UserOfLocalRegs CmmReg where
 instance UserOfLocalRegs LocalReg where
     foldRegsUsed f z r = f z r
 
+instance UserOfLocalRegs RegSet where
+    foldRegsUsed f = foldUniqSet (flip f)
+
 instance UserOfLocalRegs CmmExpr where
   foldRegsUsed f z e = expr z e
     where expr z (CmmLit _)          = z
@@ -152,7 +160,7 @@ localRegRep :: LocalReg -> MachRep
 localRegRep (LocalReg _ rep _) = rep
 
 
-localRegGCFollow :: LocalReg -> Kind
+localRegGCFollow :: LocalReg -> GCKind
 localRegGCFollow (LocalReg _ _ p) = p
 
 cmmLitRep :: CmmLit -> MachRep