-- Copyright (C) 2018-2024 Jun Zhang <zhangjunphy[at]gmail[dot]com>
--
-- This file is a part of decafc.
--
-- decafc is free software: you can redistribute it and/or modify it under the
-- terms of the MIT (X11) License as described in the LICENSE file.
--
-- decafc is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE.  See the X11 license for more details.

module CFG.Plot (fileCFGsToDot) where

import AST qualified
import CFG.Build
import CFG.Types
import Control.Lens (use, uses, view, (%=), (%~), (&), (+=), (.=), (.~), (^.), _1, _2, _3, _Just)
import Data.Functor ((<&>))
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LT
import Formatting
import SSA qualified
import Semantic qualified as SE
import Types
import Util.Graph qualified as G
import Util.Constants (globalScopeID)

-- Reorder some backward edges introduced by loops so graphviz could find a
-- clear ordering of the nodes.
findBackEdges :: CFG -> Set (BBID, BBID)
findBackEdges :: CFG -> Set (BBID, BBID)
findBackEdges (CFG Graph BBID BasicBlock CFGEdge
g BBID
_ BBID
_ [Var]
_ MethodSig
_) =
  [(BBID, BBID)] -> Set (BBID, BBID)
forall a. Ord a => [a] -> Set a
Set.fromList ([(BBID, BBID)] -> Set (BBID, BBID))
-> [(BBID, BBID)] -> Set (BBID, BBID)
forall a b. (a -> b) -> a -> b
$
    ((BBID, BBID) -> Bool) -> [(BBID, BBID)] -> [(BBID, BBID)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((BBID -> BBID -> Bool) -> (BBID, BBID) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BBID -> BBID -> Bool
forall a. Ord a => a -> a -> Bool
(>)) ([(BBID, BBID)] -> [(BBID, BBID)])
-> [(BBID, BBID)] -> [(BBID, BBID)]
forall a b. (a -> b) -> a -> b
$
      ((BBID, BBID, CFGEdge) -> (BBID, BBID))
-> [(BBID, BBID, CFGEdge)] -> [(BBID, BBID)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(BBID
b1, BBID
b2, CFGEdge
_) -> (BBID
b1, BBID
b2)) (Graph BBID BasicBlock CFGEdge -> [(BBID, BBID, CFGEdge)]
forall ni nd ed.
(Eq ni, Ord ni) =>
Graph ni nd ed -> [(ni, ni, ed)]
G.edgeToList Graph BBID BasicBlock CFGEdge
g)

data GVizNode = GVizNode
  { GVizNode -> BBID
id :: !BBID,
    GVizNode -> Text
label :: !Text,
    GVizNode -> Maybe Text
rank :: !(Maybe Text)
  }

instance Show GVizNode where
  show :: GVizNode -> String
show (GVizNode BBID
id Text
label (Just Text
rank)) = Format String (BBID -> Text -> Text -> String)
-> BBID -> Text -> Text -> String
forall a. Format String a -> a
formatToString (Format (Text -> Text -> String) (BBID -> Text -> Text -> String)
forall a r. Integral a => Format r (a -> r)
int Format (Text -> Text -> String) (BBID -> Text -> Text -> String)
-> Format String (Text -> Text -> String)
-> Format String (BBID -> Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Text -> Text -> String) (Text -> Text -> String)
"[label=\"" Format (Text -> Text -> String) (Text -> Text -> String)
-> Format String (Text -> Text -> String)
-> Format String (Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> String) (Text -> Text -> String)
forall r. Format r (Text -> r)
stext Format (Text -> String) (Text -> Text -> String)
-> Format String (Text -> String)
-> Format String (Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> String) (Text -> String)
"\", rank=\"" Format (Text -> String) (Text -> String)
-> Format String (Text -> String) -> Format String (Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String (Text -> String)
forall r. Format r (Text -> r)
stext Format String (Text -> String)
-> Format String String -> Format String (Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String String
"\"]") BBID
id Text
label Text
rank
  show (GVizNode BBID
id Text
label Maybe Text
Nothing) = Format String (BBID -> Text -> String) -> BBID -> Text -> String
forall a. Format String a -> a
formatToString (Format (Text -> String) (BBID -> Text -> String)
forall a r. Integral a => Format r (a -> r)
int Format (Text -> String) (BBID -> Text -> String)
-> Format String (Text -> String)
-> Format String (BBID -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Text -> String) (Text -> String)
"[label=\"" Format (Text -> String) (Text -> String)
-> Format String (Text -> String) -> Format String (Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String (Text -> String)
forall r. Format r (Text -> r)
stext Format String (Text -> String)
-> Format String String -> Format String (Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String String
"\"]") BBID
id Text
label

data GVizEdge = GVizEdge
  { GVizEdge -> BBID
from :: !BBID,
    GVizEdge -> BBID
to :: !BBID,
    GVizEdge -> Text
label :: !Text,
    GVizEdge -> Text
dir :: !Text
  }

instance Show GVizEdge where
  show :: GVizEdge -> String
show (GVizEdge BBID
from BBID
to Text
label Text
dir) =
    Format String (BBID -> BBID -> Text -> Text -> String)
-> BBID -> BBID -> Text -> Text -> String
forall a. Format String a -> a
formatToString
      (Format
  (BBID -> Text -> Text -> String)
  (BBID -> BBID -> Text -> Text -> String)
forall a r. Integral a => Format r (a -> r)
int Format
  (BBID -> Text -> Text -> String)
  (BBID -> BBID -> Text -> Text -> String)
-> Format String (BBID -> Text -> Text -> String)
-> Format String (BBID -> BBID -> Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format
  (BBID -> Text -> Text -> String) (BBID -> Text -> Text -> String)
"->" Format
  (BBID -> Text -> Text -> String) (BBID -> Text -> Text -> String)
-> Format String (BBID -> Text -> Text -> String)
-> Format String (BBID -> Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Text -> Text -> String) (BBID -> Text -> Text -> String)
forall a r. Integral a => Format r (a -> r)
int Format (Text -> Text -> String) (BBID -> Text -> Text -> String)
-> Format String (Text -> Text -> String)
-> Format String (BBID -> Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Text -> Text -> String) (Text -> Text -> String)
"[label=\"" Format (Text -> Text -> String) (Text -> Text -> String)
-> Format String (Text -> Text -> String)
-> Format String (Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> String) (Text -> Text -> String)
forall r. Format r (Text -> r)
stext Format (Text -> String) (Text -> Text -> String)
-> Format String (Text -> String)
-> Format String (Text -> Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> String) (Text -> String)
"\", dir=" Format (Text -> String) (Text -> String)
-> Format String (Text -> String) -> Format String (Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String (Text -> String)
forall r. Format r (Text -> r)
stext Format String (Text -> String)
-> Format String String -> Format String (Text -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String String
"]")
      BBID
from
      BBID
to
      Text
label
      Text
dir

data GVizSubgraph = GVizSubgraph
  { GVizSubgraph -> Text
name :: !Text,
    GVizSubgraph -> [GVizNode]
nodes :: ![GVizNode],
    GVizSubgraph -> [GVizEdge]
edges :: ![GVizEdge]
  }

instance Show GVizSubgraph where
  show :: GVizSubgraph -> String
show (GVizSubgraph Text
name [GVizNode]
nodes [GVizEdge]
edges) =
    Format String (Text -> [GVizNode] -> [GVizEdge] -> String)
-> Text -> [GVizNode] -> [GVizEdge] -> String
forall a. Format String a -> a
formatToString
      ( Format
  (Text -> [GVizNode] -> [GVizEdge] -> String)
  (Text -> [GVizNode] -> [GVizEdge] -> String)
"subgraph"
          Format
  (Text -> [GVizNode] -> [GVizEdge] -> String)
  (Text -> [GVizNode] -> [GVizEdge] -> String)
-> Format String (Text -> [GVizNode] -> [GVizEdge] -> String)
-> Format String (Text -> [GVizNode] -> [GVizEdge] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format
  ([GVizNode] -> [GVizEdge] -> String)
  (Text -> [GVizNode] -> [GVizEdge] -> String)
forall r. Format r (Text -> r)
stext
          Format
  ([GVizNode] -> [GVizEdge] -> String)
  (Text -> [GVizNode] -> [GVizEdge] -> String)
-> Format String ([GVizNode] -> [GVizEdge] -> String)
-> Format String (Text -> [GVizNode] -> [GVizEdge] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format
  ([GVizNode] -> [GVizEdge] -> String)
  ([GVizNode] -> [GVizEdge] -> String)
"{\n"
          Format
  ([GVizNode] -> [GVizEdge] -> String)
  ([GVizNode] -> [GVizEdge] -> String)
-> Format String ([GVizNode] -> [GVizEdge] -> String)
-> Format String ([GVizNode] -> [GVizEdge] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (GVizNode -> Builder)
-> Format
     ([GVizEdge] -> String) ([GVizNode] -> [GVizEdge] -> String)
forall (t :: * -> *) a r.
Foldable t =>
Format Builder (a -> Builder) -> Format r (t a -> r)
concatenated (Format Builder (GVizNode -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format Builder (GVizNode -> Builder)
-> Format Builder Builder -> Format Builder (GVizNode -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
";\n")
          Format ([GVizEdge] -> String) ([GVizNode] -> [GVizEdge] -> String)
-> Format String ([GVizEdge] -> String)
-> Format String ([GVizNode] -> [GVizEdge] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (GVizEdge -> Builder)
-> Format String ([GVizEdge] -> String)
forall (t :: * -> *) a r.
Foldable t =>
Format Builder (a -> Builder) -> Format r (t a -> r)
concatenated (Format Builder (GVizEdge -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format Builder (GVizEdge -> Builder)
-> Format Builder Builder -> Format Builder (GVizEdge -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
";\n")
          Format String ([GVizEdge] -> String)
-> Format String String -> Format String ([GVizEdge] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String String
"}"
      )
      Text
name
      [GVizNode]
nodes
      [GVizEdge]
edges

data GVizGraph = GVizGraph
  { GVizGraph -> [GVizSubgraph]
subgraphs :: ![GVizSubgraph],
    GVizGraph -> [GVizNode]
nodes :: ![GVizNode],
    GVizGraph -> [GVizEdge]
edges :: ![GVizEdge]
  }

instance Show GVizGraph where
  show :: GVizGraph -> String
show (GVizGraph [GVizSubgraph]
subgraphs [GVizNode]
nodes [GVizEdge]
edges) =
    Format
  String ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
-> [GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String
forall a. Format String a -> a
formatToString
      ( Format
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
"digraph {\n"
          Format
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
-> Format
     String ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
-> Format
     String ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
"node [shape=box];\n"
          Format
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
-> Format
     String ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
-> Format
     String ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (GVizNode -> Builder)
-> Format
     ([GVizEdge] -> [GVizSubgraph] -> String)
     ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
forall (t :: * -> *) a r.
Foldable t =>
Format Builder (a -> Builder) -> Format r (t a -> r)
concatenated (Format Builder (GVizNode -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format Builder (GVizNode -> Builder)
-> Format Builder Builder -> Format Builder (GVizNode -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
";\n")
          Format
  ([GVizEdge] -> [GVizSubgraph] -> String)
  ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
-> Format String ([GVizEdge] -> [GVizSubgraph] -> String)
-> Format
     String ([GVizNode] -> [GVizEdge] -> [GVizSubgraph] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (GVizEdge -> Builder)
-> Format
     ([GVizSubgraph] -> String) ([GVizEdge] -> [GVizSubgraph] -> String)
forall (t :: * -> *) a r.
Foldable t =>
Format Builder (a -> Builder) -> Format r (t a -> r)
concatenated (Format Builder (GVizEdge -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format Builder (GVizEdge -> Builder)
-> Format Builder Builder -> Format Builder (GVizEdge -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
";\n")
          Format
  ([GVizSubgraph] -> String) ([GVizEdge] -> [GVizSubgraph] -> String)
-> Format String ([GVizSubgraph] -> String)
-> Format String ([GVizEdge] -> [GVizSubgraph] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (GVizSubgraph -> Builder)
-> Format String ([GVizSubgraph] -> String)
forall (t :: * -> *) a r.
Foldable t =>
Format Builder (a -> Builder) -> Format r (t a -> r)
concatenated (Format Builder (GVizSubgraph -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format Builder (GVizSubgraph -> Builder)
-> Format Builder Builder
-> Format Builder (GVizSubgraph -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
"\n")
          Format String ([GVizSubgraph] -> String)
-> Format String String -> Format String ([GVizSubgraph] -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format String String
"}"
      )
      [GVizNode]
nodes
      [GVizEdge]
edges
      [GVizSubgraph]
subgraphs

basicBlockToNode :: CFG -> BasicBlock -> GVizNode
basicBlockToNode :: CFG -> BasicBlock -> GVizNode
basicBlockToNode (CFG Graph BBID BasicBlock CFGEdge
_ BBID
entry BBID
exit [Var]
args MethodSig
sig) BasicBlock {$sel:bbid:BasicBlock :: BasicBlock -> BBID
bbid = BBID
id, $sel:statements:BasicBlock :: BasicBlock -> [SSA]
statements = [SSA]
stmts} =
  let idText :: [Text]
idText = [Format Text (BBID -> Text -> Text) -> BBID -> Text -> Text
forall a. Format Text a -> a
sformat (Format (BBID -> Text -> Text) (BBID -> Text -> Text)
"<id:" Format (BBID -> Text -> Text) (BBID -> Text -> Text)
-> Format Text (BBID -> Text -> Text)
-> Format Text (BBID -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Text -> Text) (BBID -> Text -> Text)
forall a r. Integral a => Format r (a -> r)
int Format (Text -> Text) (BBID -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (BBID -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format Text (Text -> Text)
forall r. Format r (Text -> r)
stext Format Text (Text -> Text)
-> Format Text Text -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
">") BBID
id Text
entryExit]
      segments :: [Text]
segments = [SSA]
stmts [SSA] -> (SSA -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Format Text (SSA -> Text) -> SSA -> Text
forall a. Format Text a -> a
sformat Format Text (SSA -> Text)
forall a r. Show a => Format r (a -> r)
shown
   in BBID -> Text -> Maybe Text -> GVizNode
GVizNode BBID
id (Text -> [Text] -> Text
Text.intercalate Text
"\\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
idText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
segments) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"same")
  where
    ppVarWithType :: Format r (SSA.Var -> r)
    ppVarWithType :: forall r. Format r (Var -> r)
ppVarWithType = ((Type -> Const Type Type) -> Var -> Const Type Var)
-> Format r (Type -> r) -> Format r (Var -> r)
forall a b s t r.
((a -> Const a b) -> s -> Const a t)
-> Format r (a -> r) -> Format r (s -> r)
viewed (Type -> Const Type Type) -> Var -> Const Type Var
#tpe Format r (Type -> r)
forall a r. Show a => Format r (a -> r)
shown Format r (Var -> r) -> Format r (Var -> r) -> Format r (Var -> r)
forall r a.
Format r (a -> r) -> Format r (a -> r) -> Format r (a -> r)
<%+> Format r (Var -> r)
forall a r. Show a => Format r (a -> r)
shown
    methodAndArgs :: Text
methodAndArgs = Format Text (Text -> [Var] -> Text) -> Text -> [Var] -> Text
forall a. Format Text a -> a
sformat (Format ([Var] -> Text) (Text -> [Var] -> Text)
forall r. Format r (Text -> r)
stext Format ([Var] -> Text) (Text -> [Var] -> Text)
-> Format Text ([Var] -> Text)
-> Format Text (Text -> [Var] -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format ([Var] -> Text) ([Var] -> Text)
"(" Format ([Var] -> Text) ([Var] -> Text)
-> Format Text ([Var] -> Text) -> Format Text ([Var] -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Text
-> Format Builder (Var -> Builder) -> Format Text ([Var] -> Text)
forall (t :: * -> *) a r.
Foldable t =>
Text -> Format Builder (a -> Builder) -> Format r (t a -> r)
intercalated Text
", " Format Builder (Var -> Builder)
forall r. Format r (Var -> r)
ppVarWithType Format Text ([Var] -> Text)
-> Format Text Text -> Format Text ([Var] -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
")") (MethodSig -> Text
AST.mangle MethodSig
sig) [Var]
args
    entryExit :: Text
entryExit
      | BBID
id BBID -> BBID -> Bool
forall a. Eq a => a -> a -> Bool
== BBID
entry = Format Text (Text -> Text) -> Text -> Text
forall a. Format Text a -> a
sformat (Format (Text -> Text) (Text -> Text)
"[entry(" Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Text -> Text)
forall r. Format r (Text -> r)
stext Format Text (Text -> Text)
-> Format Text Text -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
")]") Text
methodAndArgs
      | BBID
id BBID -> BBID -> Bool
forall a. Eq a => a -> a -> Bool
== BBID
exit = Text
"[exit]"
      | Bool
otherwise = Text
""

prettyPrintEdge :: CFGEdge -> Text
prettyPrintEdge :: CFGEdge -> Text
prettyPrintEdge CFGEdge
SeqEdge = Text
""
prettyPrintEdge (CondEdge (Pred VarOrImm
var)) = Format Text (VarOrImm -> Text) -> VarOrImm -> Text
forall a. Format Text a -> a
sformat Format Text (VarOrImm -> Text)
forall a r. Show a => Format r (a -> r)
shown VarOrImm
var
prettyPrintEdge (CondEdge (Complement VarOrImm
var)) = Format Text (VarOrImm -> Text) -> VarOrImm -> Text
forall a. Format Text a -> a
sformat (Format (VarOrImm -> Text) (VarOrImm -> Text)
"!" Format (VarOrImm -> Text) (VarOrImm -> Text)
-> Format Text (VarOrImm -> Text) -> Format Text (VarOrImm -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (VarOrImm -> Text)
forall a r. Show a => Format r (a -> r)
shown) VarOrImm
var

cfgToSubgraph :: CFG -> GVizSubgraph
cfgToSubgraph :: CFG -> GVizSubgraph
cfgToSubgraph CFG
cfg = Text -> [GVizNode] -> [GVizEdge] -> GVizSubgraph
GVizSubgraph Text
name [GVizNode]
nodes [GVizEdge]
edges
  where
    name :: Text
name = CFG
cfg CFG -> Getting Text CFG Text -> Text
forall s a. s -> Getting a s a -> a
^. (MethodSig -> Const Text MethodSig) -> CFG -> Const Text CFG
#sig ((MethodSig -> Const Text MethodSig) -> CFG -> Const Text CFG)
-> ((Text -> Const Text Text) -> MethodSig -> Const Text MethodSig)
-> Getting Text CFG Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> MethodSig -> Const Text MethodSig
#name
    graph :: Graph BBID BasicBlock CFGEdge
graph = CFG
cfg CFG
-> Getting
     (Graph BBID BasicBlock CFGEdge) CFG (Graph BBID BasicBlock CFGEdge)
-> Graph BBID BasicBlock CFGEdge
forall s a. s -> Getting a s a -> a
^. Getting
  (Graph BBID BasicBlock CFGEdge) CFG (Graph BBID BasicBlock CFGEdge)
#graph
    nodes :: [GVizNode]
nodes = Graph BBID BasicBlock CFGEdge -> [(BBID, BasicBlock)]
forall ni nd ed. (Eq ni, Ord ni) => Graph ni nd ed -> [(ni, nd)]
G.nodeToList Graph BBID BasicBlock CFGEdge
graph [(BBID, BasicBlock)]
-> ((BBID, BasicBlock) -> GVizNode) -> [GVizNode]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CFG -> BasicBlock -> GVizNode
basicBlockToNode CFG
cfg (BasicBlock -> GVizNode)
-> ((BBID, BasicBlock) -> BasicBlock)
-> (BBID, BasicBlock)
-> GVizNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BBID, BasicBlock) -> BasicBlock
forall a b. (a, b) -> b
snd
    backEdges :: Set (BBID, BBID)
backEdges = CFG -> Set (BBID, BBID)
findBackEdges CFG
cfg
    isBackEdge :: (BBID, BBID, CFGEdge) -> Bool
isBackEdge (BBID
from, BBID
to, CFGEdge
_) = (BBID, BBID) -> Set (BBID, BBID) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (BBID
from, BBID
to) Set (BBID, BBID)
backEdges
    convertEdge :: (BBID, BBID, CFGEdge) -> GVizEdge
convertEdge edge :: (BBID, BBID, CFGEdge)
edge@(BBID
from, BBID
to, CFGEdge
ed) =
      let (BBID
from', BBID
to', Text
dir) =
            if (BBID, BBID, CFGEdge) -> Bool
isBackEdge (BBID, BBID, CFGEdge)
edge
              then (BBID
to, BBID
from, Text
"back")
              else (BBID
from, BBID
to, Text
"forward")
       in BBID -> BBID -> Text -> Text -> GVizEdge
GVizEdge BBID
from' BBID
to' (CFGEdge -> Text
prettyPrintEdge CFGEdge
ed) Text
dir
    edges :: [GVizEdge]
edges = Graph BBID BasicBlock CFGEdge -> [(BBID, BBID, CFGEdge)]
forall ni nd ed.
(Eq ni, Ord ni) =>
Graph ni nd ed -> [(ni, ni, ed)]
G.edgeToList Graph BBID BasicBlock CFGEdge
graph [(BBID, BBID, CFGEdge)]
-> ((BBID, BBID, CFGEdge) -> GVizEdge) -> [GVizEdge]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (BBID, BBID, CFGEdge) -> GVizEdge
convertEdge

-- basicBlockToNode Nothing BasicBlock {bbid = id, statements = stmts} =
--   let idText = [sformat ("<id:" %+ int %+ stext % ">") id "[global]"]
--       segments = stmts <&> sformat shown
--    in GVizNode id (Text.intercalate "\\n" $ idText ++ segments) (Just "source")

buildGlobalAndDeclares :: [Name] -> [(SSA.Var, AST.Type)] -> GVizNode
buildGlobalAndDeclares :: [Text] -> [(Var, Type)] -> GVizNode
buildGlobalAndDeclares [Text]
declares [(Var, Type)]
globals = 
  let idText :: [Text]
idText = [Format Text (BBID -> Text -> Text) -> BBID -> Text -> Text
forall a. Format Text a -> a
sformat (Format (BBID -> Text -> Text) (BBID -> Text -> Text)
"<id:" Format (BBID -> Text -> Text) (BBID -> Text -> Text)
-> Format Text (BBID -> Text -> Text)
-> Format Text (BBID -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Text -> Text) (BBID -> Text -> Text)
forall a r. Integral a => Format r (a -> r)
int Format (Text -> Text) (BBID -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (BBID -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format Text (Text -> Text)
forall r. Format r (Text -> r)
stext Format Text (Text -> Text)
-> Format Text Text -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
">") BBID
globalScopeID Text
"[global]"]
      declares' :: [Text]
declares' = [Text]
declares [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Format Text (Text -> Text) -> Text -> Text
forall a. Format Text a -> a
sformat (Format (Text -> Text) (Text -> Text)
"void " Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Text -> Text)
forall r. Format r (Text -> r)
stext Format Text (Text -> Text)
-> Format Text Text -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
"()")
      globals' :: [Text]
globals' = [(Var, Type)]
globals [(Var, Type)] -> ((Var, Type) -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Var -> Type -> Text) -> (Var, Type) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Format Text (Var -> Type -> Text) -> Var -> Type -> Text
forall a. Format Text a -> a
sformat (Format (Type -> Text) (Var -> Type -> Text)
forall a r. Show a => Format r (a -> r)
shown Format (Type -> Text) (Var -> Type -> Text)
-> Format Text (Type -> Text) -> Format Text (Var -> Type -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format (Type -> Text) (Type -> Text)
"= global " Format (Type -> Text) (Type -> Text)
-> Format Text (Type -> Text) -> Format Text (Type -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Type -> Text)
forall a r. Show a => Format r (a -> r)
shown))
   in BBID -> Text -> Maybe Text -> GVizNode
GVizNode BBID
globalScopeID (Text -> [Text] -> Text
Text.intercalate Text
"\\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
idText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
declares' [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
globals') (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"source")

fileCFGsToGraph :: SingleFileCFG -> GVizGraph
fileCFGsToGraph :: SingleFileCFG -> GVizGraph
fileCFGsToGraph (SingleFileCFG [Text]
declares [(Var, Type)]
globals Map Text CFG
cfgs) = [GVizSubgraph] -> [GVizNode] -> [GVizEdge] -> GVizGraph
GVizGraph [GVizSubgraph]
subgraphs [GVizNode
globalNode] []
  where
    globalNode :: GVizNode
globalNode = [Text] -> [(Var, Type)] -> GVizNode
buildGlobalAndDeclares [Text]
declares [(Var, Type)]
globals
    subgraphs :: [GVizSubgraph]
subgraphs = Map Text CFG -> [CFG]
forall k a. Map k a -> [a]
Map.elems Map Text CFG
cfgs [CFG] -> (CFG -> GVizSubgraph) -> [GVizSubgraph]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CFG -> GVizSubgraph
cfgToSubgraph

fileCFGsToDot :: SingleFileCFG -> Text
fileCFGsToDot :: SingleFileCFG -> Text
fileCFGsToDot = String -> Text
Text.pack (String -> Text)
-> (SingleFileCFG -> String) -> SingleFileCFG -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GVizGraph -> String
forall a. Show a => a -> String
show (GVizGraph -> String)
-> (SingleFileCFG -> GVizGraph) -> SingleFileCFG -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleFileCFG -> GVizGraph
fileCFGsToGraph