-- Copyright (C) 2018-2024 Jun Zhang <zhangjunphy[at]gmail[dot]com>
--
-- This file is a part of decafc.
--
-- decafc is free software: you can redistribute it and/or modify it under the
-- terms of the MIT (X11) License as described in the LICENSE file.
--
-- decafc is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE.  See the X11 license for more details.

-- Graph -- A graph implementation to help build CFG
-- Supports cyclical graphs. Also allows dynamic updates to the graph for
-- transformations over CFG.
-- TODO: Perhaps we could just use FGL/ALGA?

module Util.Graph
  ( empty
  , Graph(..) 
  , outBound
  , inBound
  , lookupNode
  , nodeToList
  , edgeToList
  , alterNode
  , adjustNode
  , union
  , GraphBuilder(..)
  , addNode
  , addEdge
  , deleteNode
  , deleteEdge
  , update
  , build
  , strictlyDominate
  , strictlyPostDominate
  , topologicalTraverse
  , topologicalTraverseM
  ) where

import Control.Lens ((%=))
import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Data.Monoid
import Data.Functor
import Data.Generics.Labels
import Data.List qualified as List
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe qualified as Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text.Lazy.Builder qualified as Text
import GHC.Generics (Generic)

data Graph ni nd ed = Graph
  { forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes :: !(Map ni nd),
    forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges :: !(Map (ni, ni) ed)
  }
  deriving (Int -> Graph ni nd ed -> ShowS
[Graph ni nd ed] -> ShowS
Graph ni nd ed -> String
(Int -> Graph ni nd ed -> ShowS)
-> (Graph ni nd ed -> String)
-> ([Graph ni nd ed] -> ShowS)
-> Show (Graph ni nd ed)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ni nd ed.
(Show ni, Show nd, Show ed) =>
Int -> Graph ni nd ed -> ShowS
forall ni nd ed.
(Show ni, Show nd, Show ed) =>
[Graph ni nd ed] -> ShowS
forall ni nd ed.
(Show ni, Show nd, Show ed) =>
Graph ni nd ed -> String
$cshowsPrec :: forall ni nd ed.
(Show ni, Show nd, Show ed) =>
Int -> Graph ni nd ed -> ShowS
showsPrec :: Int -> Graph ni nd ed -> ShowS
$cshow :: forall ni nd ed.
(Show ni, Show nd, Show ed) =>
Graph ni nd ed -> String
show :: Graph ni nd ed -> String
$cshowList :: forall ni nd ed.
(Show ni, Show nd, Show ed) =>
[Graph ni nd ed] -> ShowS
showList :: [Graph ni nd ed] -> ShowS
Show, (forall x. Graph ni nd ed -> Rep (Graph ni nd ed) x)
-> (forall x. Rep (Graph ni nd ed) x -> Graph ni nd ed)
-> Generic (Graph ni nd ed)
forall x. Rep (Graph ni nd ed) x -> Graph ni nd ed
forall x. Graph ni nd ed -> Rep (Graph ni nd ed) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ni nd ed x. Rep (Graph ni nd ed) x -> Graph ni nd ed
forall ni nd ed x. Graph ni nd ed -> Rep (Graph ni nd ed) x
$cfrom :: forall ni nd ed x. Graph ni nd ed -> Rep (Graph ni nd ed) x
from :: forall x. Graph ni nd ed -> Rep (Graph ni nd ed) x
$cto :: forall ni nd ed x. Rep (Graph ni nd ed) x -> Graph ni nd ed
to :: forall x. Rep (Graph ni nd ed) x -> Graph ni nd ed
Generic)

type GraphException = Text

empty :: Graph ni nd ed
empty :: forall ni nd ed. Graph ni nd ed
empty = Map ni nd -> Map (ni, ni) ed -> Graph ni nd ed
forall ni nd ed. Map ni nd -> Map (ni, ni) ed -> Graph ni nd ed
Graph Map ni nd
forall k a. Map k a
Map.empty Map (ni, ni) ed
forall k a. Map k a
Map.empty

flattenEdgeTuple :: ((ni, ni), d) -> (ni, ni, d)
flattenEdgeTuple :: forall ni d. ((ni, ni), d) -> (ni, ni, d)
flattenEdgeTuple ((ni
src, ni
dst), d
d) = (ni
src, ni
dst, d
d)

outBound :: (Eq ni, Ord ni) => ni -> Graph ni nd ed -> [(ni, ni, ed)]
outBound :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> [(ni, ni, ed)]
outBound ni
idx Graph ni nd ed
g = (((ni, ni), ed) -> (ni, ni, ed))
-> [((ni, ni), ed)] -> [(ni, ni, ed)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ni, ni), ed) -> (ni, ni, ed)
forall ni d. ((ni, ni), d) -> (ni, ni, d)
flattenEdgeTuple ([((ni, ni), ed)] -> [(ni, ni, ed)])
-> [((ni, ni), ed)] -> [(ni, ni, ed)]
forall a b. (a -> b) -> a -> b
$
  Map (ni, ni) ed -> [((ni, ni), ed)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (ni, ni) ed -> [((ni, ni), ed)])
