\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 :: forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge MMGraph s
graph ((Vertex
s,Vertex
t),[PathStep]
p)
 = do Map Vertex [PathStep]
m <- 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 (forall k a. Ord k => k -> Map k a -> Bool
Map.member Vertex
t Map Vertex [PathStep]
m)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray MMGraph s
graph Vertex
s (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Vertex
t [PathStep]
p Map Vertex [PathStep]
m))
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b 

hasEdge :: MMGraph s -> EdgePath -> ST s Bool
hasEdge :: forall s. MMGraph s -> EdgePath -> ST s Bool
hasEdge MMGraph s
graph ((Vertex
s,Vertex
t),[PathStep]
_)
 = do Map Vertex [PathStep]
m <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray MMGraph s
graph Vertex
s
      forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall s. 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 <- forall s. MMGraph s -> EdgePath -> ST s Bool
hasEdge Tds s
tdpN EdgePath
e                                      -- if it's not yet present
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b 
              (do  Map Vertex [PathStep]
rs <- 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 <- 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 forall a. a -> [a] -> [a]
:[ ((Vertex
r,Vertex
t),[PathStep]
erforall a. [a] -> [a] -> [a]
++[PathStep]
ee    ) | (Vertex
r,[PathStep]
er) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs ]
                               forall a. [a] -> [a] -> [a]
++ [ ((Vertex
s,Vertex
u),    [PathStep]
eeforall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
u,[PathStep]
eu) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                               forall a. [a] -> [a] -> [a]
++ [ ((Vertex
r,Vertex
u),[PathStep]
erforall a. [a] -> [a] -> [a]
++[PathStep]
eeforall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
r,[PathStep]
er) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs, (Vertex
u,[PathStep]
eu) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 :: forall s. 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 <- forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge Tds s
tdpN EdgePath
e                                  -- add it to the normal graph
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b                                               -- if it was a new edge
           (do  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 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 forall i e. Ix i => Array i e -> i -> e
! Vertex
t
                     nonlocal :: Bool
nonlocal = Vertex
u forall a. Eq a => a -> a -> Bool
/= -Vertex
1 Bool -> Bool -> Bool
&& Vertex
v forall a. Eq a => a -> a -> Bool
/= -Vertex
1
                     equalfield :: Bool
equalfield = CRule -> CRule -> Bool
isEqualField (Info -> Table CRule
ruleTable Info
info forall i e. Ix i => Array i e -> i -> e
! Vertex
s) (Info -> Table CRule
ruleTable Info
info forall i e. Ix i => Array i e -> i -> e
! Vertex
t)
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
nonlocal Bool -> Bool -> Bool
&& Bool
equalfield)               -- ...and when necessary...
                     (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 :: forall s. 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 <- forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge Tds s
tds EdgePath
e
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b
             (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 forall i e. Ix i => Array i e -> i -> e
! Vertex
u
                                          , Bool -> Bool
not (CRule -> Bool
getIsIn (Info -> Table CRule
ruleTable Info
info 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 forall i e. Ix i => Array i e -> i -> e
! Vertex
v
                                          , CRule -> Bool
getIsIn (Info -> Table CRule
ruleTable Info
info 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 forall i e. Ix i => Array i e -> i -> e
! Vertex
s) (Info -> Table CRule
ruleTable Info
info 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 :: forall s. 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 <- forall s. MMGraph s -> EdgePath -> ST s Bool
hasEdge MMGraph s
tdpT ((Vertex
t,Vertex
s),forall a. HasCallStack => a
undefined)
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (do  Map Vertex [PathStep]
rs <- 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 <- 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 forall a. a -> [a] -> [a]
:[ ((Vertex
r,Vertex
t),[PathStep]
erforall a. [a] -> [a] -> [a]
++[PathStep]
ee    ) | (Vertex
r,[PathStep]
er) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs ]
                                 forall a. [a] -> [a] -> [a]
++ [ ((Vertex
s,Vertex
u),    [PathStep]
eeforall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
u,[PathStep]
eu) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                                 forall a. [a] -> [a] -> [a]
++ [ ((Vertex
r,Vertex
u),[PathStep]
erforall a. [a] -> [a] -> [a]
++[PathStep]
eeforall a. [a] -> [a] -> [a]
++[PathStep]
eu) | (Vertex
r,[PathStep]
er) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
rs, (Vertex
u,[PathStep]
eu) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex [PathStep]
us ]
                     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. Tdp s -> EdgePath -> ST s ()
addSimpleEdge Tdp s
tdp) [EdgePath]
edges
                )

addSimpleEdge :: Tdp s -> EdgePath -> ST s ()
addSimpleEdge :: forall s. Tdp s -> EdgePath -> ST s ()
addSimpleEdge (MMGraph s
tdpN,MMGraph s
tdpT) e :: EdgePath
e@((Vertex
s,Vertex
t),[PathStep]
ee)
  = do Bool
b <- forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge MMGraph s
tdpN EdgePath
e
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (do forall s. MMGraph s -> EdgePath -> ST s Bool
addEdge MMGraph s
tdpT ((Vertex
t,Vertex
s),[PathStep]
ee)
                  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 = forall a. [a] -> [a]
reverse 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (T_Segment -> T_Segments -> T_Segments
sem_Segments_Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Vertex] -> [Vertex] -> T_Segment
sem_Segment_Segment) T_Segments
sem_Segments_Nil 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (T_Interface -> T_Interfaces -> T_Interfaces
sem_Interfaces_Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NontermIdent, [NontermIdent]), LMH) -> T_Interface
mkInter) T_Interfaces
sem_Interfaces_Nil (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 = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Table [Vertex]
graph forall i e. Ix i => Array i e -> i -> e
! Vertex
v 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 forall a. Ord a => a -> a -> Bool
> Vertex
h = [([],[])]
  | Bool
otherwise = let  syn :: [Vertex]
syn = forall a. (a -> Bool) -> [a] -> [a]
filter (Table [Vertex] -> [Vertex] -> Vertex -> Bool
isSink Table [Vertex]
tds [Vertex]
del) ([Vertex
m..Vertex
h] forall a. Eq a => [a] -> [a] -> [a]
\\ [Vertex]
del)
                     del' :: [Vertex]
del' = [Vertex]
del forall a. [a] -> [a] -> [a]
++ [Vertex]
syn
                     inh :: [Vertex]
inh = forall a. (a -> Bool) -> [a] -> [a]
filter (Table [Vertex] -> [Vertex] -> Vertex -> Bool
isSink Table [Vertex]
tds [Vertex]
del') ([Vertex
l..(Vertex
mforall a. Num a => a -> a -> a
-Vertex
1)] forall a. Eq a => [a] -> [a] -> [a]
\\ [Vertex]
del')
                     del'' :: [Vertex]
del'' = [Vertex]
del' 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  forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vertex]
inh Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vertex]
syn
                       then []
                       else ([Vertex]
inh,[Vertex]
syn) 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) <- forall k a. Map k a -> [(k, a)]
Map.toList (MGraph
tds forall i e. Ix i => Array i e -> i -> e
! Vertex
v)         -- find dependent attributes...
    , Vertex
l forall a. Ord a => a -> a -> Bool
<= Vertex
u, Vertex
u forall a. Ord a => a -> a -> Bool
< Vertex
m                          -- ...that are inherited...
    , let mbp2 :: Maybe [PathStep]
mbp2 = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
v (MGraph
tds forall i e. Ix i => Array i e -> i -> e
! Vertex
u)      -- ...and have a cycle back
    , forall a. Maybe a -> Bool
isJust Maybe [PathStep]
mbp2
    , let p2 :: [PathStep]
p2 = forall a. HasCallStack => Maybe a -> a
fromJust Maybe [PathStep]
mbp2
    ]

findLocCycles :: MGraph -> [EdgePath]
findLocCycles :: MGraph -> [EdgePath]
findLocCycles MGraph
tdp
  = let (Vertex
low, Vertex
high) = 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) <- forall k a. Map k a -> [(k, a)]
Map.toList (MGraph
tdp forall i e. Ix i => Array i e -> i -> e
! Vertex
u)
        , Vertex
vforall 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), forall a. HasCallStack => Maybe a -> a
fromJust Maybe [PathStep]
mbp)
    | (Vertex
i, Vertex
s) <- [Edge]
instToSynEdges
    , let mbp :: Maybe [PathStep]
mbp = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
i (MGraph
tdp forall i e. Ix i => Array i e -> i -> e
! Vertex
s)
    , 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Map k a -> [k]
Map.keys MGraph
tds)
         inhs :: Inh_IRoot
