suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added all the necessary command-line options for enabling and disabling warnings in the Main module

Browse Source
This commit is contained in:
Neil Brown 2008-11-20 13:26:45 +00:00
parent f88c671cf7
commit a455676fa9
1 changed files with 30 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
Main.hs
View File

@ -26,6 +26,7 @@ import Control.Monad.Writer
import Data.Either import Data.Either
import Data.Generics import Data.Generics
import Data.Maybe import Data.Maybe
import qualified Data.Set as Set
import List import List
import System import System
import System.Console.GetOpt import System.Console.GetOpt
@ -54,10 +55,13 @@ import Utils
type OptFunc = CompState -> IO CompState type OptFunc = CompState -> IO CompState
options :: [OptDescr OptFunc] optionsNoWarnings :: [OptDescr OptFunc]
options = optionsNoWarnings =
[ Option [] ["backend"] (ReqArg optBackend "BACKEND") "code-generating backend (options: c, cppcsp, dumpast,src)" [ Option [] ["backend"] (ReqArg optBackend "BACKEND")
"code-generating backend (options: c, cppcsp, dumpast, src)"
, Option ['h'] ["help"] (NoArg optPrintHelp) "print this help" , Option ['h'] ["help"] (NoArg optPrintHelp) "print this help"
, Option [] ["help-warnings"] (NoArg optPrintWarningHelp)
"print help about warning options"
, Option ['k'] ["keep-temporaries"] (NoArg $ optKeepTemporaries) "keep temporary files" , Option ['k'] ["keep-temporaries"] (NoArg $ optKeepTemporaries) "keep temporary files"
, Option [] ["frontend"] (ReqArg optFrontend "FRONTEND") "language frontend (options: occam, rain)" , Option [] ["frontend"] (ReqArg optFrontend "FRONTEND") "language frontend (options: occam, rain)"
, Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: flowgraph, parse, compile, post-c, full)" , Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: flowgraph, parse, compile, post-c, full)"
@ -67,6 +71,14 @@ options =
, Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)" , Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)"
] ]
optionsWarnings :: [OptDescr OptFunc]
optionsWarnings = concat
[[Option [] ["w" ++ show w] (NoArg $ optEnableWarning w)
("Enable warning " ++ show w ++ " (" ++ describeWarning w ++ ")")]
++ [Option [] ["wno" ++ show w] (NoArg $ optDisableWarning w)
("Disable warning " ++ show w ++ " (" ++ describeWarning w ++ ")")]
| w <- [minBound .. maxBound]]
optMode :: String -> OptFunc optMode :: String -> OptFunc
optMode s ps optMode s ps
= do mode <- case s of = do mode <- case s of
@ -106,7 +118,11 @@ optOutput :: String -> OptFunc
optOutput s ps = return $ ps { csOutputFile = s } optOutput s ps = return $ ps { csOutputFile = s }
optPrintHelp :: OptFunc optPrintHelp :: OptFunc
optPrintHelp _ = dieIO (Nothing, usageInfo "Usage: tock [OPTION...] SOURCEFILE" options) optPrintHelp _ = dieIO (Nothing, usageInfo "Usage: tock [OPTION...] SOURCEFILE" optionsNoWarnings)
optPrintWarningHelp :: OptFunc
optPrintWarningHelp _ = dieIO (Nothing, usageInfo "Usage: tock [OPTION...] SOURCEFILE" optionsWarnings)
optUsageChecking :: String -> OptFunc optUsageChecking :: String -> OptFunc
optUsageChecking s ps optUsageChecking s ps
@ -124,11 +140,18 @@ optSanityCheck s ps
_ -> dieIO (Nothing, "Unknown sanity checking mode: " ++ s) _ -> dieIO (Nothing, "Unknown sanity checking mode: " ++ s)
return $ ps { csSanityCheck = sanityCheck } return $ ps { csSanityCheck = sanityCheck }
optEnableWarning :: WarningType -> OptFunc
optEnableWarning w ps = return $ ps { csEnabledWarnings = Set.insert w (csEnabledWarnings ps) }
optDisableWarning :: WarningType -> OptFunc
optDisableWarning w ps = return $ ps { csEnabledWarnings = Set.delete w (csEnabledWarnings ps) }
getOpts :: [String] -> IO ([OptFunc], [String]) getOpts :: [String] -> IO ([OptFunc], [String])
getOpts argv = getOpts argv =
case getOpt RequireOrder options argv of case getOpt RequireOrder (optionsNoWarnings ++ optionsWarnings) argv of
(o,n,[] ) -> return (o,n) (o,n,[] ) -> return (o,n)
(_,_,errs) -> error (concat errs ++ usageInfo header options) (_,_,errs) -> error (concat errs ++ usageInfo header optionsNoWarnings)
where header = "Usage: tock [OPTION...] SOURCEFILE" where header = "Usage: tock [OPTION...] SOURCEFILE"
main :: IO () main :: IO ()
@ -138,7 +161,7 @@ main = do
let fn = case args of let fn = case args of
[fn] -> fn [fn] -> fn
_ -> error "Must specify a single input file" _ -> error "Must specify a single input file (use \"tock --help\" to see options)"
-- Try to guess the filename from the extension. Since this function is -- Try to guess the filename from the extension. Since this function is
-- applied before the options are applied, it will be overriden by the -- applied before the options are applied, it will be overriden by the