-> Map (ni, ni) ed -> [((ni, ni), ed)]
forall a b. (a -> b) -> a -> b
$ ((ni, ni) -> ed -> Bool) -> Map (ni, ni) ed -> Map (ni, ni) ed
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(ni
src, ni
_) ed
_ -> ni
src ni -> ni -> Bool
forall a. Eq a => a -> a -> Bool
== ni
idx) (Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g)

inBound :: (Eq ni, Ord ni) => ni -> Graph ni nd ed -> [(ni, ni, ed)]
inBound :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> [(ni, ni, ed)]
inBound ni
idx Graph ni nd ed
g = (((ni, ni), ed) -> (ni, ni, ed))
-> [((ni, ni), ed)] -> [(ni, ni, ed)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ni, ni), ed) -> (ni, ni, ed)
forall ni d. ((ni, ni), d) -> (ni, ni, d)
flattenEdgeTuple ([((ni, ni), ed)] -> [(ni, ni, ed)])
-> [((ni, ni), ed)] -> [(ni, ni, ed)]
forall a b. (a -> b) -> a -> b
$
  Map (ni, ni) ed -> [((ni, ni), ed)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (ni, ni) ed -> [((ni, ni), ed)])
-> Map (ni, ni) ed -> [((ni, ni), ed)]
forall a b. (a -> b) -> a -> b
$ ((ni, ni) -> ed -> Bool) -> Map (ni, ni) ed -> Map (ni, ni) ed
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(ni
_, ni
dst) ed
_ -> ni
dst ni -> ni -> Bool
forall a. Eq a => a -> a -> Bool
== ni
idx) (Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g)

lookupNode :: (Eq ni, Ord ni) => ni -> Graph ni nd ed -> Maybe nd
lookupNode :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> Maybe nd
lookupNode ni
nid Graph ni nd ed
g = ni -> Map ni nd -> Maybe nd
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ni
nid (Map ni nd -> Maybe nd) -> Map ni nd -> Maybe nd
forall a b. (a -> b) -> a -> b
$ Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g

nodeToList :: (Eq ni, Ord ni) => Graph ni nd ed -> [(ni, nd)]
nodeToList :: forall ni nd ed. (Eq ni, Ord ni) => Graph ni nd ed -> [(ni, nd)]
nodeToList Graph ni nd ed
g = Map ni nd -> [(ni, nd)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ni nd -> [(ni, nd)]) -> Map ni nd -> [(ni, nd)]
forall a b. (a -> b) -> a -> b
$ Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g

edgeToList :: (Eq ni, Ord ni) => Graph ni nd ed -> [(ni, ni, ed)]
edgeToList :: forall ni nd ed.
(Eq ni, Ord ni) =>
Graph ni nd ed -> [(ni, ni, ed)]
edgeToList Graph ni nd ed
g = (((ni, ni), ed) -> (ni, ni, ed))
-> [((ni, ni), ed)] -> [(ni, ni, ed)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ni, ni), ed) -> (ni, ni, ed)
forall ni d. ((ni, ni), d) -> (ni, ni, d)
flattenEdgeTuple ([((ni, ni), ed)] -> [(ni, ni, ed)])
-> [((ni, ni), ed)] -> [(ni, ni, ed)]
forall a b. (a -> b) -> a -> b
$ Map (ni, ni) ed -> [((ni, ni), ed)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (ni, ni) ed -> [((ni, ni), ed)])
-> Map (ni, ni) ed -> [((ni, ni), ed)]
forall a b. (a -> b) -> a -> b
$ Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g

union :: (Eq ni, Ord ni) => Graph ni nd ed -> Graph ni nd ed -> Graph ni nd ed
union :: forall ni nd ed.
(Eq ni, Ord ni) =>
Graph ni nd ed -> Graph ni nd ed -> Graph ni nd ed
union Graph ni nd ed
g1 Graph ni nd ed
g2 =
  Graph
    { $sel:nodes:Graph :: Map ni nd
nodes = Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g1 Map ni nd -> Map ni nd -> Map ni nd
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g2,
      $sel:edges:Graph :: Map (ni, ni) ed
edges = Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g1 Map (ni, ni) ed -> Map (ni, ni) ed -> Map (ni, ni) ed
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g2
    }

