\begin{code}
module SequentialComputation (computeSequential,Vertex,Edge,Table) where
import SequentialTypes
import InterfacesRules
import CodeSyntax
import GrammarInfo

import Control.Monad(when,unless)
import Control.Monad.ST(ST, runST)
import Data.Array(Array,(!),bounds)
import Data.Array.ST(STArray, newArray, readArray, writeArray, freeze)
import Data.Maybe(isJust,fromJust)
import Data.List(partition,(\\))
import qualified Data.Set as Set
import qualified Data.Map as Map

\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Collecting information}

In the Data.Graph library,
a graph is represented as |Array Vertex [Vertex]|,
mapping each vertex to a list of adjacent vertices.
A |Vertex| is simply encoded by an |Int|.
So to test whether an edge |(x,y)| belongs to |g|
we can evaluate |y `elem` g!x|

For more efficiency, we use Maps instead of lists.
Sets would also have done, but we also want to each edge to have a path as a witness.

Moreover, as we will mostly be adding edges to the graph,
we use a mutable array.
If we want to use any of the library
functions, we can convert our representation by |fmap Map.keys . freeze|.

\begin{code}
type Graph     = Array     Vertex [Vertex]
type MGraph    = Array     Vertex (Map.Map Vertex Path)
type MMGraph s = STArray s Vertex (Map.Map Vertex Path)

singleStep :: (Vertex->Vertex->PathStep) -> Edge -> EdgePath
singleStep :: (Vertex -> Vertex -> PathStep) -> Edge -> EdgePath
singleStep Vertex -> Vertex -> PathStep
f e :: Edge
e@(Vertex
s,Vertex
t) = (Edge
e, [Vertex -> Vertex -> PathStep
f Vertex
s Vertex
t])

\end{code}

We can add an edge to a graph, or remove it. These functions return
whether they did something (resp. addition or removal) or not. hasEdge
only checks whether a graph contains an edge or not.

\begin{code}
addEdge :: MMGraph s -> EdgePath -> ST s Bool
addEdge :: MMGraph s -> EdgePath -> ST s Bool
addEdge MMGraph s
graph ((Vertex
s,Vertex
t),[PathStep]
p)
 = do Map Vertex [PathStep]
m <- MMGraph s -> Vertex -> ST s (Map Vertex [PathStep])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray MMGraph s
graph Vertex
s
      let b :: Bool
b = Bool -> Bool
not (Vertex -> Map Vertex [PathStep] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Vertex
t Map Vertex [PathStep]
m)
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (MMGraph s -> Vertex -> Map Vertex [PathStep] -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray MMGraph s
graph Vertex
s (Vertex
-> [PathStep] -> Map Vertex [PathStep] -> Map Vertex [PathStep]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Vertex
t [PathStep]
p Map Vertex [PathStep]
m))
      Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b 

hasEdge :: MMGraph s -> EdgePath -> ST s Bool
hasEdge :: MMGraph s -> EdgePath -> ST s Bool
hasEdge MMGraph s
graph ((Vertex
s,Vertex
t),[PathStep]
_)
 = do Map Vertex [PathStep]
m <- MMGraph s -> Vertex -> ST s (Map Vertex [PathStep])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray MMGraph s
graph Vertex
s
      Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Vertex -> Map Vertex [PathStep] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Vertex
t Map Vertex [PathStep]
m)
\end{code}

The first step is to assign a number to all attributes, and a
different one to all attribute occurrences. We create an array mapping
the numbers to the information about the attribute occurrences
(|ruleTable|), so we can look up this information in $O(1)$ time. We
also build mappings from attributes to their occurrences (|tdsToTdp|)
and vice versa (|tdpToTds|). |LMH| indicates the division of the
attributes - an element |(l,m,h) `elem` LMH| means that vertices |i, l
<= i <= h| are attributes of the same nonterminal, with vertices |j, l
<= j < m| being inherited and |k, m <= k <= h| being synthesized
attributes.

See the |SequentialTypes.Info| and |SequentialTypes.LMH|

Then we collect the direct dependencies, using the integer
representations. This list of tuples (edges in the dependency graph)
all information that is collected is passed to a function that will
compute the interfaces and visit sub-sequences. We cannot do this
computation in AG, because mutable arrays require the ST monad, which
cannot be used inside AG.

Now we can build a graph for attributes, and a graph for ao's, and add
the direct dependencies to the ao graph. Like Pennings we will call
the attribte graph Tds (transitive dependencies of symbols), and the
ao-graph Tdp (transitive dependencies of productions). Unlike him, we
will have only one Tds and one Tdp graph. In |STGraph|, we can lookup
outgoing edges in |O(1)| time, but looking up incoming edges will take
|O(e)| time, where |e| is the number of edges in the graph. As we will
be doing this quite often it is worthwhile to keep both Tdp and its
transposed version. The computation will involve both Tds and Tdp. It
treats specially. TODO elaborate on that.

\begin{code}
type Tdp s = (MMGraph s, MMGraph s)
type Tds s = MMGraph s
type Comp s = (Tds s, Tdp s)
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Generating IDS}

As we insert edges into Tdp we keep it transitively closed, so every
time we add the edge $(s,t)$ to V, we also add the edges
$\{ (r,t) || (r,s) \in V \}$ and
$\{ (s,u) || (t,u) \in V \}$.

