module Knuth1 where

import Pretty
import ExecutionPlan
import CommonTypes
import Control.Monad
import Control.Monad.ST
import Data.Maybe
import Data.List
import Data.STRef
import Debug.Trace

import Data.Array (Array)
import qualified Data.Array as Array
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set

-- | Trace a message in the ST monad
traceST :: String -> ST s ()
traceST :: forall s. String -> ST s ()
traceST String
s = forall a. String -> a -> a
trace String
s (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-------------------------------------------------------------------------------
--         Dependency graph representation
-------------------------------------------------------------------------------

-- Vertices
data AttrType = Inh | Syn | Loc deriving (AttrType -> AttrType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrType -> AttrType -> Bool
$c/= :: AttrType -> AttrType -> Bool
== :: AttrType -> AttrType -> Bool
$c== :: AttrType -> AttrType -> Bool
Eq, Eq AttrType
AttrType -> AttrType -> Bool
AttrType -> AttrType -> Ordering
AttrType -> AttrType -> AttrType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttrType -> AttrType -> AttrType
$cmin :: AttrType -> AttrType -> AttrType
max :: AttrType -> AttrType -> AttrType
$cmax :: AttrType -> AttrType -> AttrType
>= :: AttrType -> AttrType -> Bool
$c>= :: AttrType -> AttrType -> Bool
> :: AttrType -> AttrType -> Bool
$c> :: AttrType -> AttrType -> Bool
<= :: AttrType -> AttrType -> Bool
$c<= :: AttrType -> AttrType -> Bool
< :: AttrType -> AttrType -> Bool
$c< :: AttrType -> AttrType -> Bool
compare :: AttrType -> AttrType -> Ordering
$ccompare :: AttrType -> AttrType -> Ordering
Ord, Int -> AttrType -> ShowS
[AttrType] -> ShowS
AttrType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrType] -> ShowS
$cshowList :: [AttrType] -> ShowS
show :: AttrType -> String
$cshow :: AttrType -> String
showsPrec :: Int -> AttrType -> ShowS
$cshowsPrec :: Int -> AttrType -> ShowS
Show)
data Vertex = VAttr  AttrType Identifier Identifier
            | VChild Identifier
            | VRule  Identifier deriving (Vertex -> Vertex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex -> Vertex -> Bool
$c/= :: Vertex -> Vertex -> Bool
== :: Vertex -> Vertex -> Bool
$c== :: Vertex -> Vertex -> Bool
Eq, Eq Vertex
Vertex -> Vertex -> Bool
Vertex -> Vertex -> Ordering
Vertex -> Vertex -> Vertex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Vertex -> Vertex -> Vertex
$cmin :: Vertex -> Vertex -> Vertex
max :: Vertex -> Vertex -> Vertex
$cmax :: Vertex -> Vertex -> Vertex
>= :: Vertex -> Vertex -> Bool
$c>= :: Vertex -> Vertex -> Bool
> :: Vertex -> Vertex -> Bool
$c> :: Vertex -> Vertex -> Bool
<= :: Vertex -> Vertex -> Bool
$c<= :: Vertex -> Vertex -> Bool
< :: Vertex -> Vertex -> Bool
$c< :: Vertex -> Vertex -> Bool
compare :: Vertex -> Vertex -> Ordering
$ccompare :: Vertex -> Vertex -> Ordering
Ord)

instance Show Vertex where
  show :: Vertex -> String
show (VAttr AttrType
ty Identifier
ch Identifier
at) = forall a. Show a => a -> String
show AttrType
ty forall a. [a] -> [a] -> [a]
++ String
" @" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
ch forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
at
  show (VChild Identifier
ch)      = String
"Child " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
ch
  show (VRule Identifier
ru)       = String
"Rule " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
ru

-- | Check if a vertex is an attribute
isVertexAttr :: Vertex -> Bool
isVertexAttr :: Vertex -> Bool
isVertexAttr (VAttr AttrType
_ Identifier
_ Identifier
_) = Bool
True
isVertexAttr Vertex
_             = Bool
False

-- | Get the child name of an attribute
getAttrChildName :: Vertex -> Identifier
getAttrChildName :: Vertex -> Identifier
getAttrChildName (VAttr AttrType
_ Identifier
n Identifier
_) = Identifier
n

-- | Set the child name of an attribute
setAttrChildName :: Vertex -> Identifier -> Vertex
setAttrChildName :: Vertex -> Identifier -> Vertex
setAttrChildName (VAttr AttrType
t Identifier
_ Identifier
a) Identifier
n = AttrType -> Identifier -> Identifier -> Vertex
VAttr AttrType
t Identifier
n Identifier
a

-- | Get the type of an attribute
getAttrType :: Vertex -> AttrType
getAttrType :: Vertex -> AttrType
getAttrType (VAttr AttrType
t Identifier
_ Identifier
_) = AttrType
t

-- | Get the name of an attribute
getAttrName :: Vertex -> Identifier
getAttrName :: Vertex -> Identifier
getAttrName (VAttr AttrType
_ Identifier
_ Identifier
a) = Identifier
a

-- Edges
type Edge = (Vertex, Vertex)

-- Internal representation of a vertex
type IVertex = Int
type IEdge = (IVertex, IVertex)

-- Representation of the graph
data DependencyGraph s = DependencyGraph { forall s. DependencyGraph s -> Map Vertex Int
vertexIMap   :: Map   Vertex  IVertex
                                         , forall s. DependencyGraph s -> Array Int Vertex
vertexOMap   :: Array IVertex Vertex
                                         , forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors   :: Array IVertex (STRef s (Set IVertex))
                                         , forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors :: Array IVertex (STRef s (Set IVertex)) }

-------------------------------------------------------------------------------
--         Dependency graph fuctions
-------------------------------------------------------------------------------

-- | Construct a dependency graph
graphConstruct :: [Vertex] -> ST s (DependencyGraph s)
graphConstruct :: forall s. [Vertex] -> ST s (DependencyGraph s)
graphConstruct [Vertex]
vs = do let nv :: Int
nv    = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertex]
vs
                       let ivs :: [Int]
ivs   = [Int
0..Int
nvforall a. Num a => a -> a -> a
-Int
1]
                       let ivb :: (Int, Int)
ivb   = (Int
0,Int
nvforall a. Num a => a -> a -> a
-Int
1)
                       let vimap :: Map Vertex Int
vimap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex]
vs [Int]
ivs)
                       let vomap :: Array Int Vertex