newtype GraphBuilder ni nd ed a = GraphBuilder
  { forall ni nd ed a.
GraphBuilder ni nd ed a
-> ExceptT GraphException (State (Graph ni nd ed)) a
buildGraph :: (ExceptT GraphException (State (Graph ni nd ed))) a }
  deriving
    ( (forall a b.
 (a -> b) -> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b)
-> (forall a b.
    a -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a)
-> Functor (GraphBuilder ni nd ed)
forall a b. a -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
forall a b.
(a -> b) -> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
forall ni nd ed a b.
a -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
forall ni nd ed a b.
(a -> b) -> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ni nd ed a b.
(a -> b) -> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
fmap :: forall a b.
(a -> b) -> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
$c<$ :: forall ni nd ed a b.
a -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
<$ :: forall a b. a -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
Functor,
      Functor (GraphBuilder ni nd ed)
Functor (GraphBuilder ni nd ed)
-> (forall a. a -> GraphBuilder ni nd ed a)
-> (forall a b.
    GraphBuilder ni nd ed (a -> b)
    -> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b)
-> (forall a b c.
    (a -> b -> c)
    -> GraphBuilder ni nd ed a
    -> GraphBuilder ni nd ed b
    -> GraphBuilder ni nd ed c)
-> (forall a b.
    GraphBuilder ni nd ed a
    -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b)
-> (forall a b.
    GraphBuilder ni nd ed a
    -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a)
-> Applicative (GraphBuilder ni nd ed)
forall a. a -> GraphBuilder ni nd ed a
forall a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
forall a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
forall a b.
GraphBuilder ni nd ed (a -> b)
-> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
forall ni nd ed. Functor (GraphBuilder ni nd ed)
forall a b c.
(a -> b -> c)
-> GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b
-> GraphBuilder ni nd ed c
forall ni nd ed a. a -> GraphBuilder ni nd ed a
forall ni nd ed a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
forall ni nd ed a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
forall ni nd ed a b.
GraphBuilder ni nd ed (a -> b)
-> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
forall ni nd ed a b c.
(a -> b -> c)
-> GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b
-> GraphBuilder ni nd ed c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall ni nd ed a. a -> GraphBuilder ni nd ed a
pure :: forall a. a -> GraphBuilder ni nd ed a
$c<*> :: forall ni nd ed a b.
GraphBuilder ni nd ed (a -> b)
-> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
<*> :: forall a b.
GraphBuilder ni nd ed (a -> b)
-> GraphBuilder ni nd ed a -> GraphBuilder ni nd ed b
$cliftA2 :: forall ni nd ed a b c.
(a -> b -> c)
-> GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b
-> GraphBuilder ni nd ed c
liftA2 :: forall a b c.
(a -> b -> c)
-> GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b
-> GraphBuilder ni nd ed c
$c*> :: forall ni nd ed a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
*> :: forall a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
$c<* :: forall ni nd ed a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
<* :: forall a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed a
Applicative,
      Applicative (GraphBuilder ni nd ed)
Applicative (GraphBuilder ni nd ed)
-> (forall a b.
    GraphBuilder ni nd ed a
    -> (a -> GraphBuilder ni nd ed b) -> GraphBuilder ni nd ed b)
-> (forall a b.
    GraphBuilder ni nd ed a
    -> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b)
-> (forall a. a -> GraphBuilder ni nd ed a)
-> Monad (GraphBuilder ni nd ed)
forall a. a -> GraphBuilder ni nd ed a
forall a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
forall a b.
GraphBuilder ni nd ed a
-> (a -> GraphBuilder ni nd ed b) -> GraphBuilder ni nd ed b
forall ni nd ed. Applicative (GraphBuilder ni nd ed)
forall ni nd ed a. a -> GraphBuilder ni nd ed a
forall ni nd ed a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
forall ni nd ed a b.
GraphBuilder ni nd ed a
-> (a -> GraphBuilder ni nd ed b) -> GraphBuilder ni nd ed b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall ni nd ed a b.
GraphBuilder ni nd ed a
-> (a -> GraphBuilder ni nd ed b) -> GraphBuilder ni nd ed b
>>= :: forall a b.
GraphBuilder ni nd ed a
-> (a -> GraphBuilder ni nd ed b) -> GraphBuilder ni nd ed b
$c>> :: forall ni nd ed a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
>> :: forall a b.
GraphBuilder ni nd ed a
-> GraphBuilder ni nd ed b -> GraphBuilder ni nd ed b
$creturn :: forall ni nd ed a. a -> GraphBuilder ni nd ed a
return :: forall a. a -> GraphBuilder ni nd ed a
Monad,
      MonadError GraphException,
      MonadState (Graph ni nd ed)
    )

addNode :: (Eq ni, Ord ni) => ni -> nd -> GraphBuilder ni nd ed ()
addNode :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> nd -> GraphBuilder ni nd ed ()
addNode ni
idx nd
dt = do
  (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ())
