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 GHC.Word
import qualified GHC.Data.Word64Set as S
newtype UnVarSet = UnVarSet S.Word64Set
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 -> Word64
k :: Var -> Word64
k Var
v = Unique -> Word64
getKey (Var -> Unique
forall a. Uniquable a => a -> Unique
getUnique Var
v)
domUFMUnVarSet :: UniqFM key elt -> UnVarSet
domUFMUnVarSet :: forall {k} (key :: k) elt. UniqFM key elt -> UnVarSet
domUFMUnVarSet UniqFM key elt
ae = Word64Set -> UnVarSet
UnVarSet (Word64Set -> UnVarSet) -> Word64Set -> UnVarSet
forall a b. (a -> b) -> a -> b
$ UniqFM key elt -> Word64Set
forall {k} (key :: k) elt. UniqFM key elt -> Word64Set
ufmToSet_Directly UniqFM key elt
ae
emptyUnVarSet :: UnVarSet
emptyUnVarSet :: UnVarSet
emptyUnVarSet = Word64Set -> UnVarSet
UnVarSet Word64Set
S.empty
elemUnVarSet :: Var -> UnVarSet -> Bool
elemUnVarSet :: Var -> UnVarSet -> Bool
elemUnVarSet Var
v (UnVarSet Word64Set
s) = Var -> Word64
k Var
v Word64 -> Word64Set -> Bool
`S.member` Word64Set
s
isEmptyUnVarSet :: UnVarSet -> Bool
isEmptyUnVarSet :: UnVarSet -> Bool
isEmptyUnVarSet (UnVarSet Word64Set
s) = Word64Set -> Bool
S.null Word64Set
s
delUnVarSet :: UnVarSet -> Var -> UnVarSet
delUnVarSet :: UnVarSet -> Var -> UnVarSet
delUnVarSet (UnVarSet Word64Set
s) Var
v = Word64Set -> UnVarSet
UnVarSet (Word64Set -> UnVarSet) -> Word64Set -> UnVarSet
forall a b. (a -> b) -> a -> b
$ Var -> Word64
k Var
v Word64 -> Word64Set -> Word64Set
`S.delete` Word64Set
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 Word64Set
s) (UnVarSet Word64Set
s') = Word64Set -> UnVarSet
UnVarSet (Word64Set -> UnVarSet) -> Word64Set -> UnVarSet
forall a b. (a -> b) -> a -> b
$ Word64Set
s Word64Set -> Word64Set -> Word64Set
`S.difference` Word64Set
s'
sizeUnVarSet :: UnVarSet -> Int
sizeUnVarSet :: UnVarSet -> Int
sizeUnVarSet (UnVarSet Word64Set
s) = Word64Set -> Int
S.size Word64Set
s
mkUnVarSet :: [Var] -> UnVarSet
mkUnVarSet :: [Var] -> UnVarSet
mkUnVarSet [Var]
vs = Word64Set -> UnVarSet
UnVarSet (Word64Set -> UnVarSet) -> Word64Set -> UnVarSet
forall a b. (a -> b) -> a -> b
$ [Word64] -> Word64Set
S.fromList ([Word64] -> Word64Set) -> [Word64] -> Word64Set
forall a b. (a -> b) -> a -> b
$ (Var -> Word64) -> [Var] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Word64
k [Var]
vs
extendUnVarSet :: Var -> UnVarSet -> UnVarSet
extendUnVarSet :: Var -> UnVarSet -> UnVarSet
extendUnVarSet Var
v (UnVarSet Word64Set
s) = Word64Set -> UnVarSet
UnVarSet (Word64Set -> UnVarSet) -> Word64Set -> UnVarSet
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64Set -> Word64Set
S.insert (Var -> Word64
k Var
v) Word64Set
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 Word64Set
set1) (UnVarSet Word64Set
set2) = Word64Set -> UnVarSet
UnVarSet (Word64Set
set1 Word64Set -> Word64Set -> Word64Set
`S.union` Word64Set
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 Word64Set
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 (Word64 -> Unique
mkUniqueGrimily Word64
i) | Word64
i <- Word64Set -> [Word64]
S.toList Word64Set
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)