vomap = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (Int, Int)
ivb (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ivs [Vertex]
vs)
                       [STRef s (Set Int)]
succs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nv (forall a s. a -> ST s (STRef s a)
newSTRef forall a. Set a
Set.empty)
                       [STRef s (Set Int)]
preds <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nv (forall a s. a -> ST s (STRef s a)
newSTRef forall a. Set a
Set.empty)
                       let su :: Array Int (STRef s (Set Int))
su    = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (Int, Int)
ivb (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ivs [STRef s (Set Int)]
succs)
                       let pr :: Array Int (STRef s (Set Int))
pr    = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (Int, Int)
ivb (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ivs [STRef s (Set Int)]
preds)
                       let graph :: DependencyGraph s
graph = DependencyGraph { vertexIMap :: Map Vertex Int
vertexIMap   = Map Vertex Int
vimap
                                                   , vertexOMap :: Array Int Vertex
vertexOMap   = Array Int Vertex
vomap
                                                   , successors :: Array Int (STRef s (Set Int))
successors   = Array Int (STRef s (Set Int))
su
                                                   , predecessors :: Array Int (STRef s (Set Int))
predecessors = Array Int (STRef s (Set Int))
pr }
                       forall (m :: * -> *) a. Monad m => a -> m a
return DependencyGraph s
graph

-- | Construct a transitivelly closed graph
graphConstructTRC :: [Vertex] -> [Edge] -> ST s (DependencyGraph s)
graphConstructTRC :: forall s. [Vertex] -> [Edge] -> ST s (DependencyGraph s)
graphConstructTRC [Vertex]
vs [Edge]
es = do DependencyGraph s
g <- forall s. [Vertex] -> ST s (DependencyGraph s)
graphConstruct [Vertex]
vs
                             -- Insert all initial edges
                             forall s. DependencyGraph s -> [Edge] -> ST s [Edge]
graphInsertEdgesTRC DependencyGraph s
g [Edge]
es
                             forall (m :: * -> *) a. Monad m => a -> m a
return DependencyGraph s
g

-- | Return all successors of a vertex
graphSuccessors :: DependencyGraph s -> Vertex -> ST s (Set Vertex)
graphSuccessors :: forall s. DependencyGraph s -> Vertex -> ST s (Set Vertex)
graphSuccessors DependencyGraph s
g Vertex
v = do Set Int
sucs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! (forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v)
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g) Set Int
sucs

-- | Return all predecessors of a vertex
graphPredecessors :: DependencyGraph s -> Vertex -> ST s (Set Vertex)
graphPredecessors :: forall s. DependencyGraph s -> Vertex -> ST s (Set Vertex)
graphPredecessors DependencyGraph s
g Vertex
v = do Set Int
sucs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! (forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v)
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g) Set Int
sucs

-- | Check if the graph contains an edge
graphContainsEdge :: DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge :: forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge DependencyGraph s
g (Vertex
v1,Vertex
v2) = do let iv1 :: Int
iv1  = forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v1
                                 let iv2 :: Int
iv2  = forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v2
                                 Set Int
sucs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv1
                                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
iv2 forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
sucs

-- | Insert an edge in the graph
graphInsert :: DependencyGraph s -> Edge -> ST s ()
graphInsert :: forall s. DependencyGraph s -> Edge -> ST s ()
graphInsert DependencyGraph s
g (Vertex
v1,Vertex
v2) = do let iv1 :: Int
iv1  = forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v1
                           let iv2 :: Int
iv2  = forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v2
                           -- Add v2 to the successors of v1 and v1 to predecessors of v2
                           forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef ((forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv1) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert Int
iv2
                           forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef ((forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv2) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert Int
iv1

-- | Insert an edge in a transtive closed graph and return all other edges that were
--   added due to transtivity
graphInsertTRC :: DependencyGraph s -> Edge -> ST s [(IVertex, Set IVertex)]
graphInsertTRC :: forall s. DependencyGraph s -> Edge -> ST s [(Int, Set Int)]
graphInsertTRC DependencyGraph s
g (Vertex
v1,Vertex
v2) = do let iv1 :: Int
iv1  = forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v1
                              let iv2 :: Int
iv2  = forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v2
                              -- Read predecessors of v1 and successors of v2
                              Set Int
pred1 <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv1
                              Set Int
succ2 <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv2
                              -- First insert all edges from v1
                              let rsucc1 :: STRef s (Set Int)
rsucc1 = (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv1
                              Set Int
succ1 <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Set Int)
rsucc1
                              let add1 :: Set Int
add1 = Set Int
succ2 forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
succ1
                              forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Set Int)
rsucc1 (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Int
add1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
Set.insert Int
iv2)
                              -- All edges to v2
                              let rpred2 :: STRef s (Set Int)
rpred2 = (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
iv2
                              forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Set Int)
rpred2 (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Int
pred1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
Set.insert Int
iv1)
                              -- Connect every predecessor of v1 to every successor of v2
                              [(Int, Set Int)]
sucl <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.toList Set Int
pred1) forall a b. (a -> b) -> a -> b
$ \Int
pred -> do
                                -- Connect pred to v2 and all successors of v2
                                let rsucc :: STRef s (Set Int)
rsucc = (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
pred
                                Set Int
csucc <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Set Int)
rsucc
                                let cadd :: Set Int
cadd = (forall a. Ord a => a -> Set a -> Set a
Set.insert Int
iv2 Set Int
succ2) forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
csucc
                                forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Set Int)
rsucc (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Int
cadd)
                                forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pred, Set Int
cadd)
                              -- Connect every successor of v2 to every predecessor of v1
                              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Set a -> [a]
Set.toList Set Int
succ2) forall a b. (a -> b) -> a -> b
$ \Int
succ -> do
                                -- Connect succ to v1 and all predecessors of v1
                                let rpred :: STRef s (Set Int)
rpred = (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
succ
                                Set Int
cpred <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Set Int)
rpred
                                let cadd :: Set Int
cadd = (forall a. Ord a => a -> Set a -> Set a
Set.insert Int
iv1 Set Int
pred1) forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
cpred
                                forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Set Int)
rpred (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Int
cadd)
                              -- Create return
                              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Int
iv1,Set Int
add1) forall a. a -> [a] -> [a]
: [(Int, Set Int)]
sucl