\begin{code}
insertTdp :: Info -> Comp s -> EdgePath -> ST s ()
insertTdp :: Info -> Comp s -> EdgePath -> ST s ()
insertTdp Info
info comp :: Comp s
comp@(Tds s
_,(Tds s
tdpN,Tds s
tdpT)) e :: EdgePath
e@((Vertex
s,Vertex
t),[PathStep]
ee)                -- how to insert an edge (s,t):
  = do Bool
b <- Tds s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
hasEdge Tds s
tdpN EdgePath
e                                      -- if it's not yet present
       Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b 
              (do  Map Vertex [PathStep]
rs <- Tds s -> Vertex -> ST s (Map Vertex [PathStep])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Tds s
tdpT Vertex
s                       -- find all sources r for an edge to s
                   Map Vertex [PathStep]
us <- Tds s -> Vertex -> ST s (Map Vertex [PathStep])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Tds s
tdpN Vertex
t                       -- find all targets u for an edge from t
                   let edges :: [EdgePath]
edges = EdgePath
e EdgePath -> [EdgePath] -> [EdgePath]
forall a. a -> [a] -> [a]
:[ ((Vertex
r,Vertex
t),[PathStep]
er[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
ee    ) | (Vertex
r,[PathStep]
er) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs ]
                               [EdgePath] -> [EdgePath] -> [EdgePath]
forall a. [a] -> [a] -> [a]
++ [ ((Vertex
s,Vertex
u),    [PathStep]
ee[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
u,[PathStep]
eu) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                               [EdgePath] -> [EdgePath] -> [EdgePath]
forall a. [a] -> [a] -> [a]
++ [ ((Vertex
r,Vertex
u),[PathStep]
er[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
ee[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
r,[PathStep]
er) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs, (Vertex
u,[PathStep]
eu) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                   (EdgePath -> ST s ()) -> [EdgePath] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Info -> Comp s -> EdgePath -> ST s ()
forall s. Info -> Comp s -> EdgePath -> ST s ()
addTdpEdge Info
info Comp s
comp) [EdgePath]
edges           -- and add all of them, without having to bother about transitive closure anymore
              )
\end{code}

Edges in |Tdp| can induce edges in |Tds|, so whenever we add
an edge, we also add the induced edge if necessary

\begin{code}
addTdpEdge :: Info -> Comp s -> EdgePath -> ST s ()         -- how to add an edge (s,t) when not having to bother about the transitive closure:
addTdpEdge :: Info -> Comp s -> EdgePath -> ST s ()
addTdpEdge Info
info comp :: Comp s
comp@(Tds s
_,(Tds s
tdpN,Tds s
tdpT)) e :: EdgePath
e@((Vertex
s,Vertex
t),[PathStep]
ee)
  = do Bool
b <- Tds s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge Tds s
tdpN EdgePath
e                                  -- add it to the normal graph
       Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b                                               -- if it was a new edge
           (do  Tds s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge Tds s
tdpT ((Vertex
t,Vertex
s),[PathStep]
ee)                     --   also add it to the transposed graph
                let  u :: Vertex
u = Info -> Table Vertex
tdpToTds Info
info Table Vertex -> Vertex -> Vertex
forall i e. Ix i => Array i e -> i -> e
! Vertex
s                  --   find the corresponding attributes...
                     v :: Vertex
v = Info -> Table Vertex
tdpToTds Info
info Table Vertex -> Vertex -> Vertex
forall i e. Ix i => Array i e -> i -> e
! Vertex
t
                     nonlocal :: Bool
nonlocal = Vertex
u Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= -Vertex
1 Bool -> Bool -> Bool
&& Vertex
v Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= -Vertex
1
                     equalfield :: Bool
equalfield = CRule -> CRule -> Bool
isEqualField (Info -> Table CRule
ruleTable Info
info Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
s) (Info -> Table CRule
ruleTable Info
info Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
t)
                Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
nonlocal Bool -> Bool -> Bool
&& Bool
equalfield)               -- ...and when necessary...
                     (Info -> Comp s -> EdgePath -> ST s ()
forall s. Info -> Comp s -> EdgePath -> ST s ()
insertTds Info
info Comp s
comp ((Vertex
u,Vertex
v),[PathStep]
ee))       -- ...insert it to the Tds graph
           )
\end{code}

Inserting edges into |Tds| will insert edges between the occurrences
of the attributes into |Tdp|.

\begin{code}
insertTds :: Info -> Comp s -> EdgePath -> ST s ()
insertTds :: Info -> Comp s -> EdgePath -> ST s ()
insertTds Info
info comp :: Comp s
comp@(Tds s
tds,Tdp s
_) e :: EdgePath
e@((Vertex
u,Vertex
v),[PathStep]
ee)
  =  do Bool
b <- Tds s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge Tds s
tds EdgePath
e
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b
             ((EdgePath -> ST s ()) -> [EdgePath] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Info -> Comp s -> EdgePath -> ST s ()
forall s. Info -> Comp s -> EdgePath -> ST s ()
insertTdp Info
info Comp s
comp) [ ( (Vertex
s,Vertex
t), [Vertex -> Vertex -> PathStep
AttrStep Vertex
u Vertex
v] )
                                          | Vertex
s <- Info -> Table [Vertex]
tdsToTdp Info
info Table [Vertex] -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
u
                                          , Bool -> Bool
not (CRule -> Bool
getIsIn (Info -> Table CRule
ruleTable Info
info Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
s))    -- inherited at LHS, or synthesized at RHS
                                          , Vertex
t <- Info -> Table [Vertex]
tdsToTdp Info
info Table [Vertex] -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v
                                          , CRule -> Bool
getIsIn (Info -> Table CRule
ruleTable Info
info Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
t)          -- synthesized at LHS, or inherited at RHS
                                          , CRule -> CRule -> Bool
isEqualField (Info -> Table CRule
ruleTable Info
info Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
s) (Info -> Table CRule
ruleTable Info
info Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
t)
                                          ]
             )

\end{code}

If we add the direct dependencies to the Tdp graph in the way above, the
Tds graph is filled with IDS.
Below is a way to only build up the Tdp graph, without reflect the changes in the Tds graph.

\begin{code}
simpleInsert :: Tdp s -> EdgePath -> ST s ()
simpleInsert :: Tdp s -> EdgePath -> ST s ()
simpleInsert tdp :: Tdp s
tdp@(MMGraph s
tdpN,MMGraph s
tdpT) e :: EdgePath
e@((Vertex
s,Vertex
t),[PathStep]
ee)
  = do Bool
b <- MMGraph s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
hasEdge MMGraph s
tdpT ((Vertex
t,Vertex
s),[PathStep]
forall a. HasCallStack => a
undefined)
       Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (do  Map Vertex [PathStep]
rs <- MMGraph s -> Vertex -> ST s (Map Vertex [PathStep])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray MMGraph s
tdpT Vertex
s
                     Map Vertex [PathStep]
us <- MMGraph s -> Vertex -> ST s (Map Vertex [PathStep])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray MMGraph s
tdpN Vertex
t
                     let edges :: [EdgePath]
edges = EdgePath
e EdgePath -> [EdgePath] -> [EdgePath]
forall a. a -> [a] -> [a]
:[ ((Vertex
r,Vertex
t),[PathStep]
er[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
ee    ) | (Vertex
r,[PathStep]
er) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs ]
                                 [EdgePath] -> [EdgePath] -> [EdgePath]
forall a. [a] -> [a] -> [a]
++ [ ((Vertex
s,Vertex
u),    [PathStep]
ee[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
u,[PathStep]
eu) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                                 [EdgePath] -> [EdgePath] -> [EdgePath]
forall a. [a] -> [a] -> [a]
++ [ ((Vertex
r,Vertex
u),[PathStep]
er[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
ee[PathStep] -> [PathStep] -> [PathStep]
forall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
r,[PathStep]
er) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs, (Vertex
u,[PathStep]
eu) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                     (EdgePath -> ST s ()) -> [EdgePath] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Tdp s -> EdgePath -> ST s ()
forall s. Tdp s -> EdgePath -> ST s ()
addSimpleEdge Tdp s
tdp) [EdgePath]
edges
                )

addSimpleEdge :: Tdp s -> EdgePath -> ST s ()
addSimpleEdge :: Tdp s -> EdgePath -> ST s ()
addSimpleEdge (MMGraph s
tdpN,MMGraph s
tdpT) e :: EdgePath
e@((Vertex
s,Vertex
t),[PathStep]
ee)
  = do Bool
b <- MMGraph s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge MMGraph s
tdpN EdgePath
e
       Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (do MMGraph s -> EdgePath -> ST s Bool
forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge MMGraph s
tdpT ((Vertex
t,Vertex
s),[PathStep]
ee)
                  () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              )
\end{code}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Interfaces}

In absence of cycles we can find the interfaces. We only take
attributes that are used.

When an attribute has no incoming edges it can be computed. As the
emphasis is on incoming edges, we will work with the transposed Tds
graph. The funtion |used| indicates which vertices are included in the
interfaces.

See modules Interfaces and InterfacesRules for more information.

%format sem_IRoot_IRoot = "sem_{IRoot}"
%format sem_Interface_Interface = "sem_{Interface}"
%format sem_Interfaces_Cons = ":_{Interfaces}"
%format sem_Interfaces_Nil = "[]_{Interfaces}"
%format sem_Segments_Cons = ":_{Segments}"
%format sem_Segments_Nil = "[]_{Segments}"

\begin{code}
makeInterfaces :: Info -> Graph -> T_IRoot
makeInterfaces :: Info -> Table [Vertex] -> T_IRoot
makeInterfaces Info
info Table [Vertex]
tds
  =  let interslist :: LMH -> [([Vertex], [Vertex])]
interslist = [([Vertex], [Vertex])] -> [([Vertex], [Vertex])]
forall a. [a] -> [a]
reverse ([([Vertex], [Vertex])] -> [([Vertex], [Vertex])])
-> (LMH -> [([Vertex], [Vertex])]) -> LMH -> [([Vertex], [Vertex])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table [Vertex] -> [Vertex] -> LMH -> [([Vertex], [Vertex])]
makeInterface Table [Vertex]
tds []
         mkSegments :: LMH -> T_Segments
mkSegments = (([Vertex], [Vertex]) -> T_Segments -> T_Segments)
-> T_Segments -> [([Vertex], [Vertex])] -> T_Segments
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (T_Segment -> T_Segments -> T_Segments
sem_Segments_Cons (T_Segment -> T_Segments -> T_Segments)
-> (([Vertex], [Vertex]) -> T_Segment)
-> ([Vertex], [Vertex])
-> T_Segments
-> T_Segments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Vertex] -> [Vertex] -> T_Segment)
-> ([Vertex], [Vertex]) -> T_Segment
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Vertex] -> [Vertex] -> T_Segment
sem_Segment_Segment) T_Segments
sem_Segments_Nil ([([Vertex], [Vertex])] -> T_Segments)
-> (LMH -> [([Vertex], [Vertex])]) -> LMH -> T_Segments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMH -> [([Vertex], [Vertex])]
interslist
         mkInter :: ((NontermIdent, [NontermIdent]), LMH) -> T_Interface
mkInter ((NontermIdent
nt,[NontermIdent]
cons),LMH
lmh) = NontermIdent -> [NontermIdent] -> T_Segments -> T_Interface
sem_Interface_Interface NontermIdent
nt [NontermIdent]
cons (LMH -> T_Segments
mkSegments LMH
lmh)
         inters :: T_Interfaces
inters = (((NontermIdent, [NontermIdent]), LMH)
 -> T_Interfaces -> T_Interfaces)
-> T_Interfaces
-> [((NontermIdent, [NontermIdent]), LMH)]
-> T_Interfaces
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (T_Interface -> T_Interfaces -> T_Interfaces
sem_Interfaces_Cons (T_Interface -> T_Interfaces -> T_Interfaces)
-> (((NontermIdent, [NontermIdent]), LMH) -> T_Interface)
-> ((NontermIdent, [NontermIdent]), LMH)
-> T_Interfaces
-> T_Interfaces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NontermIdent, [NontermIdent]), LMH) -> T_Interface
mkInter) T_Interfaces
sem_Interfaces_Nil ([(NontermIdent, [NontermIdent])]
-> [LMH] -> [((NontermIdent, [NontermIdent]), LMH)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Info -> [(NontermIdent, [NontermIdent])]
nonts Info
info) (Info -> [LMH]
lmh Info
info))
     in T_Interfaces -> T_IRoot
sem_IRoot_IRoot T_Interfaces
inters
\end{code}

The sinks of a graph are those vertices that have no outgoing
edges. We define a function that determines whether a vertex is a sink
if a set |del| of vertices had been removed from the graph. This means
that the attribute can be computed if all attributes in |del| have
been computed.

\begin{code}
isSink :: Graph -> [Vertex] -> Vertex -> Bool
isSink :: Table [Vertex] -> [Vertex] -> Vertex -> Bool
isSink Table [Vertex]
graph [Vertex]
del Vertex
v = [Vertex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Table [Vertex]
graph Table [Vertex] -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Vertex]
del)
\end{code}

Now we can make interfaces by taking inherited sinks and synthesized
sinks alternatively. If there are no synthesized attributes at all,
generate an interface with one visit computing nothing.

\begin{code}
makeInterface :: Graph -> [Vertex] -> LMH -> [([Vertex],[Vertex])]
makeInterface :: Table [Vertex] -> [Vertex] -> LMH -> [([Vertex], [Vertex])]
makeInterface Table [Vertex]
tds [Vertex]
del (Vertex
l,Vertex
m,Vertex
h)
  | Vertex
m Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
> Vertex
h = [([],[])]
  | Bool
otherwise = let  syn :: [Vertex]
syn = (Vertex -> Bool) -> [Vertex] -> [Vertex]
forall a. (a -> Bool) -> [a] -> [a]
filter (Table [Vertex] -> [Vertex] -> Vertex -> Bool
isSink Table [Vertex]
tds [Vertex]
del) ([Vertex
m..Vertex
h] [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Vertex]
del)
                     del' :: [Vertex]
del' = [Vertex]
del [Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
++ [Vertex]
syn
                     inh :: [Vertex]
inh = (Vertex -> Bool) -> [Vertex] -> [Vertex]
forall a. (a -> Bool) -> [a] -> [a]
filter (Table [Vertex] -> [Vertex] -> Vertex -> Bool
isSink Table [Vertex]
tds [Vertex]
del') ([Vertex
l..(Vertex
mVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
-Vertex
1)] [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Vertex]
del')
                     del'' :: [Vertex]
del'' = [Vertex]
del' [Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
++ [Vertex]
inh
                     rest :: [([Vertex], [Vertex])]
rest = Table [Vertex] -> [Vertex] -> LMH -> [([Vertex], [Vertex])]
makeInterface Table [Vertex]
tds [Vertex]
del'' (Vertex
l,Vertex
m,Vertex
h)
                in if  [Vertex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vertex]
inh Bool -> Bool -> Bool
&& [Vertex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vertex]
syn
                       then []
                       else ([Vertex]
inh,[Vertex]
syn) ([Vertex], [Vertex])
-> [([Vertex], [Vertex])] -> [([Vertex], [Vertex])]
forall a. a -> [a] -> [a]
: [([Vertex], [Vertex])]
rest
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Detecting of cycles}

We only want to return s2i edges.

\begin{code}
findCycles :: Info -> MGraph -> [EdgePaths]
findCycles :: Info -> MGraph -> [EdgePaths]
findCycles Info
info MGraph
tds
  = [ ((Vertex
u,Vertex
v),[PathStep]
p1,[PathStep]
p2)
    | (Vertex
l,Vertex
m,Vertex
h) <- Info -> [LMH]
lmh Info
info                    -- for every nonterminal: [l..m-1] are inherited, [m..h] are synthesized
    , Vertex
v <- [Vertex
m..Vertex
h]                            -- for every synthesized attribute
    , (Vertex
u,[PathStep]
p1) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList (MGraph
tds MGraph -> Vertex -> Map Vertex [PathStep]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v)         -- find dependent attributes...
    , Vertex
l Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<= Vertex
u, Vertex
u Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
m                          -- ...that are inherited...
    , let mbp2 :: Maybe [PathStep]
mbp2 = Vertex -> Map Vertex [PathStep] -> Maybe [PathStep]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
v (MGraph
tds MGraph -> Vertex -> Map Vertex [PathStep]
forall i e. Ix i => Array i e -> i -> e
! Vertex
u)      -- ...and have a cycle back
    , Maybe [PathStep] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [PathStep]
mbp2
    , let p2 :: [PathStep]
p2 = Maybe [PathStep] -> [PathStep]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [PathStep]
mbp2
    ]

findLocCycles :: MGraph -> [EdgePath]
findLocCycles :: MGraph -> [EdgePath]
findLocCycles MGraph
tdp
  = let (Vertex
low, Vertex
high) = MGraph -> Edge
forall i e. Array i e -> (i, i)
bounds MGraph
tdp
    in  [ ((Vertex
u,Vertex
u),[PathStep]
p)
        | Vertex
u <- [Vertex
low..Vertex
high]
        , (Vertex
v,[PathStep]
p) <- Map Vertex [PathStep] -> [(Vertex, [PathStep])]
forall k a. Map k a -> [(k, a)]
Map.toList (MGraph
tdp MGraph -> Vertex -> Map Vertex [PathStep]
forall i e. Ix i => Array i e -> i -> e
! Vertex
u)
        , Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
u
        ]

findInstCycles :: [Edge] -> MGraph -> [EdgePath]
findInstCycles :: [Edge] -> MGraph -> [EdgePath]
findInstCycles [Edge]
instToSynEdges MGraph
tdp
  = [ ((Vertex
i,Vertex
s), Maybe [PathStep] -> [PathStep]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [PathStep]
mbp)
    | (Vertex
i, Vertex
s) <- [Edge]
instToSynEdges
    , let mbp :: Maybe [PathStep]
mbp = Vertex -> Map Vertex [PathStep] -> Maybe [PathStep]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
i (MGraph
tdp MGraph -> Vertex -> Map Vertex [PathStep]
forall i e. Ix i => Array i e -> i -> e
! Vertex
s)
    , Maybe [PathStep] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [PathStep]
mbp
    ]
\end{code}



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Tying it together}

