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 s = trace s (return ())

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

-- Vertices
data AttrType = Inh | Syn | Loc deriving (Eq, Ord, Show)
data Vertex = VAttr  AttrType Identifier Identifier
            | VChild Identifier
            | VRule  Identifier deriving (Eq, Ord)

instance Show Vertex where
  show (VAttr ty ch at) = show ty ++ " @" ++ show ch ++ "." ++ show at
  show (VChild ch)      = "Child " ++ show ch
  show (VRule ru)       = "Rule " ++ show ru

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

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

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

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

-- | Get the name of an attribute
getAttrName :: Vertex -> Identifier
getAttrName (VAttr _ _ a) = 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 { vertexIMap   :: Map   Vertex  IVertex
                                         , vertexOMap   :: Array IVertex Vertex
                                         , successors   :: Array IVertex (STRef s (Set IVertex))
                                         , predecessors :: Array IVertex (STRef s (Set IVertex)) }

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

-- | Construct a dependency graph
graphConstruct :: [Vertex] -> ST s (DependencyGraph s)
graphConstruct vs = do let nv    = length vs
                       let ivs   = [0..nv-1]
                       let ivb   = (0,nv-1)
                       let vimap = Map.fromList (zip vs ivs)
                       let vomap = Array.array ivb (zip ivs vs)
                       succs <- replicateM nv (newSTRef Set.empty)
                       preds <- replicateM nv (newSTRef Set.empty)
                       let su    = Array.array ivb (zip ivs succs)
                       let pr    = Array.array ivb (zip ivs preds)
                       let graph = DependencyGraph { vertexIMap   = vimap
                                                   , vertexOMap   = vomap
                                                   , successors   = su
                                                   , predecessors = pr }
                       return graph

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

-- | Return all successors of a vertex
graphSuccessors :: DependencyGraph s -> Vertex -> ST s (Set Vertex)
graphSuccessors g v = do sucs <- readSTRef $ (successors g) Array.! (graphGetIVertex g v)
                         return $ Set.map (graphGetVertex g) sucs

-- | Return all predecessors of a vertex
graphPredecessors :: DependencyGraph s -> Vertex -> ST s (Set Vertex)
graphPredecessors g v = do sucs <- readSTRef $ (predecessors g) Array.! (graphGetIVertex g v)
                           return $ Set.map (graphGetVertex g) sucs

-- | Check if the graph contains an edge
graphContainsEdge :: DependencyGraph s -> Edge -> ST s Bool
graphContainsEdge g (v1,v2) = do let iv1  = graphGetIVertex g v1
                                 let iv2  = graphGetIVertex g v2
                                 sucs <- readSTRef $ (successors g) Array.! iv1
                                 return $ iv2 `Set.member` sucs

-- | Insert an edge in the graph
graphInsert :: DependencyGraph s -> Edge -> ST s ()
graphInsert g (v1,v2) = do let iv1  = graphGetIVertex g v1
                           let iv2  = graphGetIVertex g v2
                           -- Add v2 to the successors of v1 and v1 to predecessors of v2
                           modifySTRef ((successors g) Array.! iv1) $ Set.insert iv2
                           modifySTRef ((predecessors g) Array.! iv2) $ Set.insert 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 g (v1,v2) = do let iv1  = graphGetIVertex g v1
                              let iv2  = graphGetIVertex g v2
                              -- Read predecessors of v1 and successors of v2
                              pred1 <- readSTRef $ (predecessors g) Array.! iv1
                              succ2 <- readSTRef $ (successors g) Array.! iv2
                              -- First insert all edges from v1
                              let rsucc1 = (successors g) Array.! iv1
                              succ1 <- readSTRef rsucc1
                              let add1 = succ2 `Set.difference` succ1
                              modifySTRef rsucc1 (Set.union add1 . Set.insert iv2)
                              -- All edges to v2
                              let rpred2 = (predecessors g) Array.! iv2
                              modifySTRef rpred2 (Set.union pred1 . Set.insert iv1)
                              -- Connect every predecessor of v1 to every successor of v2
                              sucl <- forM (Set.toList pred1) $ \pred -> do
                                -- Connect pred to v2 and all successors of v2
                                let rsucc = (successors g) Array.! pred
                                csucc <- readSTRef rsucc
                                let cadd = (Set.insert iv2 succ2) `Set.difference` csucc
                                modifySTRef rsucc (Set.union cadd)
                                return (pred, cadd)
                              -- Connect every successor of v2 to every predecessor of v1
                              forM_ (Set.toList succ2) $ \succ -> do
                                -- Connect succ to v1 and all predecessors of v1
                                let rpred = (predecessors g) Array.! succ
                                cpred <- readSTRef rpred
                                let cadd = (Set.insert iv1 pred1) `Set.difference` cpred
                                modifySTRef rpred (Set.union cadd)
                              -- Create return
                              return $ (iv1,add1) : sucl