-- | Return all vertices of the graph
graphVertices :: DependencyGraph s -> ST s [Vertex]
graphVertices :: forall s. DependencyGraph s -> ST s [Vertex]
graphVertices = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> [e]
Array.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. DependencyGraph s -> Array Int Vertex
vertexOMap

-- | Return all edges of the graph
graphEdges :: DependencyGraph s -> ST s [Edge]
graphEdges :: forall s. DependencyGraph s -> ST s [Edge]
graphEdges DependencyGraph s
g = do let vs :: [Int]
vs = forall i e. Ix i => Array i e -> [i]
Array.indices forall a b. (a -> b) -> a -> b
$ forall s. DependencyGraph s -> Array Int Vertex
vertexOMap DependencyGraph s
g
                  [[Edge]]
perv <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs forall a b. (a -> b) -> a -> b
$ \Int
v -> do
                    let rv :: Vertex
rv = forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g Int
v
                    Set Int
sucs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
v
                    let sucl :: [Int]
sucl = forall a. Set a -> [a]
Set.toList Set Int
sucs
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((,) Vertex
rv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g) [Int]
sucl
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Edge]]
perv

-- | Insert a list of edges in the graph
graphInsertEdges :: DependencyGraph s -> [Edge] -> ST s ()
graphInsertEdges :: forall s. DependencyGraph s -> [Edge] -> ST s ()
graphInsertEdges DependencyGraph s
g [Edge]
ed = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. DependencyGraph s -> Edge -> ST s ()
graphInsert DependencyGraph s
g) [Edge]
ed

-- | Insert a list of edges in the graph and return all other edges that
--   were added due to transitivity
graphInsertEdgesTRC :: DependencyGraph s -> [Edge] -> ST s [Edge]
graphInsertEdgesTRC :: forall s. DependencyGraph s -> [Edge] -> ST s [Edge]
graphInsertEdgesTRC DependencyGraph s
g [Edge]
ed = do -- rets :: [[(IVertex, Set IVertex)]]
                              [[(Int, Set Int)]]
rets <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s. DependencyGraph s -> Edge -> ST s [(Int, Set Int)]
graphInsertTRC DependencyGraph s
g) [Edge]
ed
                              -- Combine all successor sets
                              let f    :: (IVertex, (Set IVertex)) -> [(IVertex, IVertex)]
                                  f :: (Int, Set Int) -> [(Int, Int)]
f (Int
v,Set Int
s) = forall a b. (a -> b) -> [a] -> [b]
map ((,) Int
v) (forall a. Set a -> [a]
Set.toList Set Int
s)
                              let comb :: [(IVertex, IVertex)]
                                  comb :: [(Int, Int)]
comb = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Set Int) -> [(Int, Int)]
f) [[(Int, Set Int)]]
rets
                              -- Construct edges from this
                              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall s. DependencyGraph s -> (Int, Int) -> Edge
graphGetEdge DependencyGraph s
g) forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
comb

-- | Check whether the graph is cyclic
graphIsCyclic :: DependencyGraph s -> ST s Bool
graphIsCyclic :: forall s. DependencyGraph s -> ST s Bool
graphIsCyclic DependencyGraph s
g = do
  Set Int
s <- forall s. DependencyGraph s -> ST s (Set Int)
graphCyclicVertices DependencyGraph s
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null Set Int
s

graphCyclicVertices :: DependencyGraph s -> ST s (Set IVertex)
graphCyclicVertices :: forall s. DependencyGraph s -> ST s (Set Int)
graphCyclicVertices DependencyGraph s
g = do
  [Int]
vs <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i e. Ix i => Array i e -> [i]
Array.indices forall a b. (a -> b) -> a -> b
$ forall s. DependencyGraph s -> Array Int Vertex
vertexOMap DependencyGraph s
g
  [Set Int]
sets <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs forall a b. (a -> b) -> a -> b
$ \Int
v -> do
            Set Int
sucs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
v
            let res :: Set Int
res | Int
v forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
sucs = forall a. a -> Set a
Set.singleton Int
v
                    | Bool
otherwise           = forall a. Set a
Set.empty
            forall (m :: * -> *) a. Monad m => a -> m a
return Set Int
res
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Int]
sets)

graphCyclicVerticesExt :: DependencyGraph s -> ST s [Vertex]
graphCyclicVerticesExt :: forall s. DependencyGraph s -> ST s [Vertex]
graphCyclicVerticesExt DependencyGraph s
g = (forall a b. (a -> b) -> [a] -> [b]
map (forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.elems) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s. DependencyGraph s -> ST s (Set Int)
graphCyclicVertices DependencyGraph s
g

-- | Get internal representation of a vertex
graphGetIVertex :: DependencyGraph s -> Vertex -> IVertex
graphGetIVertex :: forall s. DependencyGraph s -> Vertex -> Int
graphGetIVertex DependencyGraph s
g Vertex
v = forall s. DependencyGraph s -> Map Vertex Int
vertexIMap DependencyGraph s
g forall k a. Ord k => Map k a -> k -> a
Map.! Vertex
v

-- | Get external representation of a vertex
graphGetVertex :: DependencyGraph s -> IVertex -> Vertex
graphGetVertex :: forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g Int
v = forall s. DependencyGraph s -> Array Int Vertex
vertexOMap DependencyGraph s
g forall i e. Ix i => Array i e -> i -> e
Array.! Int
v

-- | Get external representation of an edge
graphGetEdge :: DependencyGraph s -> IEdge -> Edge
graphGetEdge :: forall s. DependencyGraph s -> (Int, Int) -> Edge
graphGetEdge DependencyGraph s
g (Int
v1,Int
v2) = (forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g Int
v1, forall s. DependencyGraph s -> Int -> Vertex
graphGetVertex DependencyGraph s
g Int
v2)

-- | Check if the graph is transitively closed
graphIsTRC :: DependencyGraph s -> ST s Bool
graphIsTRC :: forall s. DependencyGraph s -> ST s Bool
graphIsTRC DependencyGraph s
g = do let vs :: [Int]
vs = forall i e. Ix i => Array i e -> [i]
Array.indices forall a b. (a -> b) -> a -> b
$ forall s. DependencyGraph s -> Array Int Vertex
vertexOMap DependencyGraph s
g
                  [Bool]
bs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs forall a b. (a -> b) -> a -> b
$ \Int
v -> do
                    Set Int
succs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
v
                    [Bool]
bs2 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.toList Set Int
succs) forall a b. (a -> b) -> a -> b
$ \Int
v2 -> do
                      Set Int
