module GHC.Data.Graph.UnVar
( UnVarSet
, emptyUnVarSet, mkUnVarSet, unionUnVarSet, unionUnVarSets
, extendUnVarSet, extendUnVarSetList, delUnVarSet, delUnVarSetList
, elemUnVarSet, isEmptyUnVarSet
, UnVarGraph
, emptyUnVarGraph
, unionUnVarGraph, unionUnVarGraphs
, completeGraph, completeBipartiteGraph
, neighbors
, hasLoopAt
, delNode
, domUFMUnVarSet
) where
import GHC.Prelude
import GHC.Types.Unique.FM( UniqFM, ufmToSet_Directly )
import GHC.Types.Var
import GHC.Utils.Outputable
import GHC.Types.Unique
import qualified Data.IntSet as S
newtype UnVarSet = UnVarSet (S.IntSet)
deriving UnVarSet -> UnVarSet -> Bool
(UnVarSet -> UnVarSet -> Bool)
-> (UnVarSet -> UnVarSet -> Bool) -> Eq UnVarSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnVarSet -> UnVarSet -> Bool
== :: UnVarSet -> UnVarSet -> Bool
$c/= :: UnVarSet -> UnVarSet -> Bool
/= :: UnVarSet -> UnVarSet -> Bool
Eq
k :: Var -> Int
k :: Var -> Int
k Var
v = Unique -> Int
getKey (Var -> Unique
forall a. Uniquable a => a -> Unique
getUnique Var
v)
domUFMUnVarSet :: UniqFM key elt -> UnVarSet
domUFMUnVarSet :: forall key elt. UniqFM key elt -> UnVarSet
domUFMUnVarSet UniqFM key elt
ae = IntSet -> UnVarSet
UnVarSet (IntSet -> UnVarSet) -> IntSet -> UnVarSet
forall a b. (a -> b) -> a -> b
$ UniqFM key elt -> IntSet
forall key elt. UniqFM key elt -> IntSet
ufmToSet_Directly UniqFM key elt
ae
emptyUnVarSet :: UnVarSet
emptyUnVarSet :: UnVarSet
emptyUnVarSet = IntSet -> UnVarSet
UnVarSet IntSet
S.empty
elemUnVarSet :: Var -> UnVarSet -> Bool
elemUnVarSet :: Var -> UnVarSet -> Bool
elemUnVarSet Var
v (UnVarSet IntSet
s) = Var -> Int
k Var
v Int -> IntSet -> Bool
`S.member` IntSet
s
isEmptyUnVarSet :: UnVarSet -> Bool
isEmptyUnVarSet :: UnVarSet -> Bool
isEmptyUnVarSet (UnVarSet IntSet
s) = IntSet -> Bool
S.null IntSet
s
delUnVarSet :: UnVarSet -> Var -> UnVarSet
delUnVarSet :: UnVarSet -> Var -> UnVarSet
delUnVarSet (UnVarSet IntSet
s) Var
v = IntSet -> UnVarSet
UnVarSet (IntSet -> UnVarSet) -> IntSet -> UnVarSet
forall a b. (a -> b) -> a -> b
$ Var -> Int
k Var
v Int -> IntSet -> IntSet
`S.delete` IntSet
s
delUnVarSetList :: UnVarSet -> [Var] -> UnVarSet
delUnVarSetList :: UnVarSet -> [Var] -> UnVarSet
delUnVarSetList UnVarSet
s [Var]
vs = UnVarSet
s UnVarSet -> UnVarSet -> UnVarSet
`minusUnVarSet` [Var] -> UnVarSet
mkUnVarSet [Var]
vs
minusUnVarSet :: UnVarSet -> UnVarSet -> UnVarSet
minusUnVarSet :: UnVarSet -> UnVarSet -> UnVarSet
minusUnVarSet (UnVarSet IntSet
s) (UnVarSet IntSet
s') = IntSet -> UnVarSet
UnVarSet (IntSet -> UnVarSet) -> IntSet -> UnVarSet
forall a b. (a -> b) -> a -> b
$ IntSet
s IntSet -> IntSet -> IntSet
`S.difference` IntSet
s'
sizeUnVarSet :: UnVarSet -> Int
sizeUnVarSet :: UnVarSet -> Int
sizeUnVarSet (UnVarSet IntSet
s) = IntSet -> Int
S.size IntSet
s
mkUnVarSet :: [Var] -> UnVarSet
mkUnVarSet :: [Var] -> UnVarSet
mkUnVarSet [Var]
vs = IntSet -> UnVarSet
UnVarSet (IntSet -> UnVarSet) -> IntSet -> UnVarSet
forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
S.fromList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ (Var -> Int) -> [Var] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Int
k [Var]
vs
extendUnVarSet :: Var -> UnVarSet -> UnVarSet
extendUnVarSet :: Var -> UnVarSet -> UnVarSet
extendUnVarSet Var
v (UnVarSet IntSet
s) = IntSet -> UnVarSet
UnVarSet (IntSet -> UnVarSet) -> IntSet -> UnVarSet
forall a b. (a -> b) -> a -> b
$ Int -> IntSet -> IntSet
S.insert (Var -> Int
k Var
v) IntSet
s
extendUnVarSetList :: [Var] -> UnVarSet -> UnVarSet
extendUnVarSetList :: [Var] -> UnVarSet -> UnVarSet
extendUnVarSetList [Var]
vs UnVarSet
s = UnVarSet
s UnVarSet -> UnVarSet -> UnVarSet
`unionUnVarSet` [Var] -> UnVarSet
mkUnVarSet [Var]
vs
unionUnVarSet :: UnVarSet -> UnVarSet -> UnVarSet
unionUnVarSet :: UnVarSet -> UnVarSet -> UnVarSet
unionUnVarSet (UnVarSet IntSet
set1) (UnVarSet IntSet
set2) = IntSet -> UnVarSet
UnVarSet (IntSet
set1 IntSet -> IntSet -> IntSet
`S.union` IntSet
set2)
unionUnVarSets :: [UnVarSet] -> UnVarSet
unionUnVarSets :: [UnVarSet] -> UnVarSet
unionUnVarSets = (UnVarSet -> UnVarSet -> UnVarSet)
-> UnVarSet -> [UnVarSet] -> UnVarSet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((UnVarSet -> UnVarSet -> UnVarSet)
-> UnVarSet -> UnVarSet -> UnVarSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip UnVarSet -> UnVarSet -> UnVarSet
unionUnVarSet) UnVarSet
emptyUnVarSet
instance Outputable UnVarSet where
ppr :: UnVarSet -> SDoc
ppr (UnVarSet IntSet
s) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [ Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> Unique
forall a. Uniquable a => a -> Unique
getUnique Int
i) | Int
i <- IntSet -> [Int]
S.toList IntSet
s]
data UnVarGraph = CBPG !UnVarSet !UnVarSet
| CG !UnVarSet
| Union UnVarGraph UnVarGraph
| Del !UnVarSet UnVarGraph
emptyUnVarGraph :: UnVarGraph
emptyUnVarGraph :: UnVarGraph
emptyUnVarGraph = UnVarSet -> UnVarGraph
CG UnVarSet
emptyUnVarSet
unionUnVarGraph :: UnVarGraph -> UnVarGraph -> UnVarGraph
unionUnVarGraph :: UnVarGraph -> UnVarGraph -> UnVarGraph
unionUnVarGraph UnVarGraph
a UnVarGraph
b
| UnVarGraph -> Bool
is_null UnVarGraph
a = UnVarGraph
b
| UnVarGraph -> Bool
is_null UnVarGraph
b = UnVarGraph
a
| Bool
otherwise = UnVarGraph -> UnVarGraph -> UnVarGraph
Union UnVarGraph
a UnVarGraph
b
unionUnVarGraphs :: [UnVarGraph] -> UnVarGraph
unionUnVarGraphs :: [UnVarGraph] -> UnVarGraph
unionUnVarGraphs = (UnVarGraph -> UnVarGraph -> UnVarGraph)
-> UnVarGraph -> [UnVarGraph] -> UnVarGraph
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UnVarGraph -> UnVarGraph -> UnVarGraph
unionUnVarGraph UnVarGraph
emptyUnVarGraph
completeBipartiteGraph :: UnVarSet -> UnVarSet -> UnVarGraph
completeBipartiteGraph :: UnVarSet -> UnVarSet -> UnVarGraph
completeBipartiteGraph UnVarSet
s1 UnVarSet
s2 = UnVarGraph -> UnVarGraph
prune (UnVarGraph -> UnVarGraph) -> UnVarGraph -> UnVarGraph
forall a b. (a -> b) -> a -> b
$ UnVarSet -> UnVarSet -> UnVarGraph
CBPG UnVarSet
s1 UnVarSet
s2
completeGraph :: UnVarSet -> UnVarGraph
completeGraph :: UnVarSet -> UnVarGraph
completeGraph UnVarSet
s = UnVarGraph -> UnVarGraph
prune (UnVarGraph -> UnVarGraph) -> UnVarGraph -> UnVarGraph
forall a b. (a -> b) -> a -> b
$ UnVarSet -> UnVarGraph
CG UnVarSet
s
neighbors :: UnVarGraph -> Var -> UnVarSet
neighbors :: UnVarGraph -> Var -> UnVarSet
neighbors = UnVarGraph -> Var -> UnVarSet
go
where
go :: UnVarGraph -> Var -> UnVarSet
go (Del UnVarSet
d UnVarGraph
g) Var
v
| Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
d = UnVarSet
emptyUnVarSet
| Bool
otherwise = UnVarGraph -> Var -> UnVarSet
go UnVarGraph
g Var
v UnVarSet -> UnVarSet -> UnVarSet
`minusUnVarSet` UnVarSet
d
go (Union UnVarGraph
g1 UnVarGraph
g2) Var
v = UnVarGraph -> Var -> UnVarSet
go UnVarGraph
g1 Var
v UnVarSet -> UnVarSet -> UnVarSet
`unionUnVarSet` UnVarGraph -> Var -> UnVarSet
go UnVarGraph
g2 Var
v
go (CG UnVarSet
s) Var
v = if Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
s then UnVarSet
s else UnVarSet
emptyUnVarSet
go (CBPG UnVarSet
s1 UnVarSet
s2) Var
v = (if Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
s1 then UnVarSet
s2 else UnVarSet
emptyUnVarSet) UnVarSet -> UnVarSet -> UnVarSet
`unionUnVarSet`
(if Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
s2 then UnVarSet
s1 else UnVarSet
emptyUnVarSet)
hasLoopAt :: UnVarGraph -> Var -> Bool
hasLoopAt :: UnVarGraph -> Var -> Bool
hasLoopAt = UnVarGraph -> Var -> Bool
go
where
go :: UnVarGraph -> Var -> Bool
go (Del UnVarSet
d UnVarGraph
g) Var
v
| Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
d = Bool
False
| Bool
otherwise = UnVarGraph -> Var -> Bool
go UnVarGraph
g Var
v
go (Union UnVarGraph
g1 UnVarGraph
g2) Var
v = UnVarGraph -> Var -> Bool
go UnVarGraph
g1 Var
v Bool -> Bool -> Bool
|| UnVarGraph -> Var -> Bool
go UnVarGraph
g2 Var
v
go (CG UnVarSet
s) Var
v = Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
s
go (CBPG UnVarSet
s1 UnVarSet
s2) Var
v = Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
s1 Bool -> Bool -> Bool
&& Var
v Var -> UnVarSet -> Bool
`elemUnVarSet` UnVarSet
s2
delNode :: UnVarGraph -> Var -> UnVarGraph
delNode :: UnVarGraph -> Var -> UnVarGraph
delNode (Del UnVarSet
d UnVarGraph
g) Var
v = UnVarSet -> UnVarGraph -> UnVarGraph
Del (Var -> UnVarSet -> UnVarSet
extendUnVarSet Var
v UnVarSet
d) UnVarGraph
g
delNode UnVarGraph
g Var
v
| UnVarGraph -> Bool
is_null UnVarGraph
g = UnVarGraph
emptyUnVarGraph
| Bool
otherwise = UnVarSet -> UnVarGraph -> UnVarGraph
Del ([Var] -> UnVarSet
mkUnVarSet [Var
v]) UnVarGraph
g
prune :: UnVarGraph -> UnVarGraph
prune :: UnVarGraph -> UnVarGraph
prune = UnVarSet -> UnVarGraph -> UnVarGraph
go UnVarSet
emptyUnVarSet
where
go :: UnVarSet -> UnVarGraph -> UnVarGraph
go :: UnVarSet -> UnVarGraph -> UnVarGraph
go UnVarSet
dels (Del UnVarSet
dels' UnVarGraph
g) = UnVarSet -> UnVarGraph -> UnVarGraph
go (UnVarSet
dels UnVarSet -> UnVarSet -> UnVarSet
`unionUnVarSet` UnVarSet
dels') UnVarGraph
g
go UnVarSet
dels (Union UnVarGraph
g1 UnVarGraph
g2)
| UnVarGraph -> Bool
is_null UnVarGraph
g1' = UnVarGraph
g2'
| UnVarGraph -> Bool
is_null UnVarGraph
g2' = UnVarGraph
g1'
| Bool
otherwise = UnVarGraph -> UnVarGraph -> UnVarGraph
Union UnVarGraph
g1' UnVarGraph
g2'
where
g1' :: UnVarGraph
g1' = UnVarSet -> UnVarGraph -> UnVarGraph
go UnVarSet
dels UnVarGraph
g1
g2' :: UnVarGraph
g2' = UnVarSet -> UnVarGraph -> UnVarGraph
go UnVarSet
dels UnVarGraph
g2
go UnVarSet
dels (CG UnVarSet
s) = UnVarSet -> UnVarGraph
CG (UnVarSet
s UnVarSet -> UnVarSet -> UnVarSet
`minusUnVarSet` UnVarSet
dels)
go UnVarSet
dels (CBPG UnVarSet
s1 UnVarSet
s2) = UnVarSet -> UnVarSet -> UnVarGraph
CBPG (UnVarSet
s1 UnVarSet -> UnVarSet -> UnVarSet
`minusUnVarSet` UnVarSet
dels) (UnVarSet
s2 UnVarSet -> UnVarSet -> UnVarSet
`minusUnVarSet` UnVarSet
dels)
is_null :: UnVarGraph -> Bool
is_null :: UnVarGraph -> Bool
is_null (CBPG UnVarSet
s1 UnVarSet
s2) = UnVarSet -> Bool
isEmptyUnVarSet UnVarSet
s1 Bool -> Bool -> Bool
|| UnVarSet -> Bool
isEmptyUnVarSet UnVarSet
s2
is_null (CG UnVarSet
s) = UnVarSet -> Bool
isEmptyUnVarSet UnVarSet
s
is_null UnVarGraph
_ = Bool
False
instance Outputable UnVarGraph where
ppr :: UnVarGraph -> SDoc
ppr (Del UnVarSet
d UnVarGraph
g) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Del" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnVarSet -> Int
sizeUnVarSet UnVarSet
d) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (UnVarGraph -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnVarGraph
g)
ppr (Union UnVarGraph
a UnVarGraph
b) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Union" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (UnVarGraph -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnVarGraph
a) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (UnVarGraph -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnVarGraph
b)
ppr (CG UnVarSet
s) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CG" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnVarSet -> Int
sizeUnVarSet UnVarSet
s)
ppr (CBPG UnVarSet
a UnVarSet
b) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CBPG" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnVarSet -> Int
sizeUnVarSet UnVarSet
a) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnVarSet -> Int
sizeUnVarSet UnVarSet
b)