-> (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall a b. (a -> b) -> a -> b
$ \Graph ni nd ed
g -> Graph ni nd ed
g {$sel:nodes:Graph :: Map ni nd
nodes = ni -> nd -> Map ni nd -> Map ni nd
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ni
idx nd
dt (Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g)}

addEdge :: (Eq ni, Ord ni) => ni -> ni -> ed -> GraphBuilder ni nd ed ()
addEdge :: forall ni ed nd.
(Eq ni, Ord ni) =>
ni -> ni -> ed -> GraphBuilder ni nd ed ()
addEdge ni
src ni
dst ed
dt = do
  (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ())
-> (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall a b. (a -> b) -> a -> b
$ \Graph ni nd ed
g -> Graph ni nd ed
g {$sel:edges:Graph :: Map (ni, ni) ed
edges = (ni, ni) -> ed -> Map (ni, ni) ed -> Map (ni, ni) ed
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ni
src, ni
dst) ed
dt (Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g)}

deleteNode :: (Eq ni, Ord ni) => ni -> GraphBuilder ni nd ed ()
deleteNode :: forall ni nd ed. (Eq ni, Ord ni) => ni -> GraphBuilder ni nd ed ()
deleteNode ni
n = do
  Graph ni nd ed
g <- GraphBuilder ni nd ed (Graph ni nd ed)
forall s (m :: * -> *). MonadState s m => m s
get
  let nodes' :: Map ni nd
nodes' = ni -> Map ni nd -> Map ni nd
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ni
n (Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g)
      edges' :: Map (ni, ni) ed
edges' = ((ni, ni) -> ed -> Bool) -> Map (ni, ni) ed -> Map (ni, ni) ed
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(ni
s, ni
d) ed
_ -> ni
s ni -> ni -> Bool
forall a. Eq a => a -> a -> Bool
/= ni
n Bool -> Bool -> Bool
&& ni
d ni -> ni -> Bool
forall a. Eq a => a -> a -> Bool
/= ni
n) (Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g)
  (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ())