inhs = Inh_IRoot{ info_Inh_IRoot :: Info
info_Inh_IRoot = Info
info
                         , tdp_Inh_IRoot :: Table [Vertex]
tdp_Inh_IRoot  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
  = forall a b. (a, b) -> a
fst (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}.
Ord a =>
((a, b), [a]) -> ([[a]], Set a) -> ([[a]], Set a)
f ([],forall a. Set a
Set.empty) (forall a b. (a -> b) -> [a] -> [b]
map (MGraph -> EdgePath -> EdgeRoute
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) | 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]
pforall a. a -> [a] -> [a]
:[[a]]
paths, forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
syms (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
  = forall a b. (a, b) -> a
fst (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EdgeRoutes
-> ([EdgeRoutes], Set Vertex) -> ([EdgeRoutes], Set Vertex)
f ([],forall a. Set a
Set.empty) (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) | forall a. Ord a => a -> Set a -> Bool
Set.member Vertex
x Set Vertex
syms Bool -> Bool -> 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
eppforall a. a -> [a] -> [a]
:[EdgeRoutes]
paths, forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Vertex
syms (forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
tdp2tds ([Vertex]
p1forall a. [a] -> [a] -> [a]
++[Vertex]
p2))))
          tdp2tds :: Vertex -> Vertex
tdp2tds (-2) = -Vertex
2
          tdp2tds Vertex
v = Info -> Table Vertex
tdpToTds Info
info 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 -> EdgeRoute
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 = forall a. Eq a => [a] -> [a]
shortcut (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) = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
v (MGraph
tdsforall 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 = 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 :: forall a. Eq a => [a] -> [a]
shortcut []     = []
shortcut (a
x:[a]
xs) = a
x forall a. a -> [a] -> [a]
: forall a. Eq a => [a] -> [a]
shortcut (forall a. Eq a => a -> [a] -> [a]
removeBefore a
x [a]
xs)

removeBefore :: Eq a => a -> [a] -> [a]
removeBefore :: forall a. Eq a => a -> [a] -> [a]
removeBefore a
x [a]
ys = forall a. [a] -> [a]
reverse (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=a
x) (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 forall i e. Ix i => Array i e -> i -> e
! Vertex
s) Bool -> Bool -> Bool
&& CRule -> Bool
isLocal (Table CRule
rt 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 a. (forall s. ST s a) -> a
runST
    (do let bigBounds :: Edge
bigBounds   = forall i e. Array i e -> (i, i)
bounds (Info -> Table Vertex
tdpToTds Info
info)
            smallBounds :: Edge
smallBounds = forall i e. Array i e -> (i, i)
bounds (Info -> Table [Vertex]
tdsToTdp Info
info)
            ([EdgePath]
ll,[EdgePath]
es) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Table CRule -> EdgePath -> Bool
isLocLoc (Info -> Table CRule
ruleTable Info
info)) (forall a b. (a -> b) -> [a] -> [b]
map ((Vertex -> Vertex -> PathStep) -> Edge -> EdgePath
singleStep Vertex -> Vertex -> PathStep
AtOcStep) ([Edge]
dpr forall a. [a] -> [a] -> [a]
++ [Edge]
instToSynEdges))
        STArray s Vertex (Map Vertex [PathStep])
tds  <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray Edge
smallBounds forall k a. Map k a
Map.empty
        STArray s Vertex (Map Vertex [PathStep])
tdpN <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray Edge
bigBounds   forall k a. Map k a
Map.empty
        STArray s Vertex (Map Vertex [PathStep])
tdpT <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray Edge
bigBounds   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)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 <- 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePath]
cyc1)                                                                -- are they cyclic?
            then do forall (m :: * -> *) a. Monad m => a -> m a
return ([[Vertex]] -> CycleStatus
LocalCycle (MGraph -> [EdgePath] -> [[Vertex]]
reportLocalCycle forall a. HasCallStack => a
undefined [EdgePath]
cyc1))                  -- then report an error.
            else do  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 <- 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePaths]
cyc2)                                                   -- are they cyclic?
                         then do  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 <- 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePath]
cyc4)
                                      then do 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
                                              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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) (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 <- 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePaths]
cyc3)                                      -- are they cyclic?
                                                  then 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 <- 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdgePath]
cyc5)
                                                              then do 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 forall (m :: * -> *) a. Monad m => a -> m a
return (CInterfaceMap -> CVisitsMap -> CycleStatus
CycleFree CInterfaceMap
cim CVisitsMap
cvm)                      -- otherwise we succeed.
    )
\end{code}


\end{document}