succs2 <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
v2
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Set Int
succs2 forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Int
succs
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bs2
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bs

-- | Check consistency of the graph (successor and predecessor sets)
graphCheckConsistency :: DependencyGraph s -> ST s Bool
graphCheckConsistency :: forall s. DependencyGraph s -> ST s Bool
graphCheckConsistency DependencyGraph s
g = do let vs :: [Int]
vs = forall i e. Ix i => Array i e -> [i]
Array.indices forall a b. (a -> b) -> a -> b
$ forall s. DependencyGraph s -> Array Int Vertex
vertexOMap DependencyGraph s
g
                             [Bool]
ret <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
vs forall a b. (a -> b) -> a -> b
$ \Int
v -> do
                               -- V must appear in every predecessor set of its successors
                               Set Int
succs <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
v
                               [Bool]
r1 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.toList Set Int
succs) forall a b. (a -> b) -> a -> b
$ \Int
succ -> do
                                 Set Int
preds2 <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
succ
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (Int
v forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
preds2)
                               -- V must appear in every successor set of its predecessors
                               Set Int
preds <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
v
                               [Bool]
r2 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.toList Set Int
preds) forall a b. (a -> b) -> a -> b
$ \Int
pred -> do
                                 Set Int
succs2 <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
successors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
pred
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (Int
v forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
succs2)
                               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ [Bool]
r1 forall a. [a] -> [a] -> [a]
++ [Bool]
r2
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ [Bool]
ret

-- | Add edges to the graph so that it is topologically sorted (this will not work if graph is cyclic)
graphTopSort :: DependencyGraph s -> ST s [Edge]
graphTopSort :: forall s. DependencyGraph s -> ST s [Edge]
graphTopSort DependencyGraph s
g = do let vs :: [Int]
vs = forall i e. Ix i => Array i e -> [i]
Array.indices forall a b. (a -> b) -> a -> b
$ forall s. DependencyGraph s -> Array Int Vertex
vertexOMap DependencyGraph s
g
                    [Int]
order <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall s. DependencyGraph s -> [Int] -> Int -> ST s [Int]
graphTopSort' DependencyGraph s
g) [] [Int]
vs
                    [Maybe Edge]
mb <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
order (forall a. [a] -> [a]
tail [Int]
order)) forall a b. (a -> b) -> a -> b
$ \(Int
v1,Int
v2) -> do
                      let edg :: Edge
edg = forall s. DependencyGraph s -> (Int, Int) -> Edge
graphGetEdge DependencyGraph s
g (Int
v2,Int
v1) -- order is actually reverse order
                      Bool
ce <- forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge DependencyGraph s
g Edge
edg
                      if Bool
ce
                        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        else do forall s. DependencyGraph s -> Edge -> ST s ()
graphInsert DependencyGraph s
g Edge
edg
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Edge
edg
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Edge]
mb

-- | Helper function for graphTopSort
graphTopSort' :: DependencyGraph s -> [IVertex] -> IVertex -> ST s [IVertex]
graphTopSort' :: forall s. DependencyGraph s -> [Int] -> Int -> ST s [Int]
graphTopSort' DependencyGraph s
g [Int]
prev Int
cur | Int
cur forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
prev = forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
prev
                         | Bool
otherwise       = do Set Int
pred <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ (forall s. DependencyGraph s -> Array Int (STRef s (Set Int))
predecessors DependencyGraph s
g) forall i e. Ix i => Array i e -> i -> e
Array.! Int
cur
                                                [Int]
order <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM  (forall s. DependencyGraph s -> [Int] -> Int -> ST s [Int]
graphTopSort' DependencyGraph s
g) [Int]
prev forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Int
pred
                                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
cur forall a. a -> [a] -> [a]
: [Int]
order

-------------------------------------------------------------------------------
--         Dependency graph information wrappers
-------------------------------------------------------------------------------

-- | Special wrapper for nonterminal dependency graphs (so that we can easily add other meta-information)
data NontDependencyGraph = NontDependencyGraph { NontDependencyGraph -> [Vertex]
ndgVertices    :: [Vertex]
                                               , NontDependencyGraph -> [Edge]
ndgEdges       :: [Edge] }

-- | Special wrapper for production dependency graphs, including mapping between child names and nonterminals
data ProdDependencyGraph = ProdDependencyGraph { ProdDependencyGraph -> [Vertex]
pdgVertices    :: [Vertex]
                                               , ProdDependencyGraph -> [Edge]
pdgEdges       :: [Edge]
                                               , ProdDependencyGraph -> ERules
pdgRules       :: ERules
                                               , ProdDependencyGraph -> EChildren
pdgChilds      :: EChildren
                                               , ProdDependencyGraph -> Identifier
pdgProduction  :: Identifier
                                               , ProdDependencyGraph -> [(Identifier, Identifier)]
pdgChildMap    :: [(Identifier, Identifier)]
                                               , ProdDependencyGraph -> [Type]
pdgConstraints :: [Type]
                                               , ProdDependencyGraph -> [Identifier]
pdgParams      :: [Identifier] }


-- | Represent all information from the dependency graphs for a nonterminal
data NontDependencyInformation = NontDependencyInformation { NontDependencyInformation -> Identifier
ndiNonterminal :: Identifier
                                                           , NontDependencyInformation -> [Identifier]
ndiParams      :: [Identifier]
                                                           , NontDependencyInformation -> [Identifier]
ndiInh         :: [Identifier]
                                                           , NontDependencyInformation -> [Identifier]
ndiSyn         :: [Identifier]
                                                           , NontDependencyInformation -> NontDependencyGraph
ndiDepGraph    :: NontDependencyGraph
                                                           , NontDependencyInformation -> [ProdDependencyGraph]
ndiProds       :: [ProdDependencyGraph]
                                                           , NontDependencyInformation -> Bool
ndiRecursive   :: Bool
                                                           , NontDependencyInformation -> HigherOrderInfo
ndiHoInfo      :: HigherOrderInfo
                                                           , NontDependencyInformation -> ClassContext
ndiClassCtxs   :: ClassContext
                                                           }

--- Monadic versions of these records, for use with the ST monad

-- | Monadic wrapper of NontDependencyGraph
data NontDependencyGraphM s = NontDependencyGraphM { forall s. NontDependencyGraphM s -> DependencyGraph s
ndgmDepGraph :: DependencyGraph s
                                                   , forall s. NontDependencyGraphM s -> NontDependencyGraph
ndgmOrig     :: NontDependencyGraph }

