module LOAG.Common where
import qualified Data.Array as A
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Set as S
import qualified Data.Sequence as Seq
import Data.Maybe (isNothing)
import Data.STRef
import Data.Array.ST
import Data.List (intercalate, foldl', nub)
import CommonTypes
import Control.Arrow
import Control.Monad.ST
import Control.Monad (forM, when, forM_, forM_, foldM)
import LOAG.Graphs
data Ag = Ag (Int,Int)
(Int,Int)
[Edge]
[Nt]
data Nt = Nt String
[Edge]
[Edge]
[(Vertex,[Vertex],Direction)]
[(Vertex,[Vertex],Direction)]
[Pr]
deriving (Int -> Nt -> ShowS
[Nt] -> ShowS
Nt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nt] -> ShowS
$cshowList :: [Nt] -> ShowS
show :: Nt -> String
$cshow :: Nt -> String
showsPrec :: Int -> Nt -> ShowS
$cshowsPrec :: Int -> Nt -> ShowS
Show)
data Pr = Pr PLabel
[Edge]
[(Edge,Edge,Bool)]
[Fd]
deriving (Int -> Pr -> ShowS
[Pr] -> ShowS
Pr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pr] -> ShowS
$cshowList :: [Pr] -> ShowS
show :: Pr -> String
$cshow :: Pr -> String
showsPrec :: Int -> Pr -> ShowS
$cshowsPrec :: Int -> Pr -> ShowS
Show)
data Fd = Fd String
String
[(Vertex,Vertex)]
[(Vertex,Vertex)]
deriving (Int -> Fd -> ShowS
[Fd] -> ShowS
Fd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fd] -> ShowS
$cshowList :: [Fd] -> ShowS
show :: Fd -> String
$cshow :: Fd -> String
showsPrec :: Int -> Fd -> ShowS
$cshowsPrec :: Int -> Fd -> ShowS
Show)
type Attrs = [Attr]
data Attr = Attr String Direction MyType
deriving (Int -> Attr -> ShowS
[Attr] -> ShowS
Attr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attr] -> ShowS
$cshowList :: [Attr] -> ShowS
show :: Attr -> String
$cshow :: Attr -> String
showsPrec :: Int -> Attr -> ShowS
$cshowsPrec :: Int -> Attr -> ShowS
Show, Attr -> Attr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attr -> Attr -> Bool
$c/= :: Attr -> Attr -> Bool
== :: Attr -> Attr -> Bool
$c== :: Attr -> Attr -> Bool
Eq, Eq Attr
Attr -> Attr -> Bool
Attr -> Attr -> Ordering
Attr -> Attr -> Attr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attr -> Attr -> Attr
$cmin :: Attr -> Attr -> Attr
max :: Attr -> Attr -> Attr
$cmax :: Attr -> Attr -> Attr
>= :: Attr -> Attr -> Bool
$c>= :: Attr -> Attr -> Bool
> :: Attr -> Attr -> Bool
$c> :: Attr -> Attr -> Bool
<= :: Attr -> Attr -> Bool
$c<= :: Attr -> Attr -> Bool
< :: Attr -> Attr -> Bool
$c< :: Attr -> Attr -> Bool
compare :: Attr -> Attr -> Ordering
$ccompare :: Attr -> Attr -> Ordering
Ord)
data Direction = Inh | AnyDir | Syn
deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, Eq Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum)
foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> [b] -> m a
foldM' a -> b -> m a
_ a
a [] = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
foldM' a -> b -> m a
f a
a (b
x:[b]
xs) = a -> b -> m a
f a
a b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
fax -> a
fax seq :: forall a b. a -> b -> b
`seq` forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM a -> b -> m a
f a
fax [b]
xs
modifyArray :: a i t -> i -> (t -> t) -> m ()
modifyArray a i t
r i
k t -> t
f = do
t
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray a i t
r i
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray a i t
r i
k (t -> t
f t
v)
setConcatMap :: (a -> Set a) -> Set a -> Set a
setConcatMap a -> Set a
f = forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr (forall a. Ord a => Set a -> Set a -> Set a
S.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set a
f) forall a. Set a
S.empty
isLoc :: MyOccurrence -> Bool
isLoc (MyOccurrence (PLabel
_,String
f) ALabel
_) = String
f forall a. Eq a => a -> a -> Bool
== String
"loc" Bool -> Bool -> Bool
|| String
f forall a. Eq a => a -> a -> Bool
== String
"inst"
instance Eq Direction where
Direction
Inh == :: Direction -> Direction -> Bool
== Direction
Syn = Bool
False
Direction
Syn == Direction
Inh = Bool
False
Direction
_ == Direction
_ = Bool
True
data MyType = TyInt
| TyBool
| TyString
| TyData String
| TyLit String
| TyArr MyType MyType
| NoType
| AnyType
type SchedRef s = (STArray s Vertex (Maybe Int),ThreadRef s)
type AttrAssRef s = STArray s Vertex (Maybe Int)
type ThreadRef s = STRef s InterfaceRes
type PLabel = (MyType,String)
type FLabel = String
type ALabel = (String, Direction)
type AI_N = M.Map MyType MyAttributes
type AS_N = M.Map MyType MyAttributes
type A_N = M.Map MyType MyAttributes
type A_P = M.Map PLabel MyOccurrences
type FTY = M.Map (PLabel, FLabel) MyType
type TYFS = M.Map MyType [(PLabel, FLabel)]
type SF_P = M.Map MyOccurrence (S.Set MyOccurrence)
type PMP = M.Map Int MyOccurrence
type PMP_R = M.Map MyOccurrence Int
type NMP = M.Map Int MyAttribute
type NMP_R = M.Map MyAttribute Int
type FMap = M.Map (PLabel,FLabel) (S.Set MyOccurrence, S.Set MyOccurrence)
type FsInP = M.Map PLabel [(PLabel, FLabel)]
type LOAGRes = ( Maybe TDPRes
, InterfaceRes
, ADSRes)
type VisCount= (Int, Int, Float)
type ADSRes = [Edge]
type TDPRes = A.Array Vertex Vertices
type TDPGraph = (IM.IntMap Vertices, IM.IntMap Vertices)
type InterfaceRes = M.Map String (IM.IntMap [Vertex])
type HOMap = M.Map PLabel (S.Set FLabel)
data CType = T1 | T2
| T3 [Edge]
deriving (Int -> CType -> ShowS
[CType] -> ShowS
CType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CType] -> ShowS
$cshowList :: [CType] -> ShowS
show :: CType -> String
$cshow :: CType -> String
showsPrec :: Int -> CType -> ShowS
$cshowsPrec :: Int -> CType -> ShowS
Show)
findWithErr :: (Ord k, Show k, Show a) => M.Map k a -> String -> k -> a
findWithErr :: forall k a. (Ord k, Show k, Show a) => Map k a -> String -> k -> a
findWithErr Map k a
m String
err k
k = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
err) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k a
m
findWithErr' :: IntMap b -> String -> Int -> b
findWithErr' IntMap b
m String
err Int
k= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
err) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap b
m
type MyAttributes = [MyAttribute]
data MyAttribute = MyAttribute {MyAttribute -> MyType
typeOf :: MyType, MyAttribute -> ALabel
alab :: ALabel}
deriving (Eq MyAttribute
MyAttribute -> MyAttribute -> Bool
MyAttribute -> MyAttribute -> Ordering
MyAttribute -> MyAttribute -> MyAttribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MyAttribute -> MyAttribute -> MyAttribute
$cmin :: MyAttribute -> MyAttribute -> MyAttribute
max :: MyAttribute -> MyAttribute -> MyAttribute
$cmax :: MyAttribute -> MyAttribute -> MyAttribute
>= :: MyAttribute -> MyAttribute -> Bool
$c>= :: MyAttribute -> MyAttribute -> Bool
> :: MyAttribute -> MyAttribute -> Bool
$c> :: MyAttribute -> MyAttribute -> Bool
<= :: MyAttribute -> MyAttribute -> Bool
$c<= :: MyAttribute -> MyAttribute -> Bool
< :: MyAttribute -> MyAttribute -> Bool
$c< :: MyAttribute -> MyAttribute -> Bool
compare :: MyAttribute -> MyAttribute -> Ordering
$ccompare :: MyAttribute -> MyAttribute -> Ordering
Ord, MyAttribute -> MyAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MyAttribute -> MyAttribute -> Bool
$c/= :: MyAttribute -> MyAttribute -> Bool
== :: MyAttribute -> MyAttribute -> Bool
$c== :: MyAttribute -> MyAttribute -> Bool
Eq)
<.> :: MyType -> ALabel -> MyAttribute
(<.>) = MyType -> ALabel -> MyAttribute
MyAttribute
infixl 7 <.>
instance Show MyAttribute where
show :: MyAttribute -> String
show (MyAttribute MyType
t ALabel
a) = forall a. Show a => a -> String
show MyType
t forall a. [a] -> [a] -> [a]
++ String
"<.>" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ALabel
a
type MyOccurrences = [MyOccurrence]
data MyOccurrence = MyOccurrence {MyOccurrence -> (PLabel, String)
argsOf :: (PLabel, FLabel), MyOccurrence -> ALabel
attr :: ALabel}
deriving (Eq MyOccurrence
MyOccurrence -> MyOccurrence -> Bool
MyOccurrence -> MyOccurrence -> Ordering
MyOccurrence -> MyOccurrence -> MyOccurrence
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MyOccurrence -> MyOccurrence -> MyOccurrence
$cmin :: MyOccurrence -> MyOccurrence -> MyOccurrence
max :: MyOccurrence -> MyOccurrence -> MyOccurrence
$cmax :: MyOccurrence -> MyOccurrence -> MyOccurrence
>= :: MyOccurrence -> MyOccurrence -> Bool
$c>= :: MyOccurrence -> MyOccurrence -> Bool
> :: MyOccurrence -> MyOccurrence -> Bool
$c> :: MyOccurrence -> MyOccurrence -> Bool
<= :: MyOccurrence -> MyOccurrence -> Bool
$c<= :: MyOccurrence -> MyOccurrence -> Bool
< :: MyOccurrence -> MyOccurrence -> Bool
$c< :: MyOccurrence -> MyOccurrence -> Bool
compare :: MyOccurrence -> MyOccurrence -> Ordering
$ccompare :: MyOccurrence -> MyOccurrence -> Ordering
Ord, MyOccurrence -> MyOccurrence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MyOccurrence -> MyOccurrence -> Bool
$c/= :: MyOccurrence -> MyOccurrence -> Bool
== :: MyOccurrence -> MyOccurrence -> Bool
$c== :: MyOccurrence -> MyOccurrence -> Bool
Eq)
>.< :: (PLabel, String) -> ALabel -> MyOccurrence
(>.<) = (PLabel, String) -> ALabel -> MyOccurrence
MyOccurrence
infixl 8 >.<
instance Show MyOccurrence where
show :: MyOccurrence -> String
show (MyOccurrence ((MyType
t,String
p),String
f) ALabel
a) =
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [forall a. Show a => a -> String
show MyType
t,String
p,String
f] forall a. [a] -> [a] -> [a]
++ String
"."forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ALabel
a
dirOfOcc :: MyOccurrence -> Direction
dirOfOcc :: MyOccurrence -> Direction
dirOfOcc = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyOccurrence -> ALabel
attr
handOut :: (PLabel, FLabel) -> MyAttribute -> MyOccurrence
handOut :: (PLabel, String) -> MyAttribute -> MyOccurrence
handOut (PLabel, String)
p = ((PLabel, String)
p (PLabel, String) -> ALabel -> MyOccurrence
>.<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyAttribute -> ALabel
alab
handAllOut :: (PLabel, FLabel) -> MyAttributes -> MyOccurrences
handAllOut :: (PLabel, String) -> [MyAttribute] -> [MyOccurrence]
handAllOut (PLabel, String)
p [MyAttribute]
os = forall a b. (a -> b) -> [a] -> [b]
map ((PLabel, String) -> MyAttribute -> MyOccurrence
handOut (PLabel, String)
p) [MyAttribute]
os
map2F :: (Ord a) => M.Map a [b] -> a -> [b]
map2F :: forall a b. Ord a => Map a [b] -> a -> [b]
map2F Map a [b]
m a
a = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a Map a [b]
m of
Maybe [b]
Nothing -> []
Just [b]
bs -> [b]
bs
map2F' :: (Ord a) => M.Map a (S.Set b) -> a -> (S.Set b)
map2F' :: forall a b. Ord a => Map a (Set b) -> a -> Set b
map2F' Map a (Set b)
m a
a = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a Map a (Set b)
m of
Maybe (Set b)
Nothing -> forall a. Set a
S.empty
Just Set b
bs -> Set b
bs
flipDir :: Direction -> Direction
flipDir :: Direction -> Direction
flipDir Direction
Syn = Direction
Inh
flipDir Direction
Inh = Direction
Syn
pairs :: [a] -> [(a,a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [] = []
pairs (a
x:[a]
xs) = forall a b. (a -> b) -> [a] -> [b]
map ((,) a
x) [a]
xs forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [(a, a)]
pairs [a]
xs
toMyTy :: Type -> MyType
toMyTy :: Type -> MyType
toMyTy (Haskell String
str) = String -> MyType
TyLit String
str
toMyTy (NT Identifier
id [String]
_ Bool
_ ) = String -> MyType
TyData forall a b. (a -> b) -> a -> b
$ Identifier -> String
getName Identifier
id
toMyTy Type
Self = forall a. HasCallStack => String -> a
error String
"Type Self in phase 3"
fromMyTy :: MyType -> Type
fromMyTy :: MyType -> Type
fromMyTy (TyLit String
str) = (String -> Type
Haskell String
str)
fromMyTy (TyData String
id) = Identifier -> [String] -> Bool -> Type
NT (String -> Identifier
identifier String
id) [] Bool
False
toMyAttr :: Direction -> MyType -> Attributes -> MyAttributes
toMyAttr :: Direction -> MyType -> Attributes -> [MyAttribute]
toMyAttr Direction
d MyType
dty = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey
(\Identifier
ident Type
ty [MyAttribute]
as -> MyType
dty MyType -> ALabel -> MyAttribute
<.> (Identifier -> String
getName Identifier
ident,Direction
d)forall a. a -> [a] -> [a]
:[MyAttribute]
as) []
completing :: FrGraph -> SchedRef s -> [Nt] -> ST s InterfaceRes
completing :: forall s. FrGraph -> SchedRef s -> [Nt] -> ST s InterfaceRes
completing FrGraph
ids SchedRef s
sched [Nt]
nts = do
[(String, IntMap [Int])]
ims <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Nt]
nts forall a b. (a -> b) -> a -> b
$ forall s.
FrGraph -> AttrAssRef s -> Nt -> ST s (String, IntMap [Int])
completingN FrGraph
ids (forall a b. (a, b) -> a
fst SchedRef s
sched)
let threads :: InterfaceRes
threads = (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, IntMap [Int])]
ims)
forall s a. STRef s a -> a -> ST s ()
writeSTRef (forall a b. (a, b) -> b
snd SchedRef s
sched) InterfaceRes
threads
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InterfaceRes
threads
completingN :: FrGraph -> AttrAssRef s -> Nt ->
ST s ((String, IM.IntMap [Vertex]))
completingN :: forall s.
FrGraph -> AttrAssRef s -> Nt -> ST s (String, IntMap [Int])
completingN ids :: FrGraph
ids@(DirGraph
idsf, DirGraph
idst) AttrAssRef s
schedA
(Nt String
nt_id [Edge]
_ [Edge]
_ [(Int, [Int], Direction)]
inhs [(Int, [Int], Direction)]
syns [Pr]
_) = do
STRef s (IntMap [Int])
schedS <- forall a s. a -> ST s (STRef s a)
newSTRef forall a. IntMap a
IM.empty
let attrs :: [(Int, [Int], Direction)]
attrs = [(Int, [Int], Direction)]
inhs forall a. [a] -> [a] -> [a]
++ [(Int, [Int], Direction)]
syns
dty :: MyType
dty = String -> MyType
TyData String
nt_id
assign :: (Int, [Int], Direction) -> ST s ()
assign (Int
attr,[Int]
_,Direction
dAttr) = do
let succs :: Vertices
succs = DirGraph
idsf forall i e. Ix i => Array i e -> i -> e
A.! Int
attr
Array Int (Maybe Int)
assigned <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze AttrAssRef s
schedA
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ Array Int (Maybe Int)
assigned forall i e. Ix i => Array i e -> i -> e
A.! Int
attr) forall a b. (a -> b) -> a -> b
$ do
case Vertices -> [Int]
IS.toList Vertices
succs of
[] ->Int -> Int -> ST s ()
wrap_up Int
attr(if Direction
Synforall a. Eq a => a -> a -> Bool
==Direction
dAttr then Int
1 else Int
2)
[Int]
ss ->case [(Int, Maybe Int)] -> Maybe Edge
selMax forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a
idforall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&(Array Int (Maybe Int)
assigned forall i e. Ix i => Array i e -> i -> e
A.!)) [Int]
ss of
Maybe Edge
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Int
a,Int
mx) -> do
let dA :: Direction
dA | forall a. Integral a => a -> Bool
even Int
mx = Direction
Inh
| Bool
otherwise = Direction
Syn
Int -> Int -> ST s ()
wrap_up Int
attr (if Direction
dA forall a. Eq a => a -> a -> Bool
== Direction
dAttr
then Int
mx else Int
mxforall a. Num a => a -> a -> a
+Int
1)
wrap_up :: Int -> Int -> ST s ()
wrap_up Int
attr Int
k = do
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (IntMap [Int])
schedS (forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
(++) Int
k [Int
attr])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray AttrAssRef s
schedA Int
attr (forall a. a -> Maybe a
Just Int
k)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, [Int], Direction)]
attrs (Int, [Int], Direction) -> ST s ()
assign
selMax :: [(Vertex, Maybe Int)] -> Maybe (Vertex, Int)
selMax :: [(Int, Maybe Int)] -> Maybe Edge
selMax [(Int
v,Maybe Int
mi)] = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Int
v) Maybe Int
mi
selMax ((Int, Maybe Int)
x:[(Int, Maybe Int)]
xs) = case (Int, Maybe Int)
x of
(Int
a', Maybe Int
Nothing) -> forall a. Maybe a
Nothing
(Int
a', Just Int
i') ->
case [(Int, Maybe Int)] -> Maybe Edge
selMax [(Int, Maybe Int)]
xs of
Maybe Edge
Nothing -> forall a. Maybe a
Nothing
Just (Int
a,Int
i) ->
case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
i' of
Ordering
LT -> forall a. a -> Maybe a
Just (Int
a',Int
i')
Ordering
_ -> forall a. a -> Maybe a
Just (Int
a,Int
i)
case [(Int, [Int], Direction)]
attrs of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
nt_id, forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
1,[]),(Int
2,[])])
[(Int, [Int], Direction)]
as -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, [Int], Direction)]
as (Int, [Int], Direction) -> ST s ()
assign forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s a. STRef s a -> ST s a
readSTRef STRef s (IntMap [Int])
schedS forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) String
nt_id)
fetchEdges :: FrGraph -> InterfaceRes -> [Nt] -> ([Edge],[Edge])
fetchEdges :: FrGraph -> InterfaceRes -> [Nt] -> ([Edge], [Edge])
fetchEdges FrGraph
ids InterfaceRes
threads [Nt]
nts =
let ivdNs :: [([Edge], [Edge])]
ivdNs = forall a b. (a -> b) -> [a] -> [b]
map (FrGraph -> InterfaceRes -> Nt -> ([Edge], [Edge])
fetchEdgesN FrGraph
ids InterfaceRes
threads) [Nt]
nts
in (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$ forall a b. [(a, b)] -> ([a], [b])
unzip [([Edge], [Edge])]
ivdNs
fetchEdgesN :: FrGraph -> InterfaceRes -> Nt
-> ([Edge],[Edge])
fetchEdgesN :: FrGraph -> InterfaceRes -> Nt -> ([Edge], [Edge])
fetchEdgesN (DirGraph
idsf, DirGraph
idst) InterfaceRes
threads
(Nt String
nt_id [Edge]
_ [Edge]
_ [(Int, [Int], Direction)]
_ [(Int, [Int], Direction)]
_ [Pr]
_) =
let sched :: IntMap [Int]
sched = forall k a. (Ord k, Show k, Show a) => Map k a -> String -> k -> a
findWithErr InterfaceRes
threads String
"schedule err" String
nt_id
mx :: Int
mx = if forall a. IntMap a -> Bool
IM.null IntMap [Int]
sched then Int
0 else forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> (Int, a)
IM.findMax IntMap [Int]
sched
findK :: Int -> [Int]
findK Int
0 = []
findK Int
k = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap [Int]
sched) forall a. [a] -> [a] -> [a]
++ Int -> [Int]
findK (Int
kforall a. Num a => a -> a -> a
-Int
1)
ivd :: [Edge]
ivd = [ (Int
f,Int
t) | Int
k <- [Int
2..Int
mx]
, Int
f <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap [Int]
sched
, Int
t <- Int -> [Int]
findK (Int
kforall a. Num a => a -> a -> a
-Int
1)]
in ([Edge]
ivd, [ (Int
f, Int
t) | (Int
f, Int
t) <- [Edge]
ivd
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Int -> Vertices -> Bool
IS.member Int
t (DirGraph
idsf forall i e. Ix i => Array i e -> i -> e
A.! Int
f) ])
instance Show MyType where
show :: MyType -> String
show MyType
TyInt = String
"Int"
show MyType
TyBool = String
"Bool"
show MyType
TyString = String
"String"
show (TyData String
t) = String
t
show (TyLit String
t) = forall a. Show a => a -> String
show String
t
show (TyArr MyType
a MyType
b) = forall a. Show a => a -> String
show MyType
a forall a. [a] -> [a] -> [a]
++ String
" -> (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MyType
b forall a. [a] -> [a] -> [a]
++ String
")"
show MyType
NoType = forall a. HasCallStack => String -> a
error String
"Trying to show NoType"
show MyType
AnyType = String
"AnyType"
instance Eq MyType where
MyType
TyInt == :: MyType -> MyType -> Bool
== MyType
TyInt = Bool
True
MyType
TyBool == MyType
TyBool = Bool
True
MyType
TyString == MyType
TyString = Bool
True
TyData String
n == TyData String
n' = String
n forall a. Eq a => a -> a -> Bool
== String
n'
TyLit String
ty == TyLit String
ty' = String
ty forall a. Eq a => a -> a -> Bool
== String
ty'
TyArr MyType
l MyType
r == TyArr MyType
l' MyType
r' = MyType
l forall a. Eq a => a -> a -> Bool
== MyType
l' Bool -> Bool -> Bool
&& MyType
r forall a. Eq a => a -> a -> Bool
== MyType
r'
MyType
NoType == MyType
_ = Bool
False
MyType
_ == MyType
NoType = Bool
False
MyType
AnyType == MyType
_ = Bool
True
MyType
_ == MyType
AnyType = Bool
True
MyType
_ == MyType
_ = Bool
False
instance Ord MyType where
MyType
NoType compare :: MyType -> MyType -> Ordering
`compare` MyType
_ = Ordering
LT
MyType
_ `compare` MyType
NoType = Ordering
GT
MyType
AnyType `compare` MyType
_ = Ordering
EQ
MyType
_ `compare` MyType
AnyType = Ordering
EQ
MyType
TyInt `compare` MyType
TyInt = Ordering
EQ
MyType
TyInt `compare` MyType
_ = Ordering
LT
MyType
TyBool `compare` MyType
TyInt = Ordering
GT
MyType
TyBool `compare` MyType
TyBool = Ordering
EQ
MyType
TyBool `compare` MyType
_ = Ordering
LT
MyType
TyString `compare` MyType
TyInt = Ordering
GT
MyType
TyString `compare` MyType
TyBool = Ordering
GT
MyType
TyString `compare` MyType
TyString = Ordering
EQ
MyType
TyString `compare` MyType
_ = Ordering
LT
TyData String
_ `compare` MyType
TyInt = Ordering
GT
TyData String
_ `compare` MyType
TyBool = Ordering
GT
TyData String
_ `compare` MyType
TyString = Ordering
GT
TyData String
a `compare` TyData String
b = forall a. Ord a => a -> a -> Ordering
compare String
a String
b
TyData String
_ `compare` MyType
_ = Ordering
LT
TyLit String
a `compare` TyLit String
b = forall a. Ord a => a -> a -> Ordering
compare String
a String
b
TyLit String
_ `compare` TyArr MyType
_ MyType
_= Ordering
LT
TyLit String
_ `compare` MyType
_ = Ordering
GT
TyArr MyType
a MyType
a' `compare` TyArr MyType
b MyType
b' =
case forall a. Ord a => a -> a -> Ordering
compare MyType
a MyType
b of
Ordering
LT -> Ordering
LT
Ordering
GT -> Ordering
GT
Ordering
EQ -> forall a. Ord a => a -> a -> Ordering
compare MyType
a' MyType
b'
TyArr MyType
_ MyType
_ `compare` MyType
_ = Ordering
GT