{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData      #-}
module Language.GLSL.Optimizer.DFG where

import           Control.Monad.Trans.State (StateT, execState, get, modify',
                                            put)
import           Data.Foldable             (forM_)
import           Data.Functor              (void)
import           Data.Functor.Identity     (Identity)
import           Data.Graph.Inductive      (Node)
import qualified Data.Graph.Inductive      as G
import qualified Data.GraphViz             as GV
import qualified Data.GraphViz.Printing    as GV
import qualified Data.Text.Lazy.IO         as IO
import           Language.GLSL.AST
import           Language.GLSL.Decls
import           Language.GLSL.PrettyPrint (pp, ppName, ppNamespace)

--------------------------------------------------------------------------------

data DFG = DFG
  { DFG -> Gr DFGNode DFGEdge
gr         :: G.Gr DFGNode DFGEdge
  , DFG -> Decls Node
decls      :: Decls Node
  , DFG -> Node
nextNodeId :: Node
  , DFG -> Maybe Node
ifCond     :: Maybe Node
  }

emptyDFG :: DFG
emptyDFG :: DFG
emptyDFG = DFG :: Gr DFGNode DFGEdge -> Decls Node -> Node -> Maybe Node -> DFG
DFG
  { gr :: Gr DFGNode DFGEdge
gr = Gr DFGNode DFGEdge
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
G.empty
  , decls :: Decls Node
decls = Decls Node
forall a. Decls a
emptyDecls
  , nextNodeId :: Node
nextNodeId = Node
0
  , ifCond :: Maybe Node
ifCond = Maybe Node
forall a. Maybe a
Nothing
  }

data DFGEdge = DFGEdge
  deriving (Node -> DFGEdge -> ShowS
[DFGEdge] -> ShowS
DFGEdge -> String
(Node -> DFGEdge -> ShowS)
-> (DFGEdge -> String) -> ([DFGEdge] -> ShowS) -> Show DFGEdge
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFGEdge] -> ShowS
$cshowList :: [DFGEdge] -> ShowS
show :: DFGEdge -> String
$cshow :: DFGEdge -> String
showsPrec :: Node -> DFGEdge -> ShowS
$cshowsPrec :: Node -> DFGEdge -> ShowS
Show)

data DFGNode
  = DFGNode Namespace NameId
  deriving (Node -> DFGNode -> ShowS
[DFGNode] -> ShowS
DFGNode -> String
(Node -> DFGNode -> ShowS)
-> (DFGNode -> String) -> ([DFGNode] -> ShowS) -> Show DFGNode
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFGNode] -> ShowS
$cshowList :: [DFGNode] -> ShowS
show :: DFGNode -> String
$cshow :: DFGNode -> String
showsPrec :: Node -> DFGNode -> ShowS
$cshowsPrec :: Node -> DFGNode -> ShowS
Show)

type DFGState = StateT DFG Identity

genDFG :: GLSL a -> DFG
genDFG :: GLSL a -> DFG
genDFG GLSL a
prog = State DFG () -> DFG -> DFG
forall s a. State s a -> s -> s
execState (GLSL a -> State DFG ()
forall a. GLSL a -> State DFG ()
dfgGLSL GLSL a
prog) DFG
emptyDFG

dfgGLSL :: GLSL a -> DFGState ()
dfgGLSL :: GLSL a -> State DFG ()
dfgGLSL (GLSL Version
_ [TopDecl a]
decls) = (TopDecl a -> State DFG ()) -> [TopDecl a] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TopDecl a -> State DFG ()
forall a. TopDecl a -> State DFG ()
dfgTopDecl [TopDecl a]
decls

dfgTopDecl :: TopDecl a -> DFGState ()
dfgTopDecl :: TopDecl a -> State DFG ()
dfgTopDecl (LayoutDecl LayoutSpec
_ GlobalDecl
d)     = GlobalDecl -> State DFG ()
dfgGlobalDecl GlobalDecl
d
dfgTopDecl (GlobalDecl GlobalDecl
d)       = GlobalDecl -> State DFG ()
dfgGlobalDecl GlobalDecl
d
dfgTopDecl (ProcDecl ProcName
_ [ParamDecl]
_ [StmtAnnot a]
stmts) = (StmtAnnot a -> State DFG ()) -> [StmtAnnot a] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ StmtAnnot a -> State DFG ()
forall a. StmtAnnot a -> State DFG ()
dfgStmtAnnot [StmtAnnot a]
stmts