-- | Monadic wrapper of ProdDependencyGraph
data ProdDependencyGraphM s = ProdDependencyGraphM { forall s. ProdDependencyGraphM s -> DependencyGraph s
pdgmDepGraph   :: DependencyGraph s
                                                   , forall s. ProdDependencyGraphM s -> ProdDependencyGraph
pdgmOrig       :: ProdDependencyGraph }


-- | Monadic wrapper of NontDependencyInformation
data NontDependencyInformationM s = NontDependencyInformationM { forall s. NontDependencyInformationM s -> NontDependencyInformation
ndimOrig        :: NontDependencyInformation
                                                               , forall s. NontDependencyInformationM s -> NontDependencyGraphM s
ndimDepGraph    :: NontDependencyGraphM s
                                                               , forall s. NontDependencyInformationM s -> [ProdDependencyGraphM s]
ndimProds       :: [ProdDependencyGraphM s] }


-- | Convert a NontDependencyGraph to the corresponding monadic version
mkNontDependencyGraphM :: NontDependencyGraph -> ST s (NontDependencyGraphM s)
mkNontDependencyGraphM :: forall s. NontDependencyGraph -> ST s (NontDependencyGraphM s)
mkNontDependencyGraphM NontDependencyGraph
ndg = do DependencyGraph s
g <- forall s. [Vertex] -> [Edge] -> ST s (DependencyGraph s)
graphConstructTRC (NontDependencyGraph -> [Vertex]
ndgVertices NontDependencyGraph
ndg) (NontDependencyGraph -> [Edge]
ndgEdges NontDependencyGraph
ndg)
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NontDependencyGraphM { ndgmDepGraph :: DependencyGraph s
ndgmDepGraph = DependencyGraph s
g
                                                              , ndgmOrig :: NontDependencyGraph
ndgmOrig     = NontDependencyGraph
ndg }


-- | Convert a ProdDependencyGraph to the corresponding monadic version
mkProdDependencyGraphM :: Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s)
mkProdDependencyGraphM :: forall s.
Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s)
mkProdDependencyGraphM Bool
trc ProdDependencyGraph
pdg = do DependencyGraph s
g <- if Bool
trc
                                         then forall s. [Vertex] -> [Edge] -> ST s (DependencyGraph s)
graphConstructTRC (ProdDependencyGraph -> [Vertex]
pdgVertices ProdDependencyGraph
pdg) (ProdDependencyGraph -> [Edge]
pdgEdges ProdDependencyGraph
pdg)
                                         else do DependencyGraph s
g <- forall s. [Vertex] -> ST s (DependencyGraph s)
graphConstruct (ProdDependencyGraph -> [Vertex]
pdgVertices ProdDependencyGraph
pdg)
                                                 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. DependencyGraph s -> Edge -> ST s ()
graphInsert DependencyGraph s
g) (ProdDependencyGraph -> [Edge]
pdgEdges ProdDependencyGraph
pdg)
                                                 forall (m :: * -> *) a. Monad m => a -> m a
return DependencyGraph s
g
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProdDependencyGraphM { pdgmDepGraph :: DependencyGraph s
pdgmDepGraph   = DependencyGraph s
g
                                                                  , pdgmOrig :: ProdDependencyGraph
pdgmOrig       = ProdDependencyGraph
pdg }

-- | Convert a NontDependencyInformation to the corresponding monadic version
mkNontDependencyInformationM :: NontDependencyInformation -> ST s (NontDependencyInformationM s)
mkNontDependencyInformationM :: forall s.
NontDependencyInformation -> ST s (NontDependencyInformationM s)
mkNontDependencyInformationM NontDependencyInformation
ndi = do NontDependencyGraphM s
dg <- forall s. NontDependencyGraph -> ST s (NontDependencyGraphM s)
mkNontDependencyGraphM (NontDependencyInformation -> NontDependencyGraph
ndiDepGraph NontDependencyInformation
ndi)
                                      [ProdDependencyGraphM s]
prods <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s.
Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s)
mkProdDependencyGraphM Bool
True) (NontDependencyInformation -> [ProdDependencyGraph]
ndiProds NontDependencyInformation
ndi)
                                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NontDependencyInformationM { ndimOrig :: NontDependencyInformation
ndimOrig     = NontDependencyInformation
ndi
                                                                          , ndimDepGraph :: NontDependencyGraphM s
ndimDepGraph = NontDependencyGraphM s
dg
                                                                          , ndimProds :: [ProdDependencyGraphM s]
ndimProds    = [ProdDependencyGraphM s]
prods }

-- | Construct the production graphs from the transitivelly closed graphs
undoTransitiveClosure :: [NontDependencyInformationM s] -> ST s [NontDependencyInformationM s]
undoTransitiveClosure :: forall s.
[NontDependencyInformationM s]
-> ST s [NontDependencyInformationM s]
undoTransitiveClosure [NontDependencyInformationM s]
ndis = do [[Edge]]
edgesl <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\NontDependencyInformationM s
ndi -> forall s. DependencyGraph s -> ST s [Edge]
graphEdges (forall s. NontDependencyGraphM s -> DependencyGraph s
ndgmDepGraph forall a b. (a -> b) -> a -> b
$ forall s. NontDependencyInformationM s -> NontDependencyGraphM s
ndimDepGraph NontDependencyInformationM s
ndi)) [NontDependencyInformationM s]
ndis
                                let edges :: [Edge]
edges = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Edge]]
edgesl
                                forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [NontDependencyInformationM s]
ndis forall a b. (a -> b) -> a -> b
$ \NontDependencyInformationM s
ndi -> do
                                  [ProdDependencyGraphM s]
prods <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s.
Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s)
mkProdDependencyGraphM Bool
False) (NontDependencyInformation -> [ProdDependencyGraph]
ndiProds forall a b. (a -> b) -> a -> b
$ forall s. NontDependencyInformationM s -> NontDependencyInformation
ndimOrig NontDependencyInformationM s
ndi)
                                  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [ProdDependencyGraphM s]
prods (forall s. NontDependencyInformationM s -> [ProdDependencyGraphM s]
ndimProds NontDependencyInformationM s
ndi)) forall a b. (a -> b) -> a -> b
$ \(ProdDependencyGraphM s
nprod,ProdDependencyGraphM s
oprod) -> do
                                    -- All possible edges
                                    let possa :: [Edge]