-- | Return all vertices of the graph
graphVertices :: DependencyGraph s -> ST s [Vertex]
graphVertices = return . Array.elems . vertexOMap

-- | Return all edges of the graph
graphEdges :: DependencyGraph s -> ST s [Edge]
graphEdges g = do let vs = Array.indices $ vertexOMap g
                  perv <- forM vs $ \v -> do
                    let rv = graphGetVertex g v
                    sucs <- readSTRef $ (successors g) Array.! v
                    let sucl = Set.toList sucs
                    return $ map ((,) rv . graphGetVertex g) sucl
                  return $ concat perv

-- | Insert a list of edges in the graph
graphInsertEdges :: DependencyGraph s -> [Edge] -> ST s ()
graphInsertEdges g ed = mapM_ (graphInsert g) 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 g ed = do -- rets :: [[(IVertex, Set IVertex)]]
                              rets <- mapM (graphInsertTRC g) ed
                              -- Combine all successor sets
                              let f    :: (IVertex, (Set IVertex)) -> [(IVertex, IVertex)]
                                  f (v,s) = map ((,) v) (Set.toList s)
                              let comb :: [(IVertex, IVertex)]
                                  comb = concatMap (concatMap f) rets
                              -- Construct edges from this
                              return $ map (graphGetEdge g) $ comb

-- | Check whether the graph is cyclic
graphIsCyclic :: DependencyGraph s -> ST s Bool
graphIsCyclic g = do
  s <- graphCyclicVertices g
  return $ not $ Set.null s

graphCyclicVertices :: DependencyGraph s -> ST s (Set IVertex)
graphCyclicVertices g = do
  vs <- return $ Array.indices $ vertexOMap g
  sets <- forM vs $ \v -> do
            sucs <- readSTRef $ (successors g) Array.! v
            let res | v `Set.member` sucs = Set.singleton v
                    | otherwise           = Set.empty
            return res
  return (Set.unions sets)

graphCyclicVerticesExt :: DependencyGraph s -> ST s [Vertex]
graphCyclicVerticesExt g = (map (graphGetVertex g) . Set.elems) `fmap` graphCyclicVertices g

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

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

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

-- | Check if the graph is transitively closed
graphIsTRC :: DependencyGraph s -> ST s Bool
graphIsTRC g = do let vs = Array.indices $ vertexOMap g
                  bs <- forM vs $ \v -> do
                    succs <- readSTRef $ (successors g) Array.! v
                    bs2 <- forM (Set.toList succs) $ \v2 -> do
                      succs2 <- readSTRef $ (successors g) Array.! v2
                      return $ succs2 `Set.isSubsetOf` succs
                    return $ and bs2
                  return $ and bs