dfgGlobalDecl :: GlobalDecl -> DFGState ()
dfgGlobalDecl :: GlobalDecl -> State DFG ()
dfgGlobalDecl (GDecl GDeclKind
_ (TyStruct NameId
_ [(Type, NameId)]
ms) (Name Namespace
NsU NameId
n)) =
  ((Type, NameId) -> State DFG ())
-> [(Type, NameId)] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (NameId -> (Type, NameId) -> State DFG ()
dfgStructMember NameId
n) [(Type, NameId)]
ms
dfgGlobalDecl (GDecl GDeclKind
_ Type
_ (Name Namespace
ns NameId
n)) =
  StateT DFG Identity Node -> State DFG ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT DFG Identity Node -> State DFG ())
-> StateT DFG Identity Node -> State DFG ()
forall a b. (a -> b) -> a -> b
$ Namespace -> NameId -> StateT DFG Identity Node
addNode Namespace
ns NameId
n

dfgStructMember :: NameId -> (Type, NameId) -> DFGState ()
dfgStructMember :: NameId -> (Type, NameId) -> State DFG ()
dfgStructMember NameId
n (Type
_, NameId
m) = StateT DFG Identity Node -> State DFG ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT DFG Identity Node -> State DFG ())
-> StateT DFG Identity Node -> State DFG ()
forall a b. (a -> b) -> a -> b
$ Namespace -> NameId -> StateT DFG Identity Node
addNode Namespace
NsU ((NameId, NameId) -> NameId
toUniformId (NameId
n, NameId
m))

dfgStmt :: Stmt a -> DFGState ()
dfgStmt :: Stmt a -> State DFG ()
dfgStmt (DeclStmt LocalDecl
d)     = LocalDecl -> State DFG ()
dfgLocalDecl LocalDecl
d
dfgStmt (AssignStmt Name
n Expr
e) = do
  Node
targetId <- Name -> StateT DFG Identity Node
nodeForName Name
n
  DFG{Maybe Node
ifCond :: Maybe Node
ifCond :: DFG -> Maybe Node
ifCond} <- StateT DFG Identity DFG
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Maybe Node -> (Node -> State DFG ()) -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Node
ifCond (Node -> Node -> State DFG ()
addEdge Node
targetId)
  Expr -> Node -> State DFG ()
dfgExpr Expr
e Node
targetId
dfgStmt (IfStmt NameId
c [StmtAnnot a]
t [StmtAnnot a]
e) = do
  Maybe Node
ifCond <- Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node)
-> StateT DFG Identity Node -> StateT DFG Identity (Maybe Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> NameId -> StateT DFG Identity Node
nodeFor Namespace
NsT NameId
c
  (DFG -> DFG) -> State DFG ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DFG -> DFG) -> State DFG ()) -> (DFG -> DFG) -> State DFG ()
forall a b. (a -> b) -> a -> b
$ \DFG
dfg -> DFG
dfg{Maybe Node
ifCond :: Maybe Node
ifCond :: Maybe Node
ifCond}
  (StmtAnnot a -> State DFG ()) -> [StmtAnnot a] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ StmtAnnot a -> State DFG ()
forall a. StmtAnnot a -> State DFG ()
dfgStmtAnnot ([StmtAnnot a]
t [StmtAnnot a] -> [StmtAnnot a] -> [StmtAnnot a]
forall a. [a] -> [a] -> [a]
++ [StmtAnnot a]
e)
  (DFG -> DFG) -> State DFG ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DFG -> DFG) -> State DFG ()) -> (DFG -> DFG) -> State DFG ()
forall a b. (a -> b) -> a -> b
$ \DFG
dfg -> DFG
dfg{ifCond :: Maybe Node
ifCond=Maybe Node
forall a. Maybe a
Nothing}
dfgStmt Stmt a
_                = () -> State DFG ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

dfgStmtAnnot :: StmtAnnot a -> DFGState ()
dfgStmtAnnot :: StmtAnnot a -> State DFG ()
dfgStmtAnnot (SA a
_ Stmt a
s) = Stmt a -> State DFG ()
forall a. Stmt a -> State DFG ()
dfgStmt Stmt a
s