possa = do (Vertex
v1,Vertex
v2) <- [Edge]
edges
                                                   -- Take a child of this nonterminal type
                                                   forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v1
                                                   forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v2
                                                   let tp :: Identifier
tp = Vertex -> Identifier
getAttrChildName Vertex
v1
                                                   (Identifier
ch,Identifier
chtp) <- ProdDependencyGraph -> [(Identifier, Identifier)]
pdgChildMap forall a b. (a -> b) -> a -> b
$ forall s. ProdDependencyGraphM s -> ProdDependencyGraph
pdgmOrig ProdDependencyGraphM s
nprod
                                                   forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Identifier
tp forall a. Eq a => a -> a -> Bool
== Identifier
chtp
                                                   -- Construct edge as it should be in the production graph
                                                   let nv1 :: Vertex
nv1 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v1 Identifier
ch
                                                   let nv2 :: Vertex
nv2 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v2 Identifier
ch
                                                   forall (m :: * -> *) a. Monad m => a -> m a
return (Vertex
nv1, Vertex
nv2)
                                    [Edge]
toadd <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge (forall s. ProdDependencyGraphM s -> DependencyGraph s
pdgmDepGraph ProdDependencyGraphM s
oprod)) [Edge]
possa
                                    forall s. DependencyGraph s -> [Edge] -> ST s ()
graphInsertEdges (forall s. ProdDependencyGraphM s -> DependencyGraph s
pdgmDepGraph ProdDependencyGraphM s
nprod) [Edge]
toadd
                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NontDependencyInformationM { ndimOrig :: NontDependencyInformation
ndimOrig     = forall s. NontDependencyInformationM s -> NontDependencyInformation
ndimOrig NontDependencyInformationM s
ndi
                                                                      , ndimDepGraph :: NontDependencyGraphM s
ndimDepGraph = forall s. NontDependencyInformationM s -> NontDependencyGraphM s
ndimDepGraph NontDependencyInformationM s
ndi
                                                                      , ndimProds :: [ProdDependencyGraphM s]
ndimProds    = [ProdDependencyGraphM s]
prods }


-------------------------------------------------------------------------------
--         Knuth-1 algorithm
-------------------------------------------------------------------------------

-- | Combine the dependency and nonterminal graphs using Knuth-1
--   this function assumes that the nonterminal graphs initially contains no edges
knuth1 :: [NontDependencyInformationM s] -> ST s ()
knuth1 :: forall s. [NontDependencyInformationM s] -> ST s ()
knuth1 [NontDependencyInformationM s]
ndis = do -- Create initial list of pending edges for each ndi per production (initially all prod edges)
--               pndis :: [([[Edge]], NontDependencyInformation)]
                 [([[Edge]], NontDependencyInformationM s)]
pndis <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [NontDependencyInformationM s]
ndis forall a b. (a -> b) -> a -> b
$ \NontDependencyInformationM s
ndi -> do
                   [[Edge]]
ipend <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s. DependencyGraph s -> ST s [Edge]
graphEdges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. ProdDependencyGraphM s -> DependencyGraph s
pdgmDepGraph) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. NontDependencyInformationM s -> [ProdDependencyGraphM s]
ndimProds forall a b. (a -> b) -> a -> b
$ NontDependencyInformationM s
ndi
                   forall (m :: * -> *) a. Monad m => a -> m a
return ([[Edge]]
ipend, NontDependencyInformationM s
ndi)
                 forall s. [([[Edge]], NontDependencyInformationM s)] -> ST s ()
knuth1' [([[Edge]], NontDependencyInformationM s)]
pndis

-- | Helper function for |knuth1| which repeats the process until we are done
knuth1' :: [([[Edge]], NontDependencyInformationM s)] -> ST s ()
knuth1' :: forall s. [([[Edge]], NontDependencyInformationM s)] -> ST s ()
knuth1' [([[Edge]], NontDependencyInformationM s)]
ndis = do -- Add edges from the production graphs to the nonterminal graph
--                ndis' :: [[Edge]]
                  [[Edge]]
ndis' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s. ([[Edge]], NontDependencyInformationM s) -> ST s [Edge]
addProdNont [([[Edge]], NontDependencyInformationM s)]
ndis
                  -- List of all newly added edges
--                ntedge :: [Edge]
                  let pntedge :: [Edge]
pntedge = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Edge]]
ndis'
                  -- Add backedges
                  --bedges <- addBackEdges ndis
                  -- All added nonterminal edges
                  let ntedge :: [Edge]
ntedge = [Edge]
pntedge -- ++ bedges
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Edge]
ntedge
                    -- When no new edges have been added we are done
                    then forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    else do -- Otherwise, the next step is to add edges from nonterminal to production graphs
--                          ndis'' :: [[[Edge]]]
                            [[[Edge]]]
ndis'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([[Edge]]
_,NontDependencyInformationM s
x) -> forall s.
Bool -> ([Edge], NontDependencyInformationM s) -> ST s [[Edge]]
addNontProd Bool
True ([Edge]
ntedge, NontDependencyInformationM s
x)) [([[Edge]], NontDependencyInformationM s)]
ndis
                            -- List of new states (production edges + dependency graphs)
--                          nndis' :: [([[Edge]], NontDependencyInformation)]
                            [([[Edge]], NontDependencyInformationM s)]
nndis' <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\([[Edge]]
_,NontDependencyInformationM s
ndi) [[Edge]]
me -> forall (m :: * -> *) a. Monad m => a -> m a
return ([[Edge]]
me, NontDependencyInformationM s
ndi)) [([[Edge]], NontDependencyInformationM s)]
ndis [[[Edge]]]
ndis''
                            if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[[Edge]]]
ndis''
                               -- We have added some edges, so continue the process
                              then forall s. [([[Edge]], NontDependencyInformationM s)] -> ST s ()
knuth1' [([[Edge]], NontDependencyInformationM s)]
nndis'
                              -- No new edges added, we are done
                              else forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Add pending edges from the production graphs to the nonterminal graph
--   and return the list of newly added nonterminal edges
addProdNont :: ([[Edge]], NontDependencyInformationM s) -> ST s [Edge]
addProdNont :: forall s. ([[Edge]], NontDependencyInformationM s) -> ST s [Edge]
addProdNont ([[Edge]]
pending, NontDependencyInformationM s
ndi) = do -- Unwrapping of the records
                                let nontDepGraph :: NontDependencyGraphM s