-> (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall a b. (a -> b) -> a -> b
$ \Graph ni nd ed
g -> Graph ni nd ed
g {$sel:nodes:Graph :: Map ni nd
nodes = Map ni nd
nodes', $sel:edges:Graph :: Map (ni, ni) ed
edges = Map (ni, ni) ed
edges'}

deleteEdge :: (Eq ni, Ord ni) => ni -> ni -> GraphBuilder ni nd ed ()
deleteEdge :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> ni -> GraphBuilder ni nd ed ()
deleteEdge ni
src ni
dst = do
  Graph ni nd ed
g <- GraphBuilder ni nd ed (Graph ni nd ed)
forall s (m :: * -> *). MonadState s m => m s
get
  let edges' :: Map (ni, ni) ed
edges' = (ni, ni) -> Map (ni, ni) ed -> Map (ni, ni) ed
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (ni
src, ni
dst) (Graph ni nd ed -> Map (ni, ni) ed
forall ni nd ed. Graph ni nd ed -> Map (ni, ni) ed
edges Graph ni nd ed
g)
  (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ())
-> (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall a b. (a -> b) -> a -> b
$ \Graph ni nd ed
g -> Graph ni nd ed
g {$sel:edges:Graph :: Map (ni, ni) ed
edges = Map (ni, ni) ed
edges'}

alterNode :: (Eq ni, Ord ni) => ni -> (Maybe nd -> Maybe nd) -> GraphBuilder ni nd ed ()
alterNode :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> (Maybe nd -> Maybe nd) -> GraphBuilder ni nd ed ()
alterNode ni
nid Maybe nd -> Maybe nd
f = do
  Graph ni nd ed
g <- GraphBuilder ni nd ed (Graph ni nd ed)
forall s (m :: * -> *). MonadState s m => m s
get
  let nds :: Map ni nd
nds = Graph ni nd ed -> Map ni nd
forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes Graph ni nd ed
g
  (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ())
-> (Graph ni nd ed -> Graph ni nd ed) -> GraphBuilder ni nd ed ()
forall a b. (a -> b) -> a -> b
$ \Graph ni nd ed
g -> Graph ni nd ed
g {$sel:nodes:Graph :: Map ni nd
nodes = (Maybe nd -> Maybe nd) -> ni -> Map ni nd -> Map ni nd
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe nd -> Maybe nd
f ni
nid Map ni nd
nds}

adjustNode :: (Eq ni, Ord ni) => ni -> (nd -> nd) -> GraphBuilder ni nd ed ()
adjustNode :: forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> (nd -> nd) -> GraphBuilder ni nd ed ()
adjustNode ni
nid nd -> nd
f = ni -> (Maybe nd -> Maybe nd) -> GraphBuilder ni nd ed ()
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> (Maybe nd -> Maybe nd) -> GraphBuilder ni nd ed ()
alterNode ni
nid Maybe nd -> Maybe nd
f'
  where
    f' :: Maybe nd -> Maybe nd
f' Maybe nd
Nothing = Maybe nd
forall a. Maybe a
Nothing
    f' (Just nd
d) = nd -> Maybe nd
forall a. a -> Maybe a
Just (nd -> Maybe nd) -> nd -> Maybe nd
forall a b. (a -> b) -> a -> b
$ nd -> nd
f nd
d

updateEdge :: (Eq ni, Ord ni) => ni -> ni -> ed -> GraphBuilder ni nd ed ()
updateEdge :: forall ni ed nd.
(Eq ni, Ord ni) =>
ni -> ni -> ed -> GraphBuilder ni nd ed ()
updateEdge ni
src ni
dst ed
d = do
  ni -> ni -> GraphBuilder ni nd ed ()
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> ni -> GraphBuilder ni nd ed ()
deleteEdge ni
src ni
dst
  ni -> ni -> ed -> GraphBuilder ni nd ed ()
forall ni ed nd.
(Eq ni, Ord ni) =>
ni -> ni -> ed -> GraphBuilder ni nd ed ()
addEdge ni
src ni
dst ed
d

update :: (Eq ni, Ord ni) => GraphBuilder ni nd ed a -> Graph ni nd ed -> Either Text (Graph ni nd ed)
update :: forall ni nd ed a.
(Eq ni, Ord ni) =>
GraphBuilder ni nd ed a
-> Graph ni nd ed -> Either GraphException (Graph ni nd ed)
update GraphBuilder ni nd ed a
bd Graph ni nd ed
init =
  let (Either GraphException a
except, Graph ni nd ed
g) = (State (Graph ni nd ed) (Either GraphException a)
-> Graph ni nd ed -> (Either GraphException a, Graph ni nd ed)
forall s a. State s a -> s -> (a, s)
runState (State (Graph ni nd ed) (Either GraphException a)
 -> Graph ni nd ed -> (Either GraphException a, Graph ni nd ed))
-> State (Graph ni nd ed) (Either GraphException a)
-> Graph ni nd ed
-> (Either GraphException a, Graph ni nd ed)
forall a b. (a -> b) -> a -> b
$ ExceptT GraphException (StateT (Graph ni nd ed) Identity) a
-> State (Graph ni nd ed) (Either GraphException a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT GraphException (StateT (Graph ni nd ed) Identity) a
 -> State (Graph ni nd ed) (Either GraphException a))
-> ExceptT GraphException (StateT (Graph ni nd ed) Identity) a
-> State (Graph ni nd ed) (Either GraphException a)
forall a b. (a -> b) -> a -> b
$ GraphBuilder ni nd ed a
-> ExceptT GraphException (StateT (Graph ni nd ed) Identity) a
forall ni nd ed a.
GraphBuilder ni nd ed a
-> ExceptT GraphException (State (Graph ni nd ed)) a
buildGraph GraphBuilder ni nd ed a
bd) Graph ni nd ed
init
   in case Either GraphException a
except of
        Left GraphException
except -> GraphException -> Either GraphException (Graph ni nd ed)
forall a b. a -> Either a b
Left GraphException
except
        Right a
_ -> Graph ni nd ed -> Either GraphException (Graph ni nd ed)
forall a b. b -> Either a b
Right Graph ni nd ed
g

build :: (Eq ni, Ord ni) => GraphBuilder ni nd ed a -> Either Text (Graph ni nd ed)
build :: forall ni nd ed a.
(Eq ni, Ord ni) =>
GraphBuilder ni nd ed a -> Either GraphException (Graph ni nd ed)
build GraphBuilder ni nd ed a
bd = GraphBuilder ni nd ed a
-> Graph ni nd ed -> Either GraphException (Graph ni nd ed)
forall ni nd ed a.
(Eq ni, Ord ni) =>
GraphBuilder ni nd ed a
-> Graph ni nd ed -> Either GraphException (Graph ni nd ed)
update GraphBuilder ni nd ed a
bd Graph ni nd ed
forall ni nd ed. Graph ni nd ed
empty

topologicalTraverseM :: (Eq ni, Ord ni, Monad m) => (ni -> nd -> m a) -> Graph ni nd ed -> m [a]
topologicalTraverseM :: forall ni (m :: * -> *) nd a ed.
(Eq ni, Ord ni, Monad m) =>
(ni -> nd -> m a) -> Graph ni nd ed -> m [a]
topologicalTraverseM ni -> nd -> m a
f Graph ni nd ed
g = [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m a] -> m [a]) -> [m a] -> m [a]
forall a b. (a -> b) -> a -> b
$ (ni -> nd -> m a) -> Graph ni nd ed -> [m a]
forall ni nd a ed.
(Eq ni, Ord ni) =>
(ni -> nd -> a) -> Graph ni nd ed -> [a]
topologicalTraverse ni -> nd -> m a
f Graph ni nd ed
g

topologicalTraverse :: (Eq ni, Ord ni) => (ni -> nd -> a) -> Graph ni nd ed -> [a]
topologicalTraverse :: forall ni nd a ed.
(Eq ni, Ord ni) =>
(ni -> nd -> a) -> Graph ni nd ed -> [a]
topologicalTraverse ni -> nd -> a
f g :: Graph ni nd ed
g@Graph {$sel:nodes:Graph :: forall ni nd ed. Graph ni nd ed -> Map ni nd
nodes = Map ni nd
nodes} = Map ni Int -> Graph ni nd ed -> [a]
recurse Map ni Int
initIndegree Graph ni nd ed
g
  where
    initIndegree :: Map ni Int
initIndegree = (ni -> nd -> Int) -> Map ni nd -> Map ni Int
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ni
i nd
d -> [(ni, ni, ed)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(ni, ni, ed)] -> Int) -> [(ni, ni, ed)] -> Int
forall a b. (a -> b) -> a -> b
$ ni -> Graph ni nd ed -> [(ni, ni, ed)]
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> [(ni, ni, ed)]
inBound ni
i Graph ni nd ed
g) Map ni nd
nodes
    findZeroIndegree :: Map ni Int -> [ni]
    findZeroIndegree :: forall ni. Map ni Int -> [ni]
findZeroIndegree Map ni Int
m = ((ni, Int) -> ni) -> [(ni, Int)] -> [ni]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ni, Int) -> ni
forall a b. (a, b) -> a
fst ([(ni, Int)] -> [ni]) -> [(ni, Int)] -> [ni]
forall a b. (a -> b) -> a -> b
$ Map ni Int -> [(ni, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ni Int -> [(ni, Int)]) -> Map ni Int -> [(ni, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Map ni Int -> Map ni Int
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Map ni Int
m
    updateIndegree :: k -> Map k a -> Graph k nd c -> Map k a
updateIndegree k
i Map k a
m Graph k nd c
g =
      let m' :: Map k a
m' = (Map k a -> (k, k, c) -> Map k a)
-> Map k a -> [(k, k, c)] -> Map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Map k a
m (k
_, k
ni, c
_) -> (a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
1) k
ni Map k a
m) Map k a
m ([(k, k, c)] -> Map k a) -> [(k, k, c)] -> Map k a
forall a b. (a -> b) -> a -> b
$ k -> Graph k nd c -> [(k, k, c)]
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> [(ni, ni, ed)]
outBound k
i Graph k nd c
g
          m'' :: Map k a
m'' = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
i Map k a
m'
       in Map k a
m''
    recurse :: Map ni Int -> Graph ni nd ed -> [a]
recurse Map ni Int
indegree Graph ni nd ed
g =
      let zeroIndegree :: [ni]
zeroIndegree = Map ni Int -> [ni]
forall ni. Map ni Int -> [ni]
findZeroIndegree Map ni Int
indegree
      in case [ni]
zeroIndegree of
        [] -> [a]
forall a. Monoid a => a
mempty
        (ni
n : [ni]
ns) ->
          let ele :: a
ele = ni -> nd -> a
f ni
n (Maybe nd -> nd
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Maybe nd -> nd) -> Maybe nd -> nd
forall a b. (a -> b) -> a -> b
$ ni -> Graph ni nd ed -> Maybe nd
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> Maybe nd
lookupNode ni
n Graph ni nd ed
g)
              indegree' :: Map ni Int
indegree' = ni -> Map ni Int -> Graph ni nd ed -> Map ni Int
forall {k} {a} {nd} {c}.
(Ord k, Num a) =>
k -> Map k a -> Graph k nd c -> Map k a
updateIndegree ni
n Map ni Int
indegree Graph ni nd ed
g
          in a
ele a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Map ni Int -> Graph ni nd ed -> [a]
recurse Map ni Int
indegree' Graph ni nd ed
g

newtype Memoize ni m a = Memoize
  { forall ni m a. Memoize ni m a -> State m a
unmem :: State m a
  }
  deriving ((forall a b. (a -> b) -> Memoize ni m a -> Memoize ni m b)
-> (forall a b. a -> Memoize ni m b -> Memoize ni m a)
-> Functor (Memoize ni m)
forall a b. a -> Memoize ni m b -> Memoize ni m a
forall a b. (a -> b) -> Memoize ni m a -> Memoize ni m b
forall ni m a b. a -> Memoize ni m b -> Memoize ni m a
forall ni m a b. (a -> b) -> Memoize ni m a -> Memoize ni m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ni m a b. (a -> b) -> Memoize ni m a -> Memoize ni m b
fmap :: forall a b. (a -> b) -> Memoize ni m a -> Memoize ni m b
$c<$ :: forall ni m a b. a -> Memoize ni m b -> Memoize ni m a
<$ :: forall a b. a -> Memoize ni m b -> Memoize ni m a
Functor, Functor (Memoize ni m)
Functor (Memoize ni m)
-> (forall a. a -> Memoize ni m a)
-> (forall a b.
    Memoize ni m (a -> b) -> Memoize ni m a -> Memoize ni m b)
-> (forall a b c.
    (a -> b -> c)
    -> Memoize ni m a -> Memoize ni m b -> Memoize ni m c)
-> (forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b)
-> (forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m a)
-> Applicative (Memoize ni m)
forall a. a -> Memoize ni m a
forall ni m. Functor (Memoize ni m)
forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m a
forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
forall a b.
Memoize ni m (a -> b) -> Memoize ni m a -> Memoize ni m b
forall ni m a. a -> Memoize ni m a
forall a b c.
(a -> b -> c) -> Memoize ni m a -> Memoize ni m b -> Memoize ni m c
forall ni m a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m a
forall ni m a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
forall ni m a b.
Memoize ni m (a -> b) -> Memoize ni m a -> Memoize ni m b
forall ni m a b c.
(a -> b -> c) -> Memoize ni m a -> Memoize ni m b -> Memoize ni m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall ni m a. a -> Memoize ni m a
pure :: forall a. a -> Memoize ni m a
$c<*> :: forall ni m a b.
Memoize ni m (a -> b) -> Memoize ni m a -> Memoize ni m b
<*> :: forall a b.
Memoize ni m (a -> b) -> Memoize ni m a -> Memoize ni m b
$cliftA2 :: forall ni m a b c.
(a -> b -> c) -> Memoize ni m a -> Memoize ni m b -> Memoize ni m c
liftA2 :: forall a b c.
(a -> b -> c) -> Memoize ni m a -> Memoize ni m b -> Memoize ni m c
$c*> :: forall ni m a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
*> :: forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
$c<* :: forall ni m a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m a
<* :: forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m a
Applicative, Applicative (Memoize ni m)
Applicative (Memoize ni m)
-> (forall a b.
    Memoize ni m a -> (a -> Memoize ni m b) -> Memoize ni m b)
-> (forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b)
-> (forall a. a -> Memoize ni m a)
-> Monad (Memoize ni m)
forall a. a -> Memoize ni m a
forall ni m. Applicative (Memoize ni m)
forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
forall a b.
Memoize ni m a -> (a -> Memoize ni m b) -> Memoize ni m b
forall ni m a. a -> Memoize ni m a
forall ni m a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
forall ni m a b.
Memoize ni m a -> (a -> Memoize ni m b) -> Memoize ni m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall ni m a b.
Memoize ni m a -> (a -> Memoize ni m b) -> Memoize ni m b
>>= :: forall a b.
Memoize ni m a -> (a -> Memoize ni m b) -> Memoize ni m b
$c>> :: forall ni m a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
>> :: forall a b. Memoize ni m a -> Memoize ni m b -> Memoize ni m b
$creturn :: forall ni m a. a -> Memoize ni m a
return :: forall a. a -> Memoize ni m a
Monad, MonadState m)

data Memory ni = Memory
  { forall ni. Memory ni -> Set ni
processing :: !(Set ni),
    forall ni. Memory ni -> Map ni (Set ni)
finished :: !(Map ni (Set ni))
  }
  deriving ((forall x. Memory ni -> Rep (Memory ni) x)
-> (forall x. Rep (Memory ni) x -> Memory ni)
-> Generic (Memory ni)
forall x. Rep (Memory ni) x -> Memory ni
forall x. Memory ni -> Rep (Memory ni) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ni x. Rep (Memory ni) x -> Memory ni
forall ni x. Memory ni -> Rep (Memory ni) x
$cfrom :: forall ni x. Memory ni -> Rep (Memory ni) x
from :: forall x. Memory ni -> Rep (Memory ni) x
$cto :: forall ni x. Rep (Memory ni) x -> Memory ni
to :: forall x. Rep (Memory ni) x -> Memory ni
Generic)

recurse_ :: (Eq ni, Ord ni) => (ni -> Graph ni nd ed -> [ni]) -> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
recurse_ :: forall ni nd ed.
(Eq ni, Ord ni) =>
(ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
recurse_ ni -> Graph ni nd ed -> [ni]
f ni
idx Graph ni nd ed
g = do
  (Memory Set ni
processing Map ni (Set ni)
finished) <- Memoize ni (Memory ni) (Memory ni)
forall s (m :: * -> *). MonadState s m => m s
get
  #processing %= Set.insert idx
  case ni -> Map ni (Set ni) -> Maybe (Set ni)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ni
idx Map ni (Set ni)
finished of
    Just Set ni
res -> Set ni -> Memoize ni (Memory ni) (Set ni)
forall a. a -> Memoize ni (Memory ni) a
forall (m :: * -> *) a. Monad m => a -> m a
return Set ni
res
    Maybe (Set ni)
Nothing -> do
      let direct :: [ni]
direct = ni -> Graph ni nd ed -> [ni]
f ni
idx Graph ni nd ed
g
      -- Avoid infinite loops by ignoring nodes being processed in the stack
      [Set ni]
indirect <- (ni -> Memoize ni (Memory ni) (Set ni))
-> [ni] -> Memoize ni (Memory ni) [Set ni]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ni
i -> (ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
forall ni nd ed.
(Eq ni, Ord ni) =>
(ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
recurse_ ni -> Graph ni nd ed -> [ni]
f ni
i Graph ni nd ed
g) ((ni -> Bool) -> [ni] -> [ni]
forall a. (a -> Bool) -> [a] -> [a]
filter (ni -> Set ni -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ni
processing) [ni]
direct)
      let res :: Set ni
res = Set ni -> Set ni -> Set ni
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([ni] -> Set ni
forall a. Ord a => [a] -> Set a
Set.fromList [ni]
direct) ([Set ni] -> Set ni
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set ni]
indirect)
      #finished %= Map.insert idx res
      Set ni -> Memoize ni (Memory ni) (Set ni)
forall a. a -> Memoize ni (Memory ni) a
forall (m :: * -> *) a. Monad m => a -> m a
return Set ni
res

strictlyDominate :: (Eq ni, Ord ni) => ni -> Graph ni nd ed -> Set ni
strictlyDominate :: forall ni nd ed. (Eq ni, Ord ni) => ni -> Graph ni nd ed -> Set ni
strictlyDominate ni
idx Graph ni nd ed
g =
  State (Memory ni) (Set ni) -> Memory ni -> Set ni
forall s a. State s a -> s -> a
evalState (Memoize ni (Memory ni) (Set ni) -> State (Memory ni) (Set ni)
forall ni m a. Memoize ni m a -> State m a
unmem (Memoize ni (Memory ni) (Set ni) -> State (Memory ni) (Set ni))
-> Memoize ni (Memory ni) (Set ni) -> State (Memory ni) (Set ni)
forall a b. (a -> b) -> a -> b
$ (ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
forall ni nd ed.
(Eq ni, Ord ni) =>
(ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
recurse_ (\ni
i Graph ni nd ed
g -> ni -> Graph ni nd ed -> [(ni, ni, ed)]
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> [(ni, ni, ed)]
outBound ni
i Graph ni nd ed
g [(ni, ni, ed)] -> ((ni, ni, ed) -> ni) -> [ni]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ni
_, ni
dst, ed
_) -> ni
dst) ni
idx Graph ni nd ed
g) (Set ni -> Map ni (Set ni) -> Memory ni
forall ni. Set ni -> Map ni (Set ni) -> Memory ni
Memory Set ni
forall a. Set a
Set.empty Map ni (Set ni)
forall k a. Map k a
Map.empty)

strictlyPostDominate :: (Eq ni, Ord ni) => ni -> Graph ni nd ed -> Set ni
strictlyPostDominate :: forall ni nd ed. (Eq ni, Ord ni) => ni -> Graph ni nd ed -> Set ni
strictlyPostDominate ni
idx Graph ni nd ed
g =
  State (Memory ni) (Set ni) -> Memory ni -> Set ni
forall s a. State s a -> s -> a
evalState (Memoize ni (Memory ni) (Set ni) -> State (Memory ni) (Set ni)
forall ni m a. Memoize ni m a -> State m a
unmem (Memoize ni (Memory ni) (Set ni) -> State (Memory ni) (Set ni))
-> Memoize ni (Memory ni) (Set ni) -> State (Memory ni) (Set ni)
forall a b. (a -> b) -> a -> b
$ (ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
forall ni nd ed.
(Eq ni, Ord ni) =>
(ni -> Graph ni nd ed -> [ni])
-> ni -> Graph ni nd ed -> Memoize ni (Memory ni) (Set ni)
recurse_ (\ni
i Graph ni nd ed
g -> ni -> Graph ni nd ed -> [(ni, ni, ed)]
forall ni nd ed.
(Eq ni, Ord ni) =>
ni -> Graph ni nd ed -> [(ni, ni, ed)]
inBound ni
i Graph ni nd ed
g [(ni, ni, ed)] -> ((ni, ni, ed) -> ni) -> [ni]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ni
src, ni
_, ed
_) -> ni
src) ni
idx Graph ni nd ed
g) (Set ni -> Map ni (Set ni) -> Memory ni
forall ni. Set ni -> Map ni (Set ni) -> Memory ni
Memory Set ni
forall a. Set a
Set.empty Map ni (Set ni)
forall k a. Map k a
Map.empty)