dfgLocalDecl :: LocalDecl -> DFGState ()
dfgLocalDecl :: LocalDecl -> State DFG ()
dfgLocalDecl (LDecl Type
_ NameId
n Maybe Expr
e) = do
  Node
nodeId <- Namespace -> NameId -> StateT DFG Identity Node
addNode Namespace
NsT NameId
n
  State DFG ()
-> (Expr -> State DFG ()) -> Maybe Expr -> State DFG ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> State DFG ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Expr -> Node -> State DFG ()
`dfgExpr` Node
nodeId) Maybe Expr
e

dfgExpr :: Expr -> Node -> DFGState ()
dfgExpr :: Expr -> Node -> State DFG ()
dfgExpr (FunCallExpr FunName
_ [ExprAtom]
args) Node
declNode = (ExprAtom -> State DFG ()) -> [ExprAtom] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ExprAtom -> Node -> State DFG ()
`dfgExprAtom` Node
declNode) [ExprAtom]
args
dfgExpr (TextureExpr ExprAtom
t ExprAtom
x ExprAtom
y) Node
declNode  = (ExprAtom -> State DFG ()) -> [ExprAtom] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ExprAtom -> Node -> State DFG ()
`dfgExprAtom` Node
declNode) [ExprAtom
t, ExprAtom
x, ExprAtom
y]
dfgExpr (UnaryExpr UnaryOp
_ ExprAtom
e) Node
declNode      = ExprAtom -> Node -> State DFG ()
dfgExprAtom ExprAtom
e Node
declNode
dfgExpr (AtomExpr ExprAtom
e) Node
declNode         = ExprAtom -> Node -> State DFG ()
dfgExprAtom ExprAtom
e Node
declNode
dfgExpr (BinaryExpr ExprAtom
l BinaryOp
_ ExprAtom
r) Node
declNode   = (ExprAtom -> State DFG ()) -> [ExprAtom] -> State DFG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ExprAtom -> Node -> State DFG ()
`dfgExprAtom` Node
declNode) [ExprAtom
l, ExprAtom
r]

dfgExprAtom :: ExprAtom -> Node -> DFGState ()
dfgExprAtom :: ExprAtom -> Node -> State DFG ()
dfgExprAtom LitIntExpr{} Node
_                = () -> State DFG ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
dfgExprAtom LitFloatExpr{} Node
_              = () -> State DFG ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
dfgExprAtom (IdentifierExpr NameExpr
n) Node
declNode   = NameExpr -> StateT DFG Identity Node
nodeForNameExpr NameExpr
n StateT DFG Identity Node -> (Node -> State DFG ()) -> State DFG ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node -> Node -> State DFG ()
addEdge Node
declNode
dfgExprAtom (SwizzleExpr NameId
n Swizzle
_)  Node
declNode   = Namespace -> NameId -> StateT DFG Identity Node
nodeFor Namespace
NsT NameId
n StateT DFG Identity Node -> (Node -> State DFG ()) -> State DFG ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node -> Node -> State DFG ()
addEdge Node
declNode
dfgExprAtom (VecIndexExpr NameExpr
n Swizzle
_) Node
declNode   = NameExpr -> StateT DFG Identity Node
nodeForNameExpr NameExpr
n StateT DFG Identity Node -> (Node -> State DFG ()) -> State DFG ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node -> Node -> State DFG ()
addEdge Node
declNode
dfgExprAtom (MatIndexExpr NameExpr
n Swizzle
_ Swizzle
_) Node
declNode = NameExpr -> StateT DFG Identity Node
nodeForNameExpr NameExpr
n StateT DFG Identity Node -> (Node -> State DFG ()) -> State DFG ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node -> Node -> State DFG ()
addEdge Node
declNode


nodeForUniform :: NameId -> NameId -> DFGState Node
nodeForUniform :: NameId -> NameId -> StateT DFG Identity Node
nodeForUniform NameId
n NameId
m = do
  DFG{Node
Maybe Node
Gr DFGNode DFGEdge
Decls Node
ifCond :: Maybe Node
nextNodeId :: Node
decls :: Decls Node
gr :: Gr DFGNode DFGEdge
ifCond :: DFG -> Maybe Node
nextNodeId :: DFG -> Node
decls :: DFG -> Decls Node
gr :: DFG -> Gr DFGNode DFGEdge
..} <- StateT DFG Identity DFG
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let i :: NameId
i = (NameId, NameId) -> NameId
toUniformId (NameId
n, NameId
m)
  case Namespace -> NameId -> Decls Node -> Maybe Node
