module Ethereum.Analyzer.Util
( toDotText
, disasmToDotText
, disasmToDotText2
) where
import Ethereum.Analyzer.Disasm
import Ethereum.Analyzer.IR
import Ethereum.Analyzer.CfgAugWithTopNPass
import Ethereum.Analyzer.CfgAugmentPass
import Compiler.Hoopl
import Data.GraphViz
import Data.GraphViz.Printing
import Data.Graph.Inductive.Graph as DGIG
import Data.Graph.Inductive.PatriciaTree
import Data.Text as DT
import qualified Data.Text.Lazy as DTL
disasmToDotText
:: HasEvmBytecode a
=> a -> Text
disasmToDotText a =
let disasmd = disasm a
result =
unWordLabelMapM $
do contract <- evmOps2HplContract disasmd
toDotText <$> (bodyOf . ctorOf <$> doCfgAugmentPass contract)
in result
disasmToDotText2
:: HasEvmBytecode a
=> a -> (Text, Text)
disasmToDotText2 a =
let result =
unWordLabelMapM $
do contract' <- doCfgAugWithTopNPass a
return
( toDotText $ bodyOf (ctorOf contract')
, toDotText $ bodyOf (dispatcherOf contract'))
in result
toDotText :: HplBody -> Text
toDotText bd =
let bdGr = toGr bd
dotG = toDotGraph bdGr
dotCode = toDot dotG
in DTL.toStrict $ renderDot dotCode
toGr :: HplBody -> Gr (Block HplOp C C) ()
toGr bd =
let lblToNode l = read (Prelude.drop 1 $ show l)
(nList, eList) =
mapFoldWithKey
(\lbl blk (nList', eList') ->
let node = lblToNode lbl
edgs =
Prelude.map (\l -> (node, lblToNode l, ())) (successors blk)
in (nList' ++ [(node, blk)], eList' ++ edgs))
([], [])
bd
in mkGraph nList eList
visParams
:: forall n el.
GraphvizParams n (Block HplOp C C) el () (Block HplOp C C)
visParams =
nonClusteredParams
{ fmtNode = \(_, nl) -> [toLabel $ show nl, shape BoxShape]
}
toDotGraph :: Gr (Block HplOp C C) () -> DotGraph Node
toDotGraph gr = graphToDot visParams gr