-- | Check consistency of the graph (successor and predecessor sets)
graphCheckConsistency :: DependencyGraph s -> ST s Bool
graphCheckConsistency g = do let vs = Array.indices $ vertexOMap g
                             ret <- forM vs $ \v -> do
                               -- V must appear in every predecessor set of its successors
                               succs <- readSTRef $ (successors g) Array.! v
                               r1 <- forM (Set.toList succs) $ \succ -> do
                                 preds2 <- readSTRef $ (predecessors g) Array.! succ
                                 return (v `Set.member` preds2)
                               -- V must appear in every successor set of its predecessors
                               preds <- readSTRef $ (predecessors g) Array.! v
                               r2 <- forM (Set.toList preds) $ \pred -> do
                                 succs2 <- readSTRef $ (successors g) Array.! pred
                                 return (v `Set.member` succs2)
                               return $ and $ r1 ++ r2
                             return $ and $ 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 g = do let vs = Array.indices $ vertexOMap g
                    order <- foldM (graphTopSort' g) [] vs
                    mb <- forM (zip order (tail order)) $ \(v1,v2) -> do
                      let edg = graphGetEdge g (v2,v1) -- order is actually reverse order
                      ce <- graphContainsEdge g edg
                      if ce
                        then return Nothing
                        else do graphInsert g edg
                                return $ Just edg
                    return $ catMaybes mb

-- | Helper function for graphTopSort
graphTopSort' :: DependencyGraph s -> [IVertex] -> IVertex -> ST s [IVertex]
graphTopSort' g prev cur | cur `elem` prev = return prev
                         | otherwise       = do pred <- readSTRef $ (predecessors g) Array.! cur
                                                order <- foldM  (graphTopSort' g) prev $ Set.toList pred
                                                return $ cur : order

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

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

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


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

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

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

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


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


-- | Convert a NontDependencyGraph to the corresponding monadic version
mkNontDependencyGraphM :: NontDependencyGraph -> ST s (NontDependencyGraphM s)
mkNontDependencyGraphM ndg = do g <- graphConstructTRC (ndgVertices ndg) (ndgEdges ndg)
                                return $ NontDependencyGraphM { ndgmDepGraph = g
                                                              , ndgmOrig     = ndg }


-- | Convert a ProdDependencyGraph to the corresponding monadic version
mkProdDependencyGraphM :: Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s)
mkProdDependencyGraphM trc pdg = do g <- if trc
                                         then graphConstructTRC (pdgVertices pdg) (pdgEdges pdg)
                                         else do g <- graphConstruct (pdgVertices pdg)
                                                 mapM_ (graphInsert g) (pdgEdges pdg)
                                                 return g
                                    return $ ProdDependencyGraphM { pdgmDepGraph   = g
                                                                  , pdgmOrig       = pdg }

-- | Convert a NontDependencyInformation to the corresponding monadic version
mkNontDependencyInformationM :: NontDependencyInformation -> ST s (NontDependencyInformationM s)
mkNontDependencyInformationM ndi = do dg <- mkNontDependencyGraphM (ndiDepGraph ndi)
                                      prods <- mapM (mkProdDependencyGraphM True) (ndiProds ndi)
                                      return $ NontDependencyInformationM { ndimOrig     = ndi
                                                                          , ndimDepGraph = dg
                                                                          , ndimProds    = prods }

-- | Construct the production graphs from the transitivelly closed graphs
undoTransitiveClosure :: [NontDependencyInformationM s] -> ST s [NontDependencyInformationM s]
undoTransitiveClosure ndis = do edgesl <- mapM (\ndi -> graphEdges (ndgmDepGraph $ ndimDepGraph ndi)) ndis
                                let edges = concat edgesl
                                forM ndis $ \ndi -> do
                                  prods <- mapM (mkProdDependencyGraphM False) (ndiProds $ ndimOrig ndi)
                                  forM_ (zip prods (ndimProds ndi)) $ \(nprod,oprod) -> do
                                    -- All possible edges
                                    let possa = do (v1,v2) <- edges
                                                   -- Take a child of this nonterminal type
                                                   guard $ isVertexAttr v1
                                                   guard $ isVertexAttr v2
                                                   let tp = getAttrChildName v1
                                                   (ch,chtp) <- pdgChildMap $ pdgmOrig nprod
                                                   guard $ tp == chtp
                                                   -- Construct edge as it should be in the production graph
                                                   let nv1 = setAttrChildName v1 ch
                                                   let nv2 = setAttrChildName v2 ch
                                                   return (nv1, nv2)
                                    toadd <- filterM (graphContainsEdge (pdgmDepGraph oprod)) possa
                                    graphInsertEdges (pdgmDepGraph nprod) toadd
                                  return $ NontDependencyInformationM { ndimOrig     = ndimOrig ndi
                                                                      , ndimDepGraph = ndimDepGraph ndi
                                                                      , ndimProds    = 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 ndis = do -- Create initial list of pending edges for each ndi per production (initially all prod edges)
--               pndis :: [([[Edge]], NontDependencyInformation)]
                 pndis <- forM ndis $ \ndi -> do
                   ipend <- mapM (graphEdges . pdgmDepGraph) . ndimProds $ ndi
                   return (ipend, ndi)
                 knuth1' pndis

-- | Helper function for |knuth1| which repeats the process until we are done
knuth1' :: [([[Edge]], NontDependencyInformationM s)] -> ST s ()
knuth1' ndis = do -- Add edges from the production graphs to the nonterminal graph
--                ndis' :: [[Edge]]
                  ndis' <- mapM addProdNont ndis
                  -- List of all newly added edges
--                ntedge :: [Edge]
                  let pntedge = concat ndis'
                  -- Add backedges
                  --bedges <- addBackEdges ndis
                  -- All added nonterminal edges
                  let ntedge = pntedge -- ++ bedges
                  if null ntedge
                    -- When no new edges have been added we are done
                    then return ()
                    else do -- Otherwise, the next step is to add edges from nonterminal to production graphs
--                          ndis'' :: [[[Edge]]]
                            ndis'' <- mapM (\(_,x) -> addNontProd True (ntedge, x)) ndis
                            -- List of new states (production edges + dependency graphs)
--                          nndis' :: [([[Edge]], NontDependencyInformation)]
                            nndis' <- zipWithM (\(_,ndi) me -> return (me, ndi)) ndis ndis''
                            if any (not . null) ndis''
                               -- We have added some edges, so continue the process
                              then knuth1' nndis'
                              -- No new edges added, we are done
                              else 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 (pending, ndi) = do -- Unwrapping of the records
                                let nontDepGraph = ndimDepGraph ndi
                                let nontGraph = ndgmDepGraph nontDepGraph
                                -- nub the list because multiple productions can result in the same new edges
                                let possa = nub $ do (v1,v2) <- concat pending
                                                     -- Take only edges from syn.lhs to inh.lhs
                                                     guard $ isVertexAttr v1
                                                     guard $ getAttrChildName v1 == _LHS
                                                     guard $ getAttrType      v1 ==  Syn
                                                     guard $ isVertexAttr v2
                                                     guard $ getAttrChildName v2 == _LHS
                                                     guard $ getAttrType      v2 ==  Inh
                                                     -- Construct edge as it should be in nonterminal graph
                                                     let nv1 = setAttrChildName v1 (ndiNonterminal $ ndimOrig ndi)
                                                     let nv2 = setAttrChildName v2 (ndiNonterminal $ ndimOrig ndi)
                                                     return (nv1, nv2)
                                -- Edges that are not in the nonterminal graph yet
                                toadd <- filterM (\e -> return not `ap` graphContainsEdge nontGraph e) possa
                                -- Check whether new edges are to be added and return the added edges
                                when (not $ null toadd) $ do
                                   graphInsertEdgesTRC nontGraph toadd
                                   return ()
                                return 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 trc (pending, ndi) = do -- Just call the helper function for each nonterminal
                                    mapM (addNontProd' trc pending) (ndimProds ndi)

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

-- | Add the "back edges" to the nonterminal graphs for creating a global ordering
addBackEdges :: [([[Edge]], NontDependencyInformationM s)] -> ST s [Edge]
addBackEdges ndis = do -- gather all backedges
                       lBackEdges <- forM ndis $ \(aedg,ndi) -> do
                         -- For every production
                         bs <- forM (zip aedg (ndimProds ndi)) $ \(edg,prod) -> do
                           -- Filter out the backedges
                           return $ do (v1,v2) <- edg
                                       -- Backedges are from inh.ch to syn.ch
                                       guard $ isVertexAttr v1
                                       guard $ getAttrChildName v1 /= _LHS
                                       guard $ getAttrType      v1 ==  Inh
                                       guard $ isVertexAttr v2
                                       guard $ getAttrChildName v2 /= _LHS
                                       guard $ getAttrType      v2 ==  Syn
                                       guard $ getAttrChildName v1 == getAttrChildName v2
                                       -- Find the correct child name
                                       (ch,chtp) <- pdgChildMap $ pdgmOrig prod
                                       let tp = getAttrChildName v1
                                       guard $ tp == ch
                                       -- Construct the edge as it should be in the nonterminal graph
                                       let nv1 = setAttrChildName v1 chtp
                                       let nv2 = setAttrChildName v2 chtp
                                       return (nv1, nv2)
                         return $ foldl' union [] bs
                       -- Concatenate all lists of backedges
                       let backedges = foldl' union [] lBackEdges
                       -- Add backedges to every nonterminal graph
                       ret <- forM ndis $ \(_,ndi) -> do
                         -- Find the backedges for this nonterminal
                         let nont = ndiNonterminal . ndimOrig $ ndi
                         let thisbe = filter ((==) nont . getAttrChildName . fst) backedges
                         -- Add them to the graph
                         graphInsertEdgesTRC (ndgmDepGraph . ndimDepGraph $ ndi) thisbe
                       return $ backedges ++ concat 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 pend pdg = do -- Unwrapping of the records
                              prodGraph <- return $ pdgmDepGraph pdg
                              -- Construct all possible new edges
                              let possa = do (v1,v2) <- pend
                                             -- Take a child of this nonterminal type
                                             guard $ isVertexAttr v1
                                             guard $ isVertexAttr v2
                                             let tp = getAttrChildName v1
                                             (ch,chtp) <- pdgChildMap $ pdgmOrig pdg
                                             guard $ tp == chtp
                                             -- Construct edge as it should be in the production graph
                                             let nv1 = setAttrChildName v1 ch
                                             let nv2 = setAttrChildName v2 ch
                                             return (nv1, nv2)
                              -- Edges that are not in the production graph yet
                              forM_ possa $ \(v1,v2) -> do e1 <- graphContainsEdge prodGraph (v1,v2)
                                                           e2 <- graphContainsEdge prodGraph (v2,v1)
                                                           when (not $ e1 || e2) $ do
                                                             graphInsertTRC prodGraph (v1,v2)
                                                             return ()