{-# LANGUAGE Safe #-}
{-# LANGUAGE GADTs #-}
module Copilot.Core.PrettyDot
( prettyPrintDot
, prettyPrintExprDot
) where
import Copilot.Core
import Copilot.Core.Type.Show (showWithType, ShowType(..), showType)
import Prelude hiding (id, (<>))
import Text.PrettyPrint.HughesPJ
import Data.List (intersperse)
import Text.Printf
mkExtTmpVar :: String -> String
mkExtTmpVar :: String -> String
mkExtTmpVar = (String
"ext_" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
mkExtTmpTag :: String -> Maybe Tag -> String
mkExtTmpTag :: String -> Maybe Tag -> String
mkExtTmpTag String
name Maybe Tag
tag = String
"ext_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tag -> String
forall a. Show a => a -> String
show (Maybe Tag -> Tag
tagExtract Maybe Tag
tag)
tagExtract :: Maybe Tag -> Tag
Maybe Tag
Nothing = String -> String -> Tag
forall a. String -> String -> a
impossible String
"tagExtract" String
"copilot-sbv"
tagExtract (Just Tag
tag) = Tag
tag
ppExprDot :: Int -> Int -> Bool -> Expr a -> (Doc,Int)
ppExprDot :: Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot Tag
ii Tag
pere Bool
bb Expr a
e0 = case Expr a
e0 of
Const Type a
t a
x -> (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"const: %s\",color=red1, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) ((ShowType -> Type a -> a -> String
forall a. ShowType -> Type a -> a -> String
showWithType ShowType
Haskell Type a
t a
x)::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String)),Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)
Drop Type a
_ DropIdx
0 Tag
id -> (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"stream: %s\",color=crimson, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (Tag -> String
forall a. Show a => a -> String
show Tag
id::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String)),Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)
Drop Type a
_ DropIdx
i Tag
id -> (String -> Doc
text (String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"drop %s: \nstream: %s\",color=crimson, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (DropIdx -> String
forall a. Show a => a -> String
show DropIdx
i::String) (Tag -> String
forall a. Show a => a -> String
show Tag
id::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String)),Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)
ExternVar Type a
_ String
name Maybe [a]
_ -> (if Bool
bb then (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"externV: %s\",color=cyan1, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (String
name::String)) Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String))) else (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"%s\",color=cyan1, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (String -> String
mkExtTmpVar String
name)) Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String)))
,Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)
Local Type a
_ Type a
_ String
name Expr a
e1 Expr a
e2 -> let (Doc
r1, Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
2) (Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Bool
bb Expr a
e1
in let (Doc
r2, Tag
i2) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
i1) Tag
ii Bool
bb Expr a
e2
in (String -> Doc
text (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"local:\",color=blue, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"def: %s\",color=blue, style=filled]\n" ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)::String) (String
name::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1::String))
Doc -> Doc -> Doc
<> Doc
r1
Doc -> Doc -> Doc
<> Doc
r2 ,Tag
i2)
Var Type a
_ String
name -> (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"var: %s\",color=blue, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (String
name::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String)),Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)
Op1 Op1 a a
op Expr a
e -> let (Doc
r1,Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Tag
ii Bool
bb Expr a
e
in (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"op1: %s\",color=green4, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (Op1 a a -> String
forall a b. Op1 a b -> String
ppOp1 Op1 a a
op::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String))
Doc -> Doc -> Doc
<> Doc
r1,Tag
i1)
Op2 Op2 a b a
op Expr a
e1 Expr b
e2 -> let (Doc
r1,Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Tag
ii Bool
bb Expr a
e1
in let (Doc
r2,Tag
i2) = Tag -> Tag -> Bool -> Expr b -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot Tag
i1 Tag
ii Bool
bb Expr b
e2
in (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"op2: %s\",color=green4, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (Op2 a b a -> String
forall a b c. Op2 a b c -> String
ppOp2 Op2 a b a
op::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String))
Doc -> Doc -> Doc
<> Doc
r1
Doc -> Doc -> Doc
<> Doc
r2 ,Tag
i2)
Op3 Op3 a b c a
op Expr a
e1 Expr b
e2 Expr c
e3 -> let (Doc
r1,Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Tag
ii Bool
bb Expr a
e1
in let (Doc
r2,Tag
i2) = Tag -> Tag -> Bool -> Expr b -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot Tag
i1 Tag
ii Bool
bb Expr b
e2
in let (Doc
r3,Tag
i3) = Tag -> Tag -> Bool -> Expr c -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot Tag
i2 Tag
ii Bool
bb Expr c
e3
in (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"op3: %s\",color=green4, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (Op3 a b c a -> String
forall a b c d. Op3 a b c d -> String
ppOp3 Op3 a b c a
op::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String))
Doc -> Doc -> Doc
<> Doc
r1
Doc -> Doc -> Doc
<> Doc
r2
Doc -> Doc -> Doc
<> Doc
r3 ,Tag
i3)
Label Type a
_ String
s Expr a
e -> let (Doc
r1,Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iiTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Tag
ii Bool
bb Expr a
e
in (String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"label: %s\",color=plum, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String) (String
s::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
pere::String) (Tag -> String
forall a. Show a => a -> String
show Tag
ii::String))
Doc -> Doc -> Doc
<> Doc
r1,Tag
i1)
ppUExpr :: Int -> Int -> Bool -> UExpr -> (Doc, Int)
ppUExpr :: Tag -> Tag -> Bool -> UExpr -> (Doc, Tag)
ppUExpr Tag
i Tag
pere Bool
bb UExpr { uExprExpr :: ()
uExprExpr = Expr a
e0 } = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot Tag
i Tag
pere Bool
bb Expr a
e0
ppOp1 :: Op1 a b -> String
ppOp1 :: Op1 a b -> String
ppOp1 Op1 a b
op = case Op1 a b
op of
Op1 a b
Not -> String
"not"
Abs Type a
_ -> String
"abs"
Sign Type a
_ -> String
"signum"
Recip Type a
_ -> String
"recip"
Exp Type a
_ -> String
"exp"
Sqrt Type a
_ -> String
"sqrt"
Log Type a
_ -> String
"log"
Sin Type a
_ -> String
"sin"
Tan Type a
_ -> String
"tan"
Cos Type a
_ -> String
"cos"
Asin Type a
_ -> String
"asin"
Atan Type a
_ -> String
"atan"
Acos Type a
_ -> String
"acos"
Sinh Type a
_ -> String
"sinh"
Tanh Type a
_ -> String
"tanh"
Cosh Type a
_ -> String
"cosh"
Asinh Type a
_ -> String
"asinh"
Atanh Type a
_ -> String
"atanh"
Acosh Type a
_ -> String
"acosh"
BwNot Type a
_ -> String
"~"
Cast Type a
_ Type b
_ -> String
"(cast)"
ppOp2 :: Op2 a b c -> String
ppOp2 :: Op2 a b c -> String
ppOp2 Op2 a b c
op = case Op2 a b c
op of
Op2 a b c
And -> String
"&&"
Op2 a b c
Or -> String
"||"
Add Type a
_ -> String
"+"
Sub Type a
_ -> String
"-"
Mul Type a
_ -> String
"*"
Div Type a
_ -> String
"div"
Mod Type a
_ -> String
"mod"
Fdiv Type a
_ -> String
"/"
Pow Type a
_ -> String
"**"
Logb Type a
_ -> String
"logBase"
Eq Type a
_ -> String
"=="
Ne Type a
_ -> String
"/="
Le Type a
_ -> String
"<="
Ge Type a
_ -> String
">="
Lt Type a
_ -> String
"<"
Gt Type a
_ -> String
">"
BwAnd Type a
_ -> String
"&"
BwOr Type a
_ -> String
"|"
BwXor Type a
_ -> String
"^"
BwShiftL Type a
_ Type b
_ -> String
"<<"
BwShiftR Type a
_ Type b
_ -> String
">>"
ppOp3 :: Op3 a b c d -> String
ppOp3 :: Op3 a b c d -> String
ppOp3 Op3 a b c d
op = case Op3 a b c d
op of
Mux Type b
_ -> String
"mux"
ppStream :: Int -> Stream -> (Doc, Int)
ppStream :: Tag -> Stream -> (Doc, Tag)
ppStream Tag
i
Stream
{ streamId :: Stream -> Tag
streamId = Tag
id
, streamBuffer :: ()
streamBuffer = [a]
buffer
, streamExpr :: ()
streamExpr = Expr a
e
, streamExprType :: ()
streamExprType = Type a
t
}
=
(String -> Doc
text (String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"stream: %s\ntype: %s\",color=mediumblue, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) (Tag -> String
forall a. Show a => a -> String
show Tag
id::String) (Type a -> String
forall a. Type a -> String
showType Type a
t::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"++\",color=yellow, style=filled]\n" ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"[%s]\",color=green, style=filled]\n" ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
2)::String) (([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"," ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowType -> Type a -> a -> String
forall a. ShowType -> Type a -> a -> String
showWithType ShowType
Haskell Type a
t) [a]
buffer )) ::String)
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)::String) ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
2)::String))
Doc -> Doc -> Doc
<> Doc
r1, Tag
i1)
where (Doc
r1, Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
3) (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Bool
True Expr a
e
ppTrigger :: Int -> Trigger -> (Doc, Int)
ppTrigger :: Tag -> Trigger -> (Doc, Tag)
ppTrigger Tag
i
Trigger
{ triggerName :: Trigger -> String
triggerName = String
name
, triggerGuard :: Trigger -> Expr Bool
triggerGuard = Expr Bool
e
, triggerArgs :: Trigger -> [UExpr]
triggerArgs = [UExpr]
args }
= ( String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"trigger: %s\",color=mediumblue, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) (String
name::String) )
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"guard\",color=yellow, style=filled]\n" ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) ((Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> Tag -> String
forall a b. (a -> b) -> a -> b
$ Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1)::String))
Doc -> Doc -> Doc
<> Doc
r1
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"args\",color=yellow, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i1::String))
Doc -> Doc -> Doc
<> String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s -> %s\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) (Tag -> String
forall a. Show a => a -> String
show Tag
i1::String))
Doc -> Doc -> Doc
<> ([Doc] -> Doc
vcat ([Doc]
r2))
,Tag
i2)
where
(Doc
r1, Tag
i1) = Tag -> Tag -> Bool -> Expr Bool -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
2) (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Bool
True Expr Bool
e
([Doc]
r2, Tag
i2) = Tag -> Tag -> Bool -> [UExpr] -> ([Doc], Tag)
ppUExprL (Tag
i1Tag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) (Tag
i1) Bool
True [UExpr]
args
ppUExprL :: Int -> Int -> Bool -> [UExpr] -> ([Doc], Int)
ppUExprL :: Tag -> Tag -> Bool -> [UExpr] -> ([Doc], Tag)
ppUExprL Tag
i Tag
_ Bool
_ [] = ([], Tag
i)
ppUExprL Tag
i Tag
pere Bool
bb (UExpr
a:[UExpr]
b) = ((Doc
r1Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
r2), Tag
i2)
where
(Doc
r1, Tag
i1) = Tag -> Tag -> Bool -> UExpr -> (Doc, Tag)
ppUExpr Tag
i Tag
pere Bool
bb UExpr
a
([Doc]
r2, Tag
i2) = Tag -> Tag -> Bool -> [UExpr] -> ([Doc], Tag)
ppUExprL Tag
i1 Tag
pere Bool
bb [UExpr]
b
ppObserver :: Int -> Observer -> (Doc, Int)
ppObserver :: Tag -> Observer -> (Doc, Tag)
ppObserver Tag
i
Observer
{ observerName :: Observer -> String
observerName = String
name
, observerExpr :: ()
observerExpr = Expr a
e }
=
(String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"observer: \n%s\",color=mediumblue, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) String
name::String)
Doc -> Doc -> Doc
<> Doc
r1, Tag
i1)
where (Doc
r1, Tag
i1) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Tag
i Bool
True Expr a
e
ppProperty :: Int -> Property -> (Doc, Int)
ppProperty :: Tag -> Property -> (Doc, Tag)
ppProperty Tag
i
Property
{ propertyName :: Property -> String
propertyName = String
name
, propertyExpr :: Property -> Expr Bool
propertyExpr = Expr Bool
e }
=
(String -> Doc
text (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s [label=\"property: \n%s\",color=mediumblue, style=filled]\n" (Tag -> String
forall a. Show a => a -> String
show Tag
i::String) String
name::String)
Doc -> Doc -> Doc
<> Doc
r1, Tag
i1)
where (Doc
r1, Tag
i1) = Tag -> Tag -> Bool -> Expr Bool -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot (Tag
iTag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
1) Tag
i Bool
True Expr Bool
e
ppStreamL :: Int -> [Stream] -> (Doc, Int)
ppStreamL :: Tag -> [Stream] -> (Doc, Tag)
ppStreamL Tag
i [] = (Doc
empty,Tag
i)
ppStreamL Tag
i (Stream
a:[Stream]
b) = ((Doc
s1Doc -> Doc -> Doc
$$Doc
s2),(Tag
i2))
where
(Doc
s1,Tag
i1) = Tag -> Stream -> (Doc, Tag)
ppStream Tag
i Stream
a
(Doc
s2,Tag
i2) = Tag -> [Stream] -> (Doc, Tag)
ppStreamL Tag
i1 [Stream]
b
ppTriggerL :: Int -> [Trigger] -> (Doc, Int)
ppTriggerL :: Tag -> [Trigger] -> (Doc, Tag)
ppTriggerL Tag
i [] = (Doc
empty,Tag
i)
ppTriggerL Tag
i (Trigger
a:[Trigger]
b) = ((Doc
s1Doc -> Doc -> Doc
$$Doc
s2),(Tag
i2))
where
(Doc
s1,Tag
i1) = Tag -> Trigger -> (Doc, Tag)
ppTrigger Tag
i Trigger
a
(Doc
s2,Tag
i2) = Tag -> [Trigger] -> (Doc, Tag)
ppTriggerL Tag
i1 [Trigger]
b
ppObserverL :: Int -> [Observer] -> (Doc, Int)
ppObserverL :: Tag -> [Observer] -> (Doc, Tag)
ppObserverL Tag
i [] = (Doc
empty,Tag
i)
ppObserverL Tag
i (Observer
a:[Observer]
b) = ((Doc
s1Doc -> Doc -> Doc
$$Doc
s2),(Tag
i2))
where
(Doc
s1,Tag
i1) = Tag -> Observer -> (Doc, Tag)
ppObserver Tag
i Observer
a
(Doc
s2,Tag
i2) = Tag -> [Observer] -> (Doc, Tag)
ppObserverL Tag
i1 [Observer]
b
ppPropertyL :: Int -> [Property] -> (Doc, Int)
ppPropertyL :: Tag -> [Property] -> (Doc, Tag)
ppPropertyL Tag
i [] = (Doc
empty,Tag
i)
ppPropertyL Tag
i (Property
a:[Property]
b) = ((Doc
s1Doc -> Doc -> Doc
$$Doc
s2),(Tag
i2))
where
(Doc
s1,Tag
i1) = Tag -> Property -> (Doc, Tag)
ppProperty Tag
i Property
a
(Doc
s2,Tag
i2) = Tag -> [Property] -> (Doc, Tag)
ppPropertyL Tag
i1 [Property]
b
ppSpecDot :: Int -> Spec -> (Doc, Int)
ppSpecDot :: Tag -> Spec -> (Doc, Tag)
ppSpecDot Tag
i Spec
spec =
((Doc
aa Doc -> Doc -> Doc
$$ Doc
cs Doc -> Doc -> Doc
$$ Doc
ds Doc -> Doc -> Doc
$$ Doc
es Doc -> Doc -> Doc
$$ Doc
fs Doc -> Doc -> Doc
$$ Doc
bb),Tag
i4)
where
aa :: Doc
aa = String -> Doc
text String
"digraph G {\nnode [shape=box]\n"
(Doc
cs, Tag
i1) = Tag -> [Stream] -> (Doc, Tag)
ppStreamL Tag
i (Spec -> [Stream]
specStreams Spec
spec)
(Doc
ds, Tag
i2) = Tag -> [Trigger] -> (Doc, Tag)
ppTriggerL Tag
i1 (Spec -> [Trigger]
specTriggers Spec
spec)
(Doc
es, Tag
i3) = Tag -> [Observer] -> (Doc, Tag)
ppObserverL Tag
i2 (Spec -> [Observer]
specObservers Spec
spec)
(Doc
fs, Tag
i4) = Tag -> [Property] -> (Doc, Tag)
ppPropertyL Tag
i3 (Spec -> [Property]
specProperties Spec
spec)
bb :: Doc
bb = String -> Doc
text String
"\n}\n"
prettyPrintExprDot :: Bool -> Expr a -> String
prettyPrintExprDot :: Bool -> Expr a -> String
prettyPrintExprDot Bool
bb Expr a
s = Doc -> String
render Doc
rr
where
(Doc
r1, Tag
_) = Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
forall a. Tag -> Tag -> Bool -> Expr a -> (Doc, Tag)
ppExprDot Tag
1 Tag
0 Bool
bb Expr a
s
rr :: Doc
rr = String -> Doc
text String
"digraph G {\nnode [shape=box]\n" Doc -> Doc -> Doc
$$ (String -> Doc
text String
"0 [label=\"file: \n?????\",color=red, style=filled]\n") Doc -> Doc -> Doc
<> Doc
r1 Doc -> Doc -> Doc
$$ String -> Doc
text String
"\n}\n"
prettyPrintDot :: Spec -> String
prettyPrintDot :: Spec -> String
prettyPrintDot Spec
s = Doc -> String
render Doc
r1
where (Doc
r1, Tag
_) = Tag -> Spec -> (Doc, Tag)
ppSpecDot Tag
0 Spec
s