\begin{code}
generateVisits :: Info -> MGraph -> MGraph -> [Edge] -> (CInterfaceMap, CVisitsMap, [Edge])
generateVisits :: Info
-> MGraph
-> MGraph
-> [Edge]
-> (CInterfaceMap, CVisitsMap, [Edge])
generateVisits Info
info MGraph
tds MGraph
tdp [Edge]
dpr
  = let  inters :: T_IRoot
inters = Info -> Table [Vertex] -> T_IRoot
makeInterfaces Info
info ((Map Vertex [PathStep] -> [Vertex]) -> MGraph -> Table [Vertex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Vertex [PathStep] -> [Vertex]
forall k a. Map k a -> [k]
Map.keys MGraph
tds)
         inhs :: Inh_IRoot
inhs = Inh_IRoot :: [Edge] -> Info -> Table [Vertex] -> Inh_IRoot
Inh_IRoot{ info_Inh_IRoot :: Info
info_Inh_IRoot = Info
info
                         , tdp_Inh_IRoot :: Table [Vertex]
tdp_Inh_IRoot  = (Map Vertex [PathStep] -> [Vertex]) -> MGraph -> Table [Vertex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Vertex [PathStep] -> [Vertex]
forall k a. Map k a -> [k]
Map.keys MGraph
tdp
                         , dpr_Inh_IRoot :: [Edge]
dpr_Inh_IRoot  = [Edge]
dpr
                         }
         iroot :: Syn_IRoot
iroot = T_IRoot -> Inh_IRoot -> Syn_IRoot
wrap_IRoot T_IRoot
inters Inh_IRoot
inhs
    in (Syn_IRoot -> CInterfaceMap
inters_Syn_IRoot Syn_IRoot
iroot, Syn_IRoot -> CVisitsMap
visits_Syn_IRoot Syn_IRoot
iroot, Syn_IRoot -> [Edge]
edp_Syn_IRoot Syn_IRoot
iroot)

reportLocalCycle :: MGraph -> [EdgePath] -> [[Vertex]]
reportLocalCycle :: MGraph -> [EdgePath] -> [[Vertex]]
reportLocalCycle MGraph
tds [EdgePath]
cyc
  = ([[Vertex]], Set Vertex) -> [[Vertex]]
forall a b. (a, b) -> a
fst (((Edge, [Vertex])
 -> ([[Vertex]], Set Vertex) -> ([[Vertex]], Set Vertex))
-> ([[Vertex]], Set Vertex)
-> [(Edge, [Vertex])]
-> ([[Vertex]], Set Vertex)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Edge, [Vertex])
-> ([[Vertex]], Set Vertex) -> ([[Vertex]], Set Vertex)
forall a b.
Ord a =>
((a, b), [a]) -> ([[a]], Set a) -> ([[a]], Set a)
f ([],Set Vertex
forall a. Set a
Set.empty) ((EdgePath -> (Edge, [Vertex])) -> [EdgePath] -> [(Edge, [Vertex])]
forall a b. (a -> b) -> [a] -> [b]
map (MGraph -> EdgePath -> (Edge, [Vertex])
edgePathToEdgeRoute MGraph
tds) [EdgePath]
cyc))
    where f :: ((a, b), [a]) -> ([[a]], Set a) -> ([[a]], Set a)
f ((a
x,b
_),[a]
p) res :: ([[a]], Set a)
res@([[a]]
paths,Set a
syms) | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
syms = ([[a]], Set a)
res    -- don't report a cyclic vertex if it appears on a path of an earlier reported one
                                       | Bool
otherwise         = ([a]
p[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
paths, Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
syms ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
p))

reportCycle :: Info -> MGraph -> [EdgePaths] -> [EdgeRoutes]
reportCycle :: Info -> MGraph -> [EdgePaths] -> [EdgeRoutes]
reportCycle Info
info MGraph
tds [EdgePaths]
cyc
  = ([EdgeRoutes], Set Vertex) -> [EdgeRoutes]
forall a b. (a, b) -> a
fst ((EdgeRoutes
 -> ([EdgeRoutes], Set Vertex) -> ([EdgeRoutes], Set Vertex))
-> ([EdgeRoutes], Set Vertex)
-> [EdgeRoutes]
-> ([EdgeRoutes], Set Vertex)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EdgeRoutes
-> ([EdgeRoutes], Set Vertex) -> ([EdgeRoutes], Set Vertex)
f ([],Set Vertex
forall a. Set a
Set.empty) ((EdgePaths -> EdgeRoutes) -> [EdgePaths] -> [EdgeRoutes]
forall a b. (a -> b) -> [a] -> [b]
map (MGraph -> EdgePaths -> EdgeRoutes
edgePathsToEdgeRoutes MGraph
tds) [EdgePaths]
cyc))
    where f :: EdgeRoutes
-> ([EdgeRoutes], Set Vertex) -> ([EdgeRoutes], Set Vertex)
f epp :: EdgeRoutes
epp@((Vertex
x,Vertex
y),[Vertex]
p1,[Vertex]
p2) res :: ([EdgeRoutes], Set Vertex)
res@([EdgeRoutes]
paths,Set Vertex
syms) | Vertex -> Set Vertex -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Vertex
x Set Vertex
syms Bool -> Bool -> Bool
&& 
                                                 Vertex -> Set Vertex -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Vertex
y Set Vertex
syms    = ([EdgeRoutes], Set Vertex)
res    -- don't report mutually dependent vertices if both appear on paths reported earlier
                                               | Bool
otherwise            = (EdgeRoutes
eppEdgeRoutes -> [EdgeRoutes] -> [EdgeRoutes]
forall a. a -> [a] -> [a]
:[EdgeRoutes]
paths, Set Vertex -> Set Vertex -> Set Vertex
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Vertex
syms ([Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList ((Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
tdp2tds ([Vertex]
p1[Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
++[Vertex]
p2))))
          tdp2tds :: Vertex -> Vertex
tdp2tds (-2) = -Vertex
2
          tdp2tds Vertex
v = Info -> Table Vertex
tdpToTds Info
info Table Vertex -> Vertex -> Vertex
forall i e. Ix i => Array i e -> i -> e
! Vertex
v

edgePathsToEdgeRoutes :: MGraph -> EdgePaths -> EdgeRoutes
edgePathsToEdgeRoutes :: MGraph -> EdgePaths -> EdgeRoutes
edgePathsToEdgeRoutes MGraph
tds (Edge
e,[PathStep]
p1,[PathStep]
p2) = ( Edge
e, MGraph -> [PathStep] -> [Vertex]
pathToRoute MGraph
tds [PathStep]
p1, MGraph -> [PathStep] -> [Vertex]
pathToRoute MGraph
tds [PathStep]
p2 )

edgePathToEdgeRoute :: MGraph -> EdgePath -> EdgeRoute
edgePathToEdgeRoute :: MGraph -> EdgePath -> (Edge, [Vertex])
edgePathToEdgeRoute MGraph
tds (Edge
e,[PathStep]
p) = ( Edge
e, MGraph -> [PathStep] -> [Vertex]
pathToRoute MGraph
tds [PathStep]
p )

pathToRoute :: MGraph -> Path -> Route
pathToRoute :: MGraph -> [PathStep] -> [Vertex]
pathToRoute MGraph
tds [PathStep]
p = [PathStep] -> [Vertex]
convertPath ([PathStep] -> [PathStep]
expandAll [PathStep]
p)
 where expandAll :: Path -> Path
       expandAll :: [PathStep] -> [PathStep]
expandAll [PathStep]
p | [PathStep] -> Bool
hasAttrStep [PathStep]
p  = [PathStep] -> [PathStep]
expandAll ([PathStep] -> [PathStep]
expandOne [PathStep]
p)
                   | Bool
otherwise      = [PathStep]
p
       expandOne :: Path -> Path
       expandOne :: [PathStep] -> [PathStep]
expandOne [PathStep]
p = [PathStep] -> [PathStep]
forall a. Eq a => [a] -> [a]
shortcut ((PathStep -> [PathStep]) -> [PathStep] -> [PathStep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PathStep -> [PathStep]
expandStep [PathStep]
p)
       expandStep :: PathStep -> Path
       expandStep :: PathStep -> [PathStep]
expandStep (AttrStep Vertex
u Vertex
v) = Maybe [PathStep] -> [PathStep]
forall a. HasCallStack => Maybe a -> a
fromJust (Vertex -> Map Vertex [PathStep] -> Maybe [PathStep]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
v (MGraph
tdsMGraph -> Vertex -> Map Vertex [PathStep]
forall i e. Ix i => Array i e -> i -> e
!Vertex
u))
       expandStep PathStep
x              = [PathStep
x]
       convertPath :: Path -> Route
       convertPath :: [PathStep] -> [Vertex]
convertPath [PathStep]
p = (PathStep -> [Vertex]) -> [PathStep] -> [Vertex]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PathStep -> [Vertex]
convertStep [PathStep]
p
       convertStep :: PathStep -> Route
       convertStep :: PathStep -> [Vertex]
convertStep (AtOcStep Vertex
s Vertex
t) = [Vertex
s,Vertex
t]
       convertStep (AttrIndu Vertex
s Vertex
t) = [-Vertex
2,-Vertex
2]

hasAttrStep :: Path -> Bool
hasAttrStep :: [PathStep] -> Bool
hasAttrStep []                  = Bool
False
hasAttrStep (AttrStep Vertex
_ Vertex
_ : [PathStep]
_ ) = Bool
True
hasAttrStep (PathStep
_            : [PathStep]
xs) = [PathStep] -> Bool
hasAttrStep [PathStep]
xs     

shortcut :: Eq a => [a] -> [a]
shortcut :: [a] -> [a]
shortcut []     = []
shortcut (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. Eq a => [a] -> [a]
shortcut (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
removeBefore a
x [a]
xs)

removeBefore :: Eq a => a -> [a] -> [a]
removeBefore :: a -> [a] -> [a]
removeBefore a
x [a]
ys = [a] -> [a]
forall a. [a] -> [a]
reverse ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
x) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys))


isLocLoc :: Table CRule -> EdgePath -> Bool
isLocLoc :: Table CRule -> EdgePath -> Bool
isLocLoc Table CRule
rt ((Vertex
s,Vertex
t),[PathStep]
_) = CRule -> Bool
isLocal (Table CRule
rt Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
s) Bool -> Bool -> Bool
&& CRule -> Bool
isLocal (Table CRule
rt Table CRule -> Vertex -> CRule
forall i e. Ix i => Array i e -> i -> e
! Vertex
t)
                        --  || (isInst (rt ! s) && isInst (rt ! t))

computeSequential :: Info -> [Edge] -> [Edge] -> CycleStatus
computeSequential :: Info -> [Edge] -> [Edge] -> CycleStatus
computeSequential Info
info [Edge]
dpr [Edge]
instToSynEdges
  = (forall s. ST s CycleStatus) -> CycleStatus
forall a. (forall s. ST s a) -> a
runST
    (do let bigBounds :: Edge
bigBounds   = Table Vertex -> Edge
forall i e. Array i e -> (i, i)
bounds (Info -> Table Vertex
tdpToTds Info
info)
            smallBounds :: Edge
smallBounds = Table [Vertex] -> Edge
forall i e. Array i e -> (i, i)
bounds (Info -> Table [Vertex]
tdsToTdp Info
info)
            ([EdgePath]
ll,[EdgePath]
es) = (EdgePath -> Bool) -> [EdgePath] -> ([EdgePath], [EdgePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Table CRule -> EdgePath -> Bool
isLocLoc (Info -> Table CRule
ruleTable Info
info)) ((Edge -> EdgePath) -> [Edge] -> [EdgePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Vertex -> Vertex -> PathStep) -> Edge -> EdgePath
singleStep Vertex -> Vertex -> PathStep
AtOcStep) ([Edge]
dpr [Edge] -> [Edge] -> [Edge]
forall a. [a] -> [a] -> [a]
++ [Edge]
instToSynEdges))
        STArray s Vertex (Map Vertex [PathStep])
tds  <- Edge
-> Map Vertex [PathStep]
-> ST s (STArray s Vertex (Map Vertex [PathStep]))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray Edge
smallBounds Map Vertex [PathStep]
forall k a. Map k a
Map.empty
        STArray s Vertex (Map Vertex [PathStep])
tdpN <- Edge
-> Map Vertex [PathStep]
-> ST s (STArray s Vertex (Map Vertex [PathStep]))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray Edge
bigBounds   Map Vertex [PathStep]
forall k a. Map k a
Map.empty
        STArray s Vertex (Map Vertex [PathStep])
tdpT <- Edge
-> Map Vertex [PathStep]
-> ST s (STArray s Vertex (Map Vertex [PathStep]))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray Edge
bigBounds   Map Vertex [PathStep]
forall k a. Map k a
Map.empty
        let tdp :: (STArray s Vertex (Map Vertex [PathStep]),
 STArray s Vertex (Map Vertex [PathStep]))
tdp = (STArray s Vertex (Map Vertex [PathStep])
tdpN,STArray s Vertex (Map Vertex [PathStep])
tdpT)
            comp :: (STArray s Vertex (Map Vertex [PathStep]),
 (STArray s Vertex (Map Vertex [PathStep]),
  STArray s Vertex (Map Vertex [PathStep])))
comp = (STArray s Vertex (Map Vertex [PathStep])
tds,(STArray s Vertex (Map Vertex [PathStep]),
 STArray s Vertex (Map Vertex [PathStep]))
tdp)
        (EdgePath -> ST s ()) -> [EdgePath] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((STArray s Vertex (Map Vertex [PathStep]),
 STArray s Vertex (Map Vertex [PathStep]))
-> EdgePath -> ST s ()
forall s. Tdp s -> EdgePath -> ST s ()
simpleInsert (STArray s Vertex (Map Vertex [PathStep]),
 STArray s Vertex (Map Vertex [PathStep]))
tdp) [EdgePath]
ll                                                        -- insert the local dependencies
        MGraph
tdp1 <- STArray s Vertex (Map Vertex [PathStep]) -> ST s MGraph
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STArray s Vertex (Map Vertex [PathStep])
tdpN
        let cyc1 :: [EdgePath]
cyc1 = MGraph -> [EdgePath]
findLocCycles MGraph
tdp1
        if  Bool -> Bool
not ([EdgePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePath]
cyc1)                                                                -- are they cyclic?
            then do CycleStatus -> ST s CycleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Vertex]] -> CycleStatus
LocalCycle (MGraph -> [EdgePath] -> [[Vertex]]
reportLocalCycle MGraph
forall a. HasCallStack => a
undefined [EdgePath]
cyc1))                  -- then report an error.
            else do  (EdgePath -> ST s ()) -> [EdgePath] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Info
-> (STArray s Vertex (Map Vertex [PathStep]),
    (STArray s Vertex (Map Vertex [PathStep]),
     STArray s Vertex (Map Vertex [PathStep])))
-> EdgePath
-> ST s ()
forall s. Info -> Comp s -> EdgePath -> ST s ()
insertTdp Info
info (STArray s Vertex (Map Vertex [PathStep]),
 (STArray s Vertex (Map Vertex [PathStep]),
  STArray s Vertex (Map Vertex [PathStep])))
comp) [EdgePath]
es                                        -- insert the other dependencies
                     MGraph