nontDepGraph = forall s. NontDependencyInformationM s -> NontDependencyGraphM s
ndimDepGraph NontDependencyInformationM s
ndi
                                let nontGraph :: DependencyGraph s
nontGraph = forall s. NontDependencyGraphM s -> DependencyGraph s
ndgmDepGraph NontDependencyGraphM s
nontDepGraph
                                -- nub the list because multiple productions can result in the same new edges
                                let possa :: [Edge]
possa = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ do (Vertex
v1,Vertex
v2) <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Edge]]
pending
                                                     -- Take only edges from syn.lhs to inh.lhs
                                                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v1
                                                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Identifier
getAttrChildName Vertex
v1 forall a. Eq a => a -> a -> Bool
== Identifier
_LHS
                                                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> AttrType
getAttrType      Vertex
v1 forall a. Eq a => a -> a -> Bool
==  AttrType
Syn
                                                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v2
                                                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Identifier
getAttrChildName Vertex
v2 forall a. Eq a => a -> a -> Bool
== Identifier
_LHS
                                                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> AttrType
getAttrType      Vertex
v2 forall a. Eq a => a -> a -> Bool
==  AttrType
Inh
                                                     -- Construct edge as it should be in nonterminal graph
                                                     let nv1 :: Vertex
nv1 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v1 (NontDependencyInformation -> Identifier
ndiNonterminal forall a b. (a -> b) -> a -> b
$ forall s. NontDependencyInformationM s -> NontDependencyInformation
ndimOrig NontDependencyInformationM s
ndi)
                                                     let nv2 :: Vertex
nv2 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v2 (NontDependencyInformation -> Identifier
ndiNonterminal forall a b. (a -> b) -> a -> b
$ forall s. NontDependencyInformationM s -> NontDependencyInformation
ndimOrig NontDependencyInformationM s
ndi)
                                                     forall (m :: * -> *) a. Monad m => a -> m a
return (Vertex
nv1, Vertex
nv2)
                                -- Edges that are not in the nonterminal graph yet
                                [Edge]
toadd <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\Edge
e -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool -> Bool
not forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge DependencyGraph s
nontGraph Edge
e) [Edge]
possa
                                -- Check whether new edges are to be added and return the added edges
                                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Edge]
toadd) forall a b. (a -> b) -> a -> b
$ do
                                   forall s. DependencyGraph s -> [Edge] -> ST s [Edge]
graphInsertEdgesTRC DependencyGraph s
nontGraph [Edge]
toadd
                                   forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                forall (m :: * -> *) a. Monad m => a -> m a
return [Edge]
toadd

-- | Add edges from the nonterminal graphs to the production graphs
--   and return the list of newly added production edges and the updated graph
addNontProd :: Bool -> ([Edge], NontDependencyInformationM s) -> ST s [[Edge]]
addNontProd :: forall s.
Bool -> ([Edge], NontDependencyInformationM s) -> ST s [[Edge]]
addNontProd Bool
trc ([Edge]
pending, NontDependencyInformationM s
ndi) = do -- Just call the helper function for each nonterminal
                                    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s. Bool -> [Edge] -> ProdDependencyGraphM s -> ST s [Edge]
addNontProd' Bool
trc [Edge]
pending) (forall s. NontDependencyInformationM s -> [ProdDependencyGraphM s]
ndimProds NontDependencyInformationM s
ndi)

-- | Helper function for |addNontProd| for a single production
addNontProd' :: Bool -> [Edge] -> ProdDependencyGraphM s -> ST s [Edge]
addNontProd' :: forall s. Bool -> [Edge] -> ProdDependencyGraphM s -> ST s [Edge]
addNontProd' Bool
trc [Edge]
pend ProdDependencyGraphM s
pdg = do -- Unwrapping of the records
                               DependencyGraph s
prodGraph <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. ProdDependencyGraphM s -> DependencyGraph s
pdgmDepGraph ProdDependencyGraphM s
pdg
                               -- Construct all possible new edges
                               let possa :: [Edge]
possa = do (Vertex
v1,Vertex
v2) <- [Edge]
pend
                                              -- Take a child of this nonterminal type
                                              forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v1
                                              forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v2
                                              let tp :: Identifier
tp = Vertex -> Identifier
getAttrChildName Vertex
v1
                                              (Identifier
ch,Identifier
chtp) <- ProdDependencyGraph -> [(Identifier, Identifier)]
pdgChildMap forall a b. (a -> b) -> a -> b
$ forall s. ProdDependencyGraphM s -> ProdDependencyGraph
pdgmOrig ProdDependencyGraphM s
pdg
                                              forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Identifier
tp forall a. Eq a => a -> a -> Bool
== Identifier
chtp
                                              -- Construct edge as it should be in the production graph
                                              let nv1 :: Vertex
nv1 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v1 Identifier
ch
                                              let nv2 :: Vertex
nv2 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v2 Identifier
ch
                                              forall (m :: * -> *) a. Monad m => a -> m a
return (Vertex
nv1, Vertex
nv2)
                               -- Edges that are not in the production graph yet
                               [Edge]
toadd <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\Edge
e -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool -> Bool
not forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge DependencyGraph s
prodGraph Edge
e) [Edge]
possa
                               -- Check whether new edges are to be added and return the result
                               if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Edge]
toadd
                                 then forall (m :: * -> *) a. Monad m => a -> m a
return []
                                 else do -- Insert all edges and return transitive edges that are added in this process
                                         [Edge]
ret <- if Bool
trc
                                                then forall s. DependencyGraph s -> [Edge] -> ST s [Edge]
graphInsertEdgesTRC DependencyGraph s
prodGraph [Edge]
toadd
                                                else do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. DependencyGraph s -> Edge -> ST s ()
graphInsert DependencyGraph s
prodGraph) [Edge]
toadd
                                                        forall (m :: * -> *) a. Monad m => a -> m a
return []
                                         -- Debug output
                                         --mapM_ (\edge -> traceST $ "Adding production edge " ++ show edge) toadd
                                         forall (m :: * -> *) a. Monad m => a -> m a
return [Edge]
ret

-- | Add the "back edges" to the nonterminal graphs for creating a global ordering
addBackEdges :: [([[Edge]], NontDependencyInformationM s)] -> ST s [Edge]
addBackEdges :: forall s. [([[Edge]], NontDependencyInformationM s)] -> ST s [Edge]
addBackEdges [([[Edge]], NontDependencyInformationM s)]
ndis = do -- gather all backedges
                       [[Edge]]
