    {-

    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, varEnvDom, unionUnVarSet, unionUnVarSets
        , extendUnVarSet, delUnVarSet
        , elemUnVarSet, isEmptyUnVarSet
        , UnVarGraph
        , emptyUnVarGraph
        , unionUnVarGraph, unionUnVarGraphs
        , completeGraph, completeBipartiteGraph
        , neighbors
        , hasLoopAt
        , delNode
        ) where

    import GHC.Prelude

    import GHC.Types.Id
    import GHC.Types.Var.Env
    import GHC.Types.Unique.FM
    import GHC.Utils.Outputable
    import GHC.Types.Unique

    import qualified Data.IntSet 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 adjancet nodes
    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)

    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

    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

    varEnvDom :: VarEnv a -> UnVarSet
    varEnvDom :: forall a. VarEnv a -> UnVarSet
    varEnvDom VarEnv a
    ae = IntSet -> UnVarSet
    UnVarSet (IntSet -> UnVarSet) -> IntSet -> UnVarSet
    forall a b. (a -> b) -> a -> b
    $ VarEnv a -> IntSet
    forall key elt. UniqFM key elt -> IntSet
    ufmToSet_Directly VarEnv a
    ae

    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

    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
    braces (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            [SDoc] -> SDoc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    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 -- ^ 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
    text String
    "Del" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (UnVarSet -> Int
    sizeUnVarSet UnVarSet
    d) SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (UnVarGraph -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UnVarGraph
    g)
        ppr (Union UnVarGraph
    a UnVarGraph
    b) = String -> SDoc
    text String
    "Union" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (UnVarGraph -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UnVarGraph
    a) SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (UnVarGraph -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UnVarGraph
    b)
        ppr (CG UnVarSet
    s) = String -> SDoc
    text String
    "CG" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (UnVarSet -> Int
    sizeUnVarSet UnVarSet
    s)
        ppr (CBPG UnVarSet
    a UnVarSet
    b) = String -> SDoc
    text String
    "CBPG" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (UnVarSet -> Int
    sizeUnVarSet UnVarSet
    a) SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (UnVarSet -> Int
    sizeUnVarSet UnVarSet
    b)