tds2 <- STArray s Vertex (Map Vertex [PathStep]) -> ST s MGraph
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STArray s Vertex (Map Vertex [PathStep])
tds
                     let cyc2 :: [EdgePaths]
cyc2 = Info -> MGraph -> [EdgePaths]
findCycles Info
info MGraph
tds2
                     if  Bool -> Bool
not ([EdgePaths] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePaths]
cyc2)                                                   -- are they cyclic?
                         then do  CycleStatus -> ST s CycleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ([EdgeRoutes] -> CycleStatus
DirectCycle (Info -> MGraph -> [EdgePaths] -> [EdgeRoutes]
reportCycle Info
info MGraph
tds2 [EdgePaths]
cyc2))        -- then report an error.
                         else do  MGraph
tdp2 <- STArray s Vertex (Map Vertex [PathStep]) -> ST s MGraph
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STArray s Vertex (Map Vertex [PathStep])
tdpN
                                  let cyc4 :: [EdgePath]
cyc4 = [Edge] -> MGraph -> [EdgePath]
findInstCycles [Edge]
instToSynEdges MGraph
tdp2
                                  if  Bool -> Bool
not ([EdgePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePath]
cyc4)
                                      then do CycleStatus -> ST s CycleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Vertex]] -> CycleStatus
