    {-

    Copyright (c) 2014 Joachim Breitner

    A data structure for undirected graphs of variables
    (or in plain terms: Sets of unordered pairs of numbers)

    This is very specifically tailored for the use in CallArity. In particular it
    stores the graph as a union of complete and complete bipartite graph, which
    would be very expensive to store as sets of edges or as adjanceny lists.

    It does not normalize the graphs. This means that g `unionUnVarGraph` g is
    equal to g, but twice as expensive and large.

    -}
    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

    -- We need a type for sets of variables (UnVarSet).
    -- We do not use VarSet, because for that we need to have the actual variable
    -- at hand, and we do not have that when we turn the domain of a VarEnv into a UnVarSet.
    -- Therefore, use a IntSet directly (which is likely also a bit more efficient).

    -- Set of uniques, i.e. for adjacent nodes
    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 -- ^ complete bipartite graph
                    | CG    !UnVarSet           -- ^ complete graph
                    | Union UnVarGraph UnVarGraph
                    | Del   !UnVarSet UnVarGraph

    emptyUnVarGraph :: UnVarGraph
    emptyUnVarGraph :: UnVarGraph
    emptyUnVarGraph = UnVarSet -> UnVarGraph
    CG UnVarSet
    emptyUnVarSet

    unionUnVarGraph :: UnVarGraph -> UnVarGraph -> UnVarGraph
    {-
    Premature optimisation, it seems.
    unionUnVarGraph (UnVarGraph [CBPG s1 s2]) (UnVarGraph [CG s3, CG s4])
        | s1 == s3 && s2 == s4
        = pprTrace "unionUnVarGraph fired" empty $
          completeGraph (s1 `unionUnVarSet` s2)
    unionUnVarGraph (UnVarGraph [CBPG s1 s2]) (UnVarGraph [CG s3, CG s4])
        | s2 == s3 && s1 == s4
        = pprTrace "unionUnVarGraph fired2" empty $
          completeGraph (s1 `unionUnVarSet` s2)
    -}
    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 A B = { {a,b} | a ∈ A, b ∈ B }
    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

    -- (v' ∈ neighbors G v) <=> v--v' ∈ G
    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 G v <=> v--v ∈ G
    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

    -- | Resolves all `Del`, by pushing them in, and simplifies `∅ ∪ … = …`
    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)

    -- | Shallow empty check.
    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)