lBackEdges <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([[Edge]], NontDependencyInformationM s)]
ndis forall a b. (a -> b) -> a -> b
$ \([[Edge]]
aedg,NontDependencyInformationM s
ndi) -> do
                         -- For every production
                         [[Edge]]
bs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip [[Edge]]
aedg (forall s. NontDependencyInformationM s -> [ProdDependencyGraphM s]
ndimProds NontDependencyInformationM s
ndi)) forall a b. (a -> b) -> a -> b
$ \([Edge]
edg,ProdDependencyGraphM s
prod) -> do
                           -- Filter out the backedges
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do (Vertex
v1,Vertex
v2) <- [Edge]
edg
                                       -- Backedges are from inh.ch to syn.ch
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v1
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Identifier
getAttrChildName Vertex
v1 forall a. Eq a => a -> a -> Bool
/= Identifier
_LHS
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> AttrType
getAttrType      Vertex
v1 forall a. Eq a => a -> a -> Bool
==  AttrType
Inh
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v2
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Identifier
getAttrChildName Vertex
v2 forall a. Eq a => a -> a -> Bool
/= Identifier
_LHS
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> AttrType
getAttrType      Vertex
v2 forall a. Eq a => a -> a -> Bool
==  AttrType
Syn
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Identifier
getAttrChildName Vertex
v1 forall a. Eq a => a -> a -> Bool
== Vertex -> Identifier
getAttrChildName Vertex
v2
                                       -- Find the correct child name
                                       (Identifier
ch,Identifier
chtp) <- ProdDependencyGraph -> [(Identifier, Identifier)]
pdgChildMap forall a b. (a -> b) -> a -> b
$ forall s. ProdDependencyGraphM s -> ProdDependencyGraph
pdgmOrig ProdDependencyGraphM s
prod
                                       let tp :: Identifier
tp = Vertex -> Identifier
getAttrChildName Vertex
v1
                                       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Identifier
tp forall a. Eq a => a -> a -> Bool
== Identifier
ch
                                       -- Construct the edge as it should be in the nonterminal graph
                                       let nv1 :: Vertex
nv1 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v1 Identifier
chtp
                                       let nv2 :: Vertex
nv2 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v2 Identifier
chtp
                                       forall (m :: * -> *) a. Monad m => a -> m a
return (Vertex
nv1, Vertex
nv2)
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Eq a => [a] -> [a] -> [a]
union [] [[Edge]]
bs
                       -- Concatenate all lists of backedges
                       let backedges :: [Edge]
backedges = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Eq a => [a] -> [a] -> [a]
union [] [[Edge]]
lBackEdges
                       -- Add backedges to every nonterminal graph
                       [[Edge]]
ret <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([[Edge]], NontDependencyInformationM s)]
ndis forall a b. (a -> b) -> a -> b
$ \([[Edge]]
_,NontDependencyInformationM s
ndi) -> do
                         -- Find the backedges for this nonterminal
                         let nont :: Identifier
nont = NontDependencyInformation -> Identifier
ndiNonterminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. NontDependencyInformationM s -> NontDependencyInformation
ndimOrig forall a b. (a -> b) -> a -> b
$ NontDependencyInformationM s
ndi
                         let thisbe :: [Edge]
thisbe = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) Identifier
nont forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Identifier
getAttrChildName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Edge]
backedges
                         -- Add them to the graph
                         forall s. DependencyGraph s -> [Edge] -> ST s [Edge]
graphInsertEdgesTRC (forall s. NontDependencyGraphM s -> DependencyGraph s
ndgmDepGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. NontDependencyInformationM s -> NontDependencyGraphM s
ndimDepGraph forall a b. (a -> b) -> a -> b
$ NontDependencyInformationM s
ndi) [Edge]
thisbe
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Edge]
backedges forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Edge]]
ret


-- | Add all resulting edges from a topsort on the nonterminal graph to the production graph
--   this will ignore edges that will make the graph cyclic
addTopSortEdges :: [Edge] -> ProdDependencyGraphM s -> ST s ()
addTopSortEdges :: forall s. [Edge] -> ProdDependencyGraphM s -> ST s ()
addTopSortEdges [Edge]
pend ProdDependencyGraphM s
pdg = do -- Unwrapping of the records
                              DependencyGraph s
prodGraph <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. ProdDependencyGraphM s -> DependencyGraph s
pdgmDepGraph ProdDependencyGraphM s
pdg
                              -- Construct all possible new edges
                              let possa :: [Edge]
possa = do (Vertex
v1,Vertex
v2) <- [Edge]
pend
                                             -- Take a child of this nonterminal type
                                             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v1
                                             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vertex -> Bool
isVertexAttr Vertex
v2
                                             let tp :: Identifier
tp = Vertex -> Identifier
getAttrChildName Vertex
v1
                                             (Identifier
ch,Identifier
chtp) <- ProdDependencyGraph -> [(Identifier, Identifier)]
pdgChildMap forall a b. (a -> b) -> a -> b
$ forall s. ProdDependencyGraphM s -> ProdDependencyGraph
pdgmOrig ProdDependencyGraphM s
pdg
                                             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Identifier
tp forall a. Eq a => a -> a -> Bool
== Identifier
chtp
                                             -- Construct edge as it should be in the production graph
                                             let nv1 :: Vertex
nv1 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v1 Identifier
ch
                                             let nv2 :: Vertex
nv2 = Vertex -> Identifier -> Vertex
setAttrChildName Vertex
v2 Identifier
ch
                                             forall (m :: * -> *) a. Monad m => a -> m a
return (Vertex
nv1, Vertex
nv2)
                              -- Edges that are not in the production graph yet
                              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Edge]
possa forall a b. (a -> b) -> a -> b
$ \(Vertex
v1,Vertex
v2) -> do Bool
e1 <- forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge DependencyGraph s
prodGraph (Vertex
v1,Vertex
v2)
                                                           Bool
e2 <- forall s. DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge DependencyGraph s
prodGraph (Vertex
v2,Vertex
v1)
                                                           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Bool
e1 Bool -> Bool -> Bool
|| Bool
e2) forall a b. (a -> b) -> a -> b
$ do
                                                             forall s. DependencyGraph s -> Edge -> ST s [(Int, Set Int)]
graphInsertTRC DependencyGraph s
prodGraph (Vertex
v1,Vertex
v2)
                                                             forall (m :: * -> *) a. Monad m => a -> m a
return ()