InstCycle (MGraph -> [EdgePath] -> [[Vertex]]
reportLocalCycle MGraph
tds2 [EdgePath]
cyc4))              -- then report an error.
                                      else do let  (CInterfaceMap
cim,CVisitsMap
cvm,[Edge]
edp) = Info
-> MGraph
-> MGraph
-> [Edge]
-> (CInterfaceMap, CVisitsMap, [Edge])
generateVisits Info
info MGraph
tds2 MGraph
tdp2 [Edge]
dpr
                                              (EdgePath -> ST s ()) -> [EdgePath] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Info
-> (STArray s Vertex (Map Vertex [PathStep]),
    (STArray s Vertex (Map Vertex [PathStep]),
     STArray s Vertex (Map Vertex [PathStep])))
-> EdgePath
-> ST s ()
forall s. Info -> Comp s -> EdgePath -> ST s ()
insertTds Info
info (STArray s Vertex (Map Vertex [PathStep]),
 (STArray s Vertex (Map Vertex [PathStep]),
  STArray s Vertex (Map Vertex [PathStep])))
comp) ((Edge -> EdgePath) -> [Edge] -> [EdgePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Vertex -> Vertex -> PathStep) -> Edge -> EdgePath
singleStep Vertex -> Vertex -> PathStep
AttrIndu) [Edge]
edp) -- insert dependencies induced by visit scheduling
                                              MGraph
