{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program 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
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{-
Module : $Header$
Description : Internal control flow graph printing.
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable
-}
module Main.Dot where
import Control.Exception ( catch )
import Control.Monad
import Control.Monad.Trans (liftIO)
import System.Exit
import System.Directory ( doesFileExist, removeFile, findExecutable )
import System.FilePath (dropExtension, addExtension)
import System.Process
import System.IO
import Language.CAO.Analysis.CFG
import Language.CAO.Common.Monad
import Main.Flags
--------------------------------------------------------------------------------
-- Printing Control Flow Graph
generateCFG :: Options -> [CaoCFG] -> String -> CaoResult ()
generateCFG opts cfg outExt =
liftIO $ runDotT outExt noExt $ showCFG cfg
where
noExt = dropExtension $ input opts
runDotT :: String -> String -> String -> IO ()
runDotT outExt outF arg = do
-- Find dot executable
mdot <- findExecutable "dot"
doRunDotT mdot outExt outF arg
doRunDotT :: Maybe FilePath -> String -> FilePath -> String -> IO ()
doRunDotT Nothing _ outF arg = do
hPutStrLn stderr $ "Graphviz is required by --dgen-cfg\
\ and --dgen-ssa options."
hPutStrLn stderr $ "Generating dot file: `" ++ outF ++ "dot'."
writeFile (addExtension outF "dot") arg
doRunDotT (Just dot) outExt outF arg = do
-- Open output file
file <- openFile dotOutputF WriteMode
hSetBinaryMode file True
-- Create dot process
(Just inp, _, _, h) <- createProcess $ dotProcess file
-- Feed in input
hPutStr inp arg
hFlush inp
hClose inp
-- Finish
cd <- waitForProcess h
cF cd
`catch` catchF
where
dotProcess out
= (proc dot ["-T" ++ outExt]) { std_in = CreatePipe
, std_out = UseHandle out
}
dotOutputF = addExtension outF outExt
catchF :: IOError -> IO ()
catchF _ = cF $ ExitFailure (-1)
cF :: ExitCode -> IO ()
cF ExitSuccess = return ()
cF (ExitFailure _) = do
hPutStrLn stderr "`dot' failure!"
hPutStrLn stderr $ "Generating dot file: `" ++ outF ++ "dot'."
b <- doesFileExist dotOutputF
when b $ removeFile dotOutputF
writeFile (addExtension outF "dot") arg