module Language.Bluespec.Classic.AST.SchedInfo
( SchedInfo(..)
, MethodConflictInfo(..)
, makeMethodConflictDocs
) where
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import Text.PrettyPrint.HughesPJClass
import Language.Bluespec.Prelude
import Language.Bluespec.Pretty
data SchedInfo idtype = SchedInfo {
forall idtype. SchedInfo idtype -> MethodConflictInfo idtype
methodConflictInfo :: MethodConflictInfo idtype,
forall idtype. SchedInfo idtype -> [((idtype, idtype), [idtype])]
rulesBetweenMethods :: [((idtype, idtype), [idtype])],
forall idtype.
SchedInfo idtype -> [(idtype, [Either idtype idtype])]
rulesBeforeMethods :: [(idtype,[Either idtype idtype])],
forall idtype. SchedInfo idtype -> [idtype]
clockCrossingMethods :: [idtype]
}
deriving (SchedInfo idtype -> SchedInfo idtype -> Bool
(SchedInfo idtype -> SchedInfo idtype -> Bool)
-> (SchedInfo idtype -> SchedInfo idtype -> Bool)
-> Eq (SchedInfo idtype)
forall idtype.
Eq idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall idtype.
Eq idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
== :: SchedInfo idtype -> SchedInfo idtype -> Bool
$c/= :: forall idtype.
Eq idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
/= :: SchedInfo idtype -> SchedInfo idtype -> Bool
Eq, Eq (SchedInfo idtype)
Eq (SchedInfo idtype) =>
(SchedInfo idtype -> SchedInfo idtype -> Ordering)
-> (SchedInfo idtype -> SchedInfo idtype -> Bool)
-> (SchedInfo idtype -> SchedInfo idtype -> Bool)
-> (SchedInfo idtype -> SchedInfo idtype -> Bool)
-> (SchedInfo idtype -> SchedInfo idtype -> Bool)
-> (SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype)
-> (SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype)
-> Ord (SchedInfo idtype)
SchedInfo idtype -> SchedInfo idtype -> Bool
SchedInfo idtype -> SchedInfo idtype -> Ordering
SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype
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
forall idtype. Ord idtype => Eq (SchedInfo idtype)
forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Ordering
forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype
$ccompare :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Ordering
compare :: SchedInfo idtype -> SchedInfo idtype -> Ordering
$c< :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
< :: SchedInfo idtype -> SchedInfo idtype -> Bool
$c<= :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
<= :: SchedInfo idtype -> SchedInfo idtype -> Bool
$c> :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
> :: SchedInfo idtype -> SchedInfo idtype -> Bool
$c>= :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> Bool
>= :: SchedInfo idtype -> SchedInfo idtype -> Bool
$cmax :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype
max :: SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype
$cmin :: forall idtype.
Ord idtype =>
SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype
min :: SchedInfo idtype -> SchedInfo idtype -> SchedInfo idtype
Ord, Int -> SchedInfo idtype -> ShowS
[SchedInfo idtype] -> ShowS
SchedInfo idtype -> String
(Int -> SchedInfo idtype -> ShowS)
-> (SchedInfo idtype -> String)
-> ([SchedInfo idtype] -> ShowS)
-> Show (SchedInfo idtype)
forall idtype. Show idtype => Int -> SchedInfo idtype -> ShowS
forall idtype. Show idtype => [SchedInfo idtype] -> ShowS
forall idtype. Show idtype => SchedInfo idtype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall idtype. Show idtype => Int -> SchedInfo idtype -> ShowS
showsPrec :: Int -> SchedInfo idtype -> ShowS
$cshow :: forall idtype. Show idtype => SchedInfo idtype -> String
show :: SchedInfo idtype -> String
$cshowList :: forall idtype. Show idtype => [SchedInfo idtype] -> ShowS
showList :: [SchedInfo idtype] -> ShowS
Show)
instance (Pretty idtype, Ord idtype) => Pretty (SchedInfo idtype) where
pPrintPrec :: PrettyLevel -> Rational -> SchedInfo idtype -> Doc
pPrintPrec PrettyLevel
d Rational
_p SchedInfo idtype
si =
[Doc] -> Doc
sep [String -> Doc
text String
"SchedInfo",
PrettyLevel -> Rational -> MethodConflictInfo idtype -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 (SchedInfo idtype -> MethodConflictInfo idtype
forall idtype. SchedInfo idtype -> MethodConflictInfo idtype
methodConflictInfo SchedInfo idtype
si),
PrettyLevel -> Rational -> [((idtype, idtype), [idtype])] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 (SchedInfo idtype -> [((idtype, idtype), [idtype])]
forall idtype. SchedInfo idtype -> [((idtype, idtype), [idtype])]
rulesBetweenMethods SchedInfo idtype
si),
PrettyLevel
-> Rational -> [(idtype, [Either idtype idtype])] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 (SchedInfo idtype -> [(idtype, [Either idtype idtype])]
forall idtype.
SchedInfo idtype -> [(idtype, [Either idtype idtype])]
rulesBeforeMethods SchedInfo idtype
si),
PrettyLevel -> Rational -> [idtype] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 (SchedInfo idtype -> [idtype]
forall idtype. SchedInfo idtype -> [idtype]
clockCrossingMethods SchedInfo idtype
si)]
data MethodConflictInfo idtype =
MethodConflictInfo {
forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sCF :: [(idtype, idtype)],
forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sSB :: [(idtype, idtype)],
forall idtype. MethodConflictInfo idtype -> [[idtype]]
sME :: [[idtype]],
forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sP :: [(idtype, idtype)],
forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sSBR :: [(idtype, idtype)],
forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sC :: [(idtype, idtype)],
forall idtype. MethodConflictInfo idtype -> [idtype]
sEXT :: [idtype]
}
deriving (MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
(MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool)
-> (MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool)
-> Eq (MethodConflictInfo idtype)
forall idtype.
Eq idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall idtype.
Eq idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
== :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
$c/= :: forall idtype.
Eq idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
/= :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
Eq, Eq (MethodConflictInfo idtype)
Eq (MethodConflictInfo idtype) =>
(MethodConflictInfo idtype
-> MethodConflictInfo idtype -> Ordering)
-> (MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool)
-> (MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool)
-> (MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool)
-> (MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool)
-> (MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype)
-> (MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype)
-> Ord (MethodConflictInfo idtype)
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Ordering
MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype
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
forall idtype. Ord idtype => Eq (MethodConflictInfo idtype)
forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Ordering
forall idtype.
Ord idtype =>
MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype
$ccompare :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Ordering
compare :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Ordering
$c< :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
< :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
$c<= :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
<= :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
$c> :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
> :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
$c>= :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
>= :: MethodConflictInfo idtype -> MethodConflictInfo idtype -> Bool
$cmax :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype
max :: MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype
$cmin :: forall idtype.
Ord idtype =>
MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype
min :: MethodConflictInfo idtype
-> MethodConflictInfo idtype -> MethodConflictInfo idtype
Ord, Int -> MethodConflictInfo idtype -> ShowS
[MethodConflictInfo idtype] -> ShowS
MethodConflictInfo idtype -> String
(Int -> MethodConflictInfo idtype -> ShowS)
-> (MethodConflictInfo idtype -> String)
-> ([MethodConflictInfo idtype] -> ShowS)
-> Show (MethodConflictInfo idtype)
forall idtype.
Show idtype =>
Int -> MethodConflictInfo idtype -> ShowS
forall idtype. Show idtype => [MethodConflictInfo idtype] -> ShowS
forall idtype. Show idtype => MethodConflictInfo idtype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall idtype.
Show idtype =>
Int -> MethodConflictInfo idtype -> ShowS
showsPrec :: Int -> MethodConflictInfo idtype -> ShowS
$cshow :: forall idtype. Show idtype => MethodConflictInfo idtype -> String
show :: MethodConflictInfo idtype -> String
$cshowList :: forall idtype. Show idtype => [MethodConflictInfo idtype] -> ShowS
showList :: [MethodConflictInfo idtype] -> ShowS
Show)
instance (Pretty idtype, Ord idtype) => Pretty (MethodConflictInfo idtype) where
pPrintPrec :: PrettyLevel -> Rational -> MethodConflictInfo idtype -> Doc
pPrintPrec PrettyLevel
d Rational
p MethodConflictInfo idtype
mci =
let ds :: [Doc]
ds = (idtype -> Doc)
-> (idtype -> String)
-> String
-> String
-> MethodConflictInfo idtype
-> [Doc]
forall idtype.
Ord idtype =>
(idtype -> Doc)
-> (idtype -> String)
-> String
-> String
-> MethodConflictInfo idtype
-> [Doc]
makeMethodConflictDocs (PrettyLevel -> Rational -> idtype -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p) idtype -> String
forall a. Pretty a => a -> String
ppReadable String
"[" String
"]" MethodConflictInfo idtype
mci
in String -> Doc
text String
"[" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [Doc]
ds (String -> Doc
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
"]"
makeMethodConflictDocs :: (Ord idtype) =>
(idtype -> Doc) ->
(idtype -> String) ->
String -> String ->
MethodConflictInfo idtype -> [Doc]
makeMethodConflictDocs :: forall idtype.
Ord idtype =>
(idtype -> Doc)
-> (idtype -> String)
-> String
-> String
-> MethodConflictInfo idtype
-> [Doc]
makeMethodConflictDocs idtype -> Doc
pId idtype -> String
sId String
listStart String
listEnd
(MethodConflictInfo { sCF :: forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sCF=[(idtype, idtype)]
sCF0, sSB :: forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sSB=[(idtype, idtype)]
sSB0, sME :: forall idtype. MethodConflictInfo idtype -> [[idtype]]
sME=[[idtype]]
sME0, sP :: forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sP=[(idtype, idtype)]
sP0,
sSBR :: forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sSBR=[(idtype, idtype)]
sSBR0, sC :: forall idtype. MethodConflictInfo idtype -> [(idtype, idtype)]
sC=[(idtype, idtype)]
sC0, sEXT :: forall idtype. MethodConflictInfo idtype -> [idtype]
sEXT=[idtype]
sEXT0 }) =
[[idtype] -> Doc
pp [idtype]
m Doc -> Doc -> Doc
<+> String -> Doc
text String
"CF" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
m' | ([idtype]
m,[idtype]
m') <- [(idtype, idtype)] -> [([idtype], [idtype])]
toPairsOfLists [(idtype, idtype)]
sCF0 ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[[idtype] -> Doc
pp [idtype]
m Doc -> Doc -> Doc
<+> String -> Doc
text String
"SB" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
m' | ([idtype]
m,[idtype]
m') <- [(idtype, idtype)] -> [([idtype], [idtype])]
toPairsOfLists [(idtype, idtype)]
sSB0 ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[ String -> Doc
text String
"ME" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
m | [idtype]
m <- [[idtype]]
sME_ordered ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[[idtype] -> Doc
pp [idtype]
m Doc -> Doc -> Doc
<+> String -> Doc
text String
"P" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
m' | ([idtype]
m,[idtype]
m') <- [(idtype, idtype)] -> [([idtype], [idtype])]
toPairsOfLists [(idtype, idtype)]
sP0 ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[[idtype] -> Doc
pp [idtype]
m Doc -> Doc -> Doc
<+> String -> Doc
text String
"SBR" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
m' | ([idtype]
m,[idtype]
m') <- [(idtype, idtype)] -> [([idtype], [idtype])]
toPairsOfLists [(idtype, idtype)]
sSBR0 ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[[idtype] -> Doc
pp [idtype]
m Doc -> Doc -> Doc
<+> String -> Doc
text String
"C" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
m' | ([idtype]
m,[idtype]
m') <- [(idtype, idtype)] -> [([idtype], [idtype])]
toPairsOfLists [(idtype, idtype)]
sC0 ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
(if [idtype] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [idtype]
sEXT0 then [] else [String -> Doc
text String
"EXT" Doc -> Doc -> Doc
<+> [idtype] -> Doc
pp [idtype]
sEXT_ordered])
where
pp :: [idtype] -> Doc
pp [idtype
m] = idtype -> Doc
pId idtype
m
pp [idtype]
ms =
String -> Doc
text String
listStart Doc -> Doc -> Doc
<> ([Doc] -> Doc -> Doc
sepList ((idtype -> Doc) -> [idtype] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map idtype -> Doc
pId [idtype]
ms) (String -> Doc
text String
",")) Doc -> Doc -> Doc
<> String -> Doc
text String
listEnd
collect :: [(k, a)] -> Map k (Set a)
collect [(k, a)]
ps = (Set a -> Set a -> Set a) -> [(k, Set a)] -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union) [(k
a,a -> Set a
forall a. a -> Set a
S.singleton a
b) | (k
a,a
b) <- [(k, a)]
ps]
toPairsOfLists :: [(idtype, idtype)] -> [([idtype], [idtype])]
toPairsOfLists [(idtype, idtype)]
ps = let m1 :: Map idtype (Set idtype)
m1 = [(idtype, idtype)] -> Map idtype (Set idtype)
forall {k} {a}. (Ord k, Ord a) => [(k, a)] -> Map k (Set a)
collect [(idtype, idtype)]
ps
m2 :: Map (Set idtype) (Set idtype)
m2 = [(Set idtype, idtype)] -> Map (Set idtype) (Set idtype)
forall {k} {a}. (Ord k, Ord a) => [(k, a)] -> Map k (Set a)
collect [(Set idtype
s,idtype
a) | (idtype
a,Set idtype
s) <- Map idtype (Set idtype) -> [(idtype, Set idtype)]
forall k a. Map k a -> [(k, a)]
M.toList Map idtype (Set idtype)
m1]
in [([idtype], [idtype])] -> [([idtype], [idtype])]
forall {b}. [([idtype], b)] -> [([idtype], b)]
sortLP [ ([idtype] -> [idtype]
sortI (Set idtype -> [idtype]
forall a. Set a -> [a]
S.toList Set idtype
s2), [idtype] -> [idtype]
sortI (Set idtype -> [idtype]
forall a. Set a -> [a]
S.toList Set idtype
s1))
| (Set idtype
s1,Set idtype
s2) <- Map (Set idtype) (Set idtype) -> [(Set idtype, Set idtype)]
forall k a. Map k a -> [(k, a)]
M.toList Map (Set idtype) (Set idtype)
m2
]
sortI :: [idtype] -> [idtype]
sortI = (idtype -> idtype -> Ordering) -> [idtype] -> [idtype]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\ idtype
i1 idtype
i2 -> (idtype -> String
sId idtype
i1) String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (idtype -> String
sId idtype
i2))
sortL :: [[idtype]] -> [[idtype]]
sortL = ([idtype] -> [idtype] -> Ordering) -> [[idtype]] -> [[idtype]]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\ [idtype]
is1 [idtype]
is2 -> ((idtype -> String) -> [idtype] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map idtype -> String
sId [idtype]
is1) [String] -> [String] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ((idtype -> String) -> [idtype] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map idtype -> String
sId [idtype]
is2))
sortLP :: [([idtype], b)] -> [([idtype], b)]
sortLP = (([idtype], b) -> ([idtype], b) -> Ordering)
-> [([idtype], b)] -> [([idtype], b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\([idtype]
is1,b
_) ([idtype]
is2,b
_) -> ((idtype -> String) -> [idtype] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map idtype -> String
sId [idtype]
is1) [String] -> [String] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ((idtype -> String) -> [idtype] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map idtype -> String
sId [idtype]
is2))
sME_ordered :: [[idtype]]
sME_ordered = [[idtype]] -> [[idtype]]
sortL (([idtype] -> [idtype]) -> [[idtype]] -> [[idtype]]
forall a b. (a -> b) -> [a] -> [b]
map [idtype] -> [idtype]
sortI [[idtype]]
sME0)
sEXT_ordered :: [idtype]
sEXT_ordered = [idtype] -> [idtype]
sortI [idtype]
sEXT0