tds3 <- STArray s Vertex (Map Vertex [PathStep]) -> ST s MGraph
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STArray s Vertex (Map Vertex [PathStep])
tds
                                              let cyc3 :: [EdgePaths]
cyc3 = Info -> MGraph -> [EdgePaths]
findCycles Info
info MGraph
tds3
                                              if  Bool -> Bool
not ([EdgePaths] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePaths]
cyc3)                                      -- are they cyclic?
                                                  then CycleStatus -> ST s CycleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (CInterfaceMap -> [EdgeRoutes] -> CycleStatus
InducedCycle CInterfaceMap
cim (Info -> MGraph -> [EdgePaths] -> [EdgeRoutes]
reportCycle Info
info MGraph
tds3 [EdgePaths]
cyc3)) -- then report an error.
                                                  else do MGraph
tdp3 <- STArray s Vertex (Map Vertex [PathStep]) -> ST s MGraph
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STArray s Vertex (Map Vertex [PathStep])
tdpN
                                                          let cyc5 :: [EdgePath]
cyc5 = [Edge] -> MGraph -> [EdgePath]
findInstCycles [Edge]
instToSynEdges MGraph
tdp3
                                                          if  Bool -> Bool
not ([EdgePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePath]
cyc5)
                                                              then do CycleStatus -> ST s CycleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Vertex]] -> CycleStatus
InstCycle (MGraph -> [EdgePath] -> [[Vertex]]
reportLocalCycle MGraph
tds3 [EdgePath]
cyc5))     -- then report an error.
                                                              else do CycleStatus -> ST s CycleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (CInterfaceMap -> CVisitsMap -> CycleStatus
CycleFree CInterfaceMap
cim CVisitsMap
cvm)                      -- otherwise we succeed.
    )
\end{code}


\end{document}