module Ivory.Compile.C.CmdlineFrontend.Options where
import Data.Monoid (Monoid(..),mconcat)
import System.Console.GetOpt
(ArgOrder(Permute),OptDescr(..),ArgDescr(..),getOpt,usageInfo)
import System.Environment (getProgName)
import System.Exit (exitFailure,exitSuccess)
data OptParser opt
= Success (opt -> opt)
| Error [String]
instance Monoid (OptParser opt) where
mempty = Success id
Success f `mappend` Success g = Success (f . g)
Error as `mappend` Error bs = Error (as ++ bs)
Error as `mappend` _ = Error as
_ `mappend` Error bs = Error bs
success :: (opt -> opt) -> OptParser opt
success = Success
parseOptions :: [OptDescr (OptParser opt)] -> [String]
-> (Either [String] (opt -> opt))
parseOptions opts args = case getOpt Permute opts args of
(fs,[],[]) -> case mconcat fs of
Success f -> Right f
Error es -> Left es
(_,_,es) -> Left es
data Opts = Opts
{ stdOut :: Bool
, includeDir :: FilePath
, srcDir :: FilePath
, deps :: FilePath
, depPrefix :: String
, rtIncludeDir:: Maybe FilePath
, constFold :: Bool
, overflow :: Bool
, divZero :: Bool
, ixCheck :: Bool
, fpCheck :: Bool
, outProcSyms :: Bool
, cfg :: Bool
, cfgDotDir :: FilePath
, cfgProc :: [String]
, verbose :: Bool
, help :: Bool
} deriving (Show)
initialOpts :: Opts
initialOpts = Opts
{ stdOut = False
, includeDir = ""
, srcDir = ""
, deps = ""
, depPrefix = ""
, rtIncludeDir = Nothing
, constFold = False
, overflow = False
, divZero = False
, ixCheck = False
, fpCheck = False
, outProcSyms = False
, cfg = False
, cfgDotDir = ""
, cfgProc = []
, verbose = False
, help = False
}
setStdOut :: OptParser Opts
setStdOut = success (\opts -> opts { stdOut = True } )
setIncludeDir :: String -> OptParser Opts
setIncludeDir str = success (\opts -> opts { includeDir = str })
setSrcDir :: String -> OptParser Opts
setSrcDir str = success (\opts -> opts { srcDir = str })
setDeps :: String -> OptParser Opts
setDeps str = success (\opts -> opts { deps = str })
setDepPrefix :: String -> OptParser Opts
setDepPrefix str = success (\opts -> opts { depPrefix = str })
setRtIncludeDir :: String -> OptParser Opts
setRtIncludeDir str = success (\opts -> opts { rtIncludeDir = Just str })
setConstFold :: OptParser Opts
setConstFold = success (\opts -> opts { constFold = True })
setOverflow :: OptParser Opts
setOverflow = success (\opts -> opts { overflow = True })
setDivZero :: OptParser Opts
setDivZero = success (\opts -> opts { divZero = True })
setIxCheck :: OptParser Opts
setIxCheck = success (\opts -> opts { ixCheck = True })
setFpCheck :: OptParser Opts
setFpCheck = success (\opts -> opts { fpCheck = True })
setProcSyms :: OptParser Opts
setProcSyms = success (\opts -> opts { outProcSyms = True })
setCfg :: OptParser Opts
setCfg = success (\opts -> opts { cfg = True })
setCfgDotDir :: String -> OptParser Opts
setCfgDotDir str = success (\opts -> opts { cfgDotDir = str })
addCfgProc :: String -> OptParser Opts
addCfgProc str = success (\opts -> opts { cfgProc = cfgProc opts ++ [str] })
setVerbose :: OptParser Opts
setVerbose = success (\opts -> opts { verbose = True })
setHelp :: OptParser Opts
setHelp = success (\opts -> opts { help = True })
options :: [OptDescr (OptParser Opts)]
options =
[ Option "" ["std-out"] (NoArg setStdOut)
"print to stdout only"
, Option "" ["include-dir"] (ReqArg setIncludeDir "PATH")
"output directory for header files"
, Option "" ["src-dir"] (ReqArg setSrcDir "PATH")
"output directory for source files"
, Option "" ["dep-file"] (ReqArg setDeps "FILE")
"makefile dependency output"
, Option "" ["dep-prefix"] (ReqArg setDepPrefix "STRING")
"makefile dependency prefix"
, Option "" ["rt-include-dir"] (ReqArg setRtIncludeDir "PATH")
"path to ivory runtime includes"
, Option "" ["const-fold"] (NoArg setConstFold)
"enable the constant folding pass"
, Option "" ["overflow"] (NoArg setOverflow)
"enable overflow checking annotations"
, Option "" ["div-zero"] (NoArg setDivZero)
"generate assertions checking for division by zero."
, Option "" ["ix-check"] (NoArg setIxCheck)
"generate assertions checking for back indexes (e.g., negative)"
, Option "" ["fp-check"] (NoArg setFpCheck)
"generate assertions checking for NaN and Infinitiy."
, Option "" ["out-proc-syms"] (NoArg setProcSyms)
"dump out the modules' function symbols"
, Option "" ["cfg"] (NoArg setCfg)
"Output control-flow graph and max stack usage."
, Option "" ["cfg-dot-dir"] (ReqArg setCfgDotDir "PATH")
"output directory for CFG Graphviz file"
, Option "" ["cfg-proc"] (ReqArg addCfgProc "NAME")
"entry function(s) for CFG computation."
, Option "" ["verbose"] (NoArg setVerbose)
"verbose debugging output"
, Option "h" ["help"] (NoArg setHelp)
"display this message"
]
parseOpts :: [String] -> IO Opts
parseOpts args = case parseOptions options args of
Right f ->
let opts = f initialOpts
in if help opts
then printUsage [] >> exitSuccess
else return opts
Left errs -> printUsage errs >> exitFailure
printUsage :: [String] -> IO ()
printUsage errs = do
prog <- getProgName
let banner = unlines
(errs ++ ["", "Usage: " ++ prog ++ " [OPTIONS]"])
putStrLn (usageInfo banner options)