forall a. Namespace -> NameId -> Decls a -> Maybe a
getDecl Namespace
NsU NameId
i Decls Node
decls of
    Maybe Node
Nothing -> String -> StateT DFG Identity Node
forall a. HasCallStack => String -> a
error (String -> StateT DFG Identity Node)
-> String -> StateT DFG Identity Node
forall a b. (a -> b) -> a -> b
$ String
"no node for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NameId -> String
showUniformId NameId
i
    Just Node
ok -> Node -> StateT DFG Identity Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
ok

nodeForNameExpr :: NameExpr -> DFGState Node
nodeForNameExpr :: NameExpr -> StateT DFG Identity Node
nodeForNameExpr (NameExpr Name
n)      = Name -> StateT DFG Identity Node
nodeForName Name
n
nodeForNameExpr (UniformExpr NameId
n NameId
m) = NameId -> NameId -> StateT DFG Identity Node
nodeForUniform NameId
n NameId
m

nodeForName :: Name -> DFGState Node
nodeForName :: Name -> StateT DFG Identity Node
nodeForName (Name Namespace
ns NameId
n) = Namespace -> NameId -> StateT DFG Identity Node
nodeFor Namespace
ns NameId
n

nodeFor :: Namespace -> NameId -> DFGState Node
nodeFor :: Namespace -> NameId -> StateT DFG Identity Node
nodeFor Namespace
ns NameId
n = do
  DFG{Node
Maybe Node
Gr DFGNode DFGEdge
Decls Node
ifCond :: Maybe Node
nextNodeId :: Node
decls :: Decls Node
gr :: Gr DFGNode DFGEdge
ifCond :: DFG -> Maybe Node
nextNodeId :: DFG -> Node
decls :: DFG -> Decls Node
gr :: DFG -> Gr DFGNode DFGEdge
..} <- StateT DFG Identity DFG
forall (m :: * -> *) s. Monad m => StateT s m s
get
  case Namespace -> NameId -> Decls Node -> Maybe Node
forall a. Namespace -> NameId -> Decls a -> Maybe a
getDecl Namespace
ns NameId
n Decls Node
decls of
    Maybe Node
Nothing -> String -> StateT DFG Identity Node
forall a. HasCallStack => String -> a
error (String -> StateT DFG Identity Node)
-> String -> StateT DFG Identity Node
forall a b. (a -> b) -> a -> b
$ String
"no node for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Name -> Builder) -> Name -> String
forall a. (a -> Builder) -> a -> String
pp Name -> Builder
ppName (Namespace -> NameId -> Name
Name Namespace
ns NameId
n)
    Just Node
ok -> Node -> StateT DFG Identity Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
ok

addEdge :: Node -> Node -> DFGState ()
addEdge :: Node -> Node -> State DFG ()
addEdge Node
declNode Node
idNode =
  (DFG -> DFG) -> State DFG ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DFG -> DFG) -> State DFG ()) -> (DFG -> DFG) -> State DFG ()
forall a b. (a -> b) -> a -> b
$ \g :: DFG
g@DFG{Gr DFGNode DFGEdge
gr :: Gr DFGNode DFGEdge
gr :: DFG -> Gr DFGNode DFGEdge
gr} -> DFG
g { gr :: Gr DFGNode DFGEdge
gr = LEdge DFGEdge -> Gr DFGNode DFGEdge -> Gr DFGNode DFGEdge
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
G.insEdge (Node
declNode, Node
idNode, DFGEdge
DFGEdge) Gr DFGNode DFGEdge
gr }

addNode :: Namespace -> NameId -> DFGState Node
addNode :: Namespace -> NameId -> StateT DFG Identity Node
addNode Namespace
ns NameId
n = do
  g :: DFG
g@DFG{Node
Maybe Node
Gr DFGNode DFGEdge
Decls Node
ifCond :: Maybe Node
nextNodeId :: Node
decls :: Decls Node
gr :: Gr DFGNode DFGEdge
ifCond :: DFG -> Maybe Node
nextNodeId :: DFG -> Node
decls :: DFG -> Decls Node
gr :: DFG -> Gr DFGNode DFGEdge
..} <- StateT DFG Identity DFG
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let nodeId :: Node
nodeId = Node
nextNodeId
  DFG -> State DFG ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put DFG
g { gr :: Gr DFGNode DFGEdge
gr = LNode DFGNode -> Gr DFGNode DFGEdge -> Gr DFGNode DFGEdge
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
G.insNode (Node
nodeId, Namespace -> NameId -> DFGNode
DFGNode Namespace
ns NameId
n) Gr DFGNode DFGEdge
gr
        , decls :: Decls Node
decls = Namespace -> NameId -> Node -> Decls Node -> Decls Node
forall a. Namespace -> NameId -> a -> Decls a -> Decls a
addDecl Namespace
ns NameId
n Node
nodeId Decls Node
decls
        , nextNodeId :: Node
nextNodeId = Node
nextNodeId Node -> Node -> Node
forall a. Num a => a -> a -> a
+ Node
1
        }
  Node -> StateT DFG Identity Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
nodeId

--------------------------------------------------------------------------------
-- Visualisation
--------------------------------------------------------------------------------

instance GV.Labellable DFGNode where
  toLabelValue :: DFGNode -> Label
toLabelValue (DFGNode Namespace
NsU NameId
i) = String -> Label
forall a. Labellable a => a -> Label
GV.toLabelValue (String -> Label) -> String -> Label
forall a b. (a -> b) -> a -> b
$ NameId -> String
showUniformId NameId
i
  toLabelValue (DFGNode Namespace
ns NameId
n) = String -> Label
forall a. Labellable a => a -> Label
GV.toLabelValue (String -> Label) -> String -> Label
forall a b. (a -> b) -> a -> b
$
    (Namespace -> Builder) -> Namespace -> String
forall a. (a -> Builder) -> a -> String
pp Namespace -> Builder
ppNamespace Namespace
ns String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NameId -> String
forall a. Show a => a -> String
show NameId
n

instance GV.Labellable DFGEdge where
  toLabelValue :: DFGEdge -> Label
toLabelValue DFGEdge
DFGEdge = String -> Label
forall a. Labellable a => a -> Label
GV.toLabelValue String
""

toDot :: FilePath -> DFG -> IO ()
toDot :: String -> DFG -> IO ()
toDot String
path =
  String -> Text -> IO ()
IO.writeFile String
path (Text -> IO ()) -> (DFG -> Text) -> DFG -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph Node -> Text
forall a. PrintDot a => a -> Text
GV.printIt (DotGraph Node -> Text) -> (DFG -> DotGraph Node) -> DFG -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphvizParams Node DFGNode DFGEdge () DFGNode
-> Gr DFGNode DFGEdge -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
GV.graphToDot GraphvizParams Node DFGNode DFGEdge () DFGNode
forall nl el n.
(Labellable nl, Labellable el) =>
GraphvizParams n nl el () nl
GV.quickParams (Gr DFGNode DFGEdge -> DotGraph Node)
-> (DFG -> Gr DFGNode DFGEdge) -> DFG -> DotGraph Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFG -> Gr DFGNode DFGEdge
gr

toSvg :: DFG -> FilePath -> IO FilePath
toSvg :: DFG -> String -> IO String
toSvg DFG{Gr DFGNode DFGEdge
gr :: Gr DFGNode DFGEdge
gr :: DFG -> Gr DFGNode DFGEdge
gr} = DotGraph Node -> GraphvizOutput -> String -> IO String
forall (dg :: * -> *) n.
PrintDotRepr dg n =>
dg n -> GraphvizOutput -> String -> IO String
GV.runGraphviz (GraphvizParams Node DFGNode DFGEdge () DFGNode
-> Gr DFGNode DFGEdge -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
GV.graphToDot GraphvizParams Node DFGNode DFGEdge () DFGNode
forall nl el n.
(Labellable nl, Labellable el) =>
GraphvizParams n nl el () nl
GV.quickParams Gr DFGNode DFGEdge
gr) GraphvizOutput
GV.Svg