Commit 23ba4e77 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Extended options to enable/disable certain kind of warnings

parent 900657fa
......@@ -14,7 +14,7 @@ import System.IO (hPutStrLn, stderr)
import System.Exit (exitFailure)
import Curry.Base.Message hiding (warn)
import CompilerOpts (Options (optVerbosity, optWarn), Verbosity (..))
import CompilerOpts (Options (..), Verbosity (..))
info :: Options -> String -> IO ()
info opts msg = unless (optVerbosity opts < VerbInfo)
......@@ -25,8 +25,11 @@ status opts msg = unless (optVerbosity opts < VerbStatus)
(putStrLn $ msg ++ " ...")
warn :: Options -> [Message] -> IO ()
warn opts msgs = when (optWarn opts && not (null msgs))
$ putErrLn (show $ ppMessages ppWarning $ sort msgs)
warn opts msgs = when (optWarn opts && not (null msgs)) $ do
putErrLn (show $ ppMessages ppWarning $ sort msgs)
when (optWarnAsError opts) $ do
putErrLn "Failed due to -Werror"
exitFailure
-- |Print an error message on 'stderr'
putErrLn :: String -> IO ()
......
......@@ -86,5 +86,5 @@ exportCheck _ env (Module m es is ds)
-- TODO: Which kind of warnings?
-- |Check for warnings.
warnCheck :: CompilerEnv -> Module -> [Message]
warnCheck env mdl = WC.warnCheck (valueEnv env) (tyConsEnv env) mdl
warnCheck :: Options -> CompilerEnv -> Module -> [Message]
warnCheck opts env mdl = WC.warnCheck opts (valueEnv env) (tyConsEnv env) mdl
......@@ -15,7 +15,7 @@
module Checks.WarnCheck (warnCheck) where
import Control.Monad
(filterM, foldM_, guard, liftM, unless)
(filterM, foldM_, guard, liftM, when, unless)
import Control.Monad.State.Strict (State, execState, gets, modify)
import qualified Data.Map as Map (empty, insert, lookup)
import Data.Maybe (catMaybes, isJust)
......@@ -37,6 +37,8 @@ import Base.Types
import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTC)
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
import CompilerOpts
-- Find potentially incorrect code in a Curry program and generate warnings
-- for the following issues:
-- - multiply imported modules, multiply imported/hidden values
......@@ -45,9 +47,9 @@ import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
-- - idle case alternatives
-- - overlapping case alternatives
-- - non-adjacent function rules
warnCheck :: ValueEnv -> TCEnv -> Module -> [Message]
warnCheck valEnv tcEnv (Module mid es is ds)
= runOn (initWcState mid valEnv tcEnv) $ do
warnCheck :: Options -> ValueEnv -> TCEnv -> Module -> [Message]
warnCheck opts valEnv tcEnv (Module mid es is ds)
= runOn (initWcState mid valEnv tcEnv (optWarnFlags opts)) $ do
checkExports es
checkImports is
checkDeclGroup ds
......@@ -60,6 +62,7 @@ data WcState = WcState
, scope :: ScopeEnv
, valueEnv :: ValueEnv
, tyConsEnv :: TCEnv
, warnFlags :: [WarnFlag]
, warnings :: [Message]
}
......@@ -68,8 +71,8 @@ data WcState = WcState
-- contents.
type WCM = State WcState
initWcState :: ModuleIdent -> ValueEnv -> TCEnv -> WcState
initWcState mid ve te = WcState mid SE.new ve te []
initWcState :: ModuleIdent -> ValueEnv -> TCEnv -> [WarnFlag] -> WcState
initWcState mid ve te wf = WcState mid SE.new ve te wf []
getModuleIdent :: WCM ModuleIdent
getModuleIdent = gets moduleId
......@@ -77,6 +80,11 @@ getModuleIdent = gets moduleId
modifyScope :: (ScopeEnv -> ScopeEnv) -> WCM ()
modifyScope f = modify $ \s -> s { scope = f $ scope s }
warnFor :: WarnFlag -> WCM () -> WCM ()
warnFor f act = do
warn <- gets $ \s -> f `elem` warnFlags s
when warn act
report :: Message -> WCM ()
report w = modify $ \ s -> s { warnings = w : warnings s }
......@@ -104,7 +112,7 @@ checkExports _ = ok -- TODO
-- The function uses a map of the already imported or hidden entities to
-- collect the entities throughout multiple import statements.
checkImports :: [ImportDecl] -> WCM ()
checkImports = foldM_ checkImport Map.empty
checkImports = warnFor WarnMultipleImports . foldM_ checkImport Map.empty
where
checkImport env (ImportDecl pos mid _ _ spec) = case Map.lookup mid env of
Nothing -> setImportSpec env mid $ fromImpSpec spec
......@@ -157,7 +165,8 @@ checkDeclGroup ds = do
-- Find function rules which are not together
checkRuleAdjacency :: [Decl] -> WCM ()
checkRuleAdjacency decls = foldM_ check (mkIdent "", Map.empty) decls
checkRuleAdjacency decls = warnFor WarnDisjoinedRules
$ foldM_ check (mkIdent "", Map.empty) decls
where
check (prevId, env) (FunctionDecl p f _) = do
cons <- isConsId f
......@@ -349,7 +358,7 @@ checkCaseAlternatives alts@(Alt pos _ _ : _) = do
(map (\(Alt _ p _) -> [p]) alts)
checkIdleAlts :: [Alt] -> WCM ()
checkIdleAlts alts = case idles of
checkIdleAlts alts = warnFor WarnIdleAlternatives $ case idles of
Alt p _ _ : _ : _ -> report $ warnIdleCaseAlts p
_ -> ok
where
......@@ -364,9 +373,9 @@ checkIdleAlts alts = case idles of
checkOverlappingAlts :: [Alt] -> WCM ()
checkOverlappingAlts [] = ok
checkOverlappingAlts (alt : alts) = do
let (overlapping, rest) = partition (eqAlt alt) alts
unless (null overlapping) $ report $ warnOverlappingCaseAlts (alt : overlapping)
checkOverlappingAlts (alt : alts) = warnFor WarnOverlapping $ do
let (overlapped, rest) = partition (eqAlt alt) alts
unless (null overlapped) $ report $ warnOverlappingCaseAlts (alt : overlapped)
checkOverlappingAlts rest
where
eqAlt (Alt _ p1 _) (Alt _ p2 _) = eqPattern p1 p2
......@@ -399,7 +408,7 @@ checkOverlappingAlts (alt : alts) = do
-- -----------------------------------------------------------------------------
checkNonExhaustivePattern :: String -> Position -> [[Pattern]] -> WCM ()
checkNonExhaustivePattern loc pos pats = do
checkNonExhaustivePattern loc pos pats = warnFor WarnIncompletePatterns $ do
missing <- missingPattern (map (map simplifyPat) pats)
unless (null missing) $ report $ warnMissingPattern loc pos missing
......@@ -579,15 +588,16 @@ patArgs _ = []
-- -----------------------------------------------------------------------------
checkShadowing :: Ident -> WCM ()
checkShadowing x = shadowsVar x >>= maybe ok (report . warnShadowing x)
checkShadowing x = warnFor WarnNameShadowing $
shadowsVar x >>= maybe ok (report . warnShadowing x)
reportUnusedVars :: WCM ()
reportUnusedVars = do
reportUnusedVars = warnFor WarnUnusedBindings $ do
unused <- returnUnrefVars
unless (null unused) $ mapM_ report $ map warnUnrefVar unused
reportUnusedTypeVars :: [Ident] -> WCM ()
reportUnusedTypeVars vs = do
reportUnusedTypeVars vs = warnFor WarnUnusedBindings $ do
unused <- filterM isUnrefTypeVar vs
unless (null unused) $ mapM_ report $ map warnUnrefTypeVar unused
......
......@@ -16,7 +16,7 @@
-}
module CompilerOpts
( Options (..), CymakeMode (..), Verbosity (..), TargetType (..)
, Extension (..), DumpLevel (..), dumpLevel
, WarnFlag (..), Extension (..), DumpLevel (..), dumpLevel
, defaultOptions, getCompilerOpts, usage
) where
......@@ -41,7 +41,8 @@ data Options = Options
, optUseSubdir :: Bool -- ^ use subdir for output?
, optInterface :: Bool -- ^ create an interface file
, optWarn :: Bool -- ^ show warnings
, optOverlapWarn :: Bool -- ^ show "overlap" warnings
, optWarnFlags :: [WarnFlag]
, optWarnAsError :: Bool
, optTargetTypes :: [TargetType] -- ^ what to generate
, optExtensions :: [Extension] -- ^ enabled language extensions
, optDumps :: [DumpLevel] -- ^ dump levels
......@@ -61,7 +62,8 @@ defaultOptions = Options
, optUseSubdir = True
, optInterface = True
, optWarn = True
, optOverlapWarn = True
, optWarnFlags = [minBound .. maxBound]
, optWarnAsError = False
, optTargetTypes = []
, optExtensions = []
, optDumps = []
......@@ -78,6 +80,13 @@ data CymakeMode
| ModeMake -- ^ Compile with dependencies
deriving (Eq, Show)
-- |Data type representing the verbosity level
data Verbosity
= VerbQuiet -- ^ be quiet
| VerbStatus -- ^ show status of compilation
| VerbInfo -- ^ show also additional info
deriving (Eq, Ord, Show)
-- |Type of the target file
data TargetType
= Parsed -- ^ Parsed source code
......@@ -85,22 +94,30 @@ data TargetType
| ExtendedFlatCurry -- ^ Extended FlatCurry
| FlatXml -- ^ FlatCurry as XML
| AbstractCurry -- ^ AbstractCurry
| UntypedAbstractCurry -- ^ UntypedAbstractCurry
| UntypedAbstractCurry -- ^ Untyped AbstractCurry
deriving (Eq, Show)
-- |Data type representing the verbosity level
data Verbosity
= VerbQuiet -- ^ be quiet
| VerbStatus -- ^ show status of compilation
| VerbInfo -- ^ show also additional info
deriving (Eq, Ord, Show)
-- |Warnings flags
data WarnFlag
= WarnMultipleImports -- ^ Warn for multiple imports
| WarnDisjoinedRules -- ^ Warn for disjoined function rules
| WarnUnusedBindings -- ^ Warn for unused bindings
| WarnNameShadowing -- ^ Warn for name shadowing
| WarnOverlapping -- ^ Warn for overlapping rules/alternatives
| WarnIncompletePatterns -- ^ Warn for incomplete pattern matching
| WarnIdleAlternatives -- ^ Warn for idle case alternatives
deriving (Eq, Bounded, Enum, Show)
-- |Classifies a number as a 'Verbosity'
classifyVerbosity :: String -> Verbosity -> Verbosity
classifyVerbosity "0" _ = VerbQuiet
classifyVerbosity "1" _ = VerbStatus
classifyVerbosity "2" _ = VerbInfo
classifyVerbosity _ v = v
warnFlags :: [(WarnFlag, String, String)]
warnFlags =
[ (WarnMultipleImports , "multiple-imports" , "multiple imports" )
, (WarnDisjoinedRules , "disjoined-rules" , "disjoined function rules" )
, (WarnUnusedBindings , "unused-bindings" , "unused bindings" )
, (WarnNameShadowing , "name-shadowing" , "name shadowing" )
, (WarnOverlapping , "overlapping" , "overlapping function rules" )
, (WarnIncompletePatterns, "incomplete-patterns", "incomplete pattern matching")
, (WarnIdleAlternatives , "idle-alternatives" , "idle case alternatives" )
]
-- |Data type for representing code dumps
data DumpLevel
......@@ -137,7 +154,6 @@ data Extension
| FunctionalPatterns
| AnonFreeVars
| NoImplicitPrelude
| UnknownExtension String
deriving (Eq, Read, Show)
allExtensions :: [Extension]
......@@ -147,130 +163,205 @@ allExtensions = [Records, FunctionalPatterns, AnonFreeVars, NoImplicitPrelude]
curryExtensions :: [Extension]
curryExtensions = [Records, FunctionalPatterns, AnonFreeVars]
-- |Classifies a 'String' as an 'Extension'
classifyExtension :: String -> Extension
classifyExtension str = case reads str of
[(e, "")] -> e
_ -> UnknownExtension str
type OptErr = (Options, [String])
onOpts :: (Options -> Options) -> OptErr -> OptErr
onOpts f (opts, errs) = (f opts, errs)
onOptsArg :: (String -> Options -> Options) -> String -> OptErr -> OptErr
onOptsArg f arg (opts, errs) = (f arg opts, errs)
addErr :: String -> OptErr -> OptErr
addErr err (opts, errs) = (opts, errs ++ [err])
-- | All available compiler options
options :: [OptDescr (Options -> Options)]
options :: [OptDescr (OptErr -> OptErr)]
options =
-- modus operandi
[ Option "h?" ["help"]
(NoArg (\ opts -> opts { optMode = ModeHelp }))
(NoArg (onOpts $ \ opts -> opts { optMode = ModeHelp }))
"display this help and exit"
, Option "V" ["version"]
(NoArg (\ opts -> opts { optMode = ModeVersion }))
(NoArg (onOpts $ \ opts -> opts { optMode = ModeVersion }))
"show the version number and exit"
, Option "" ["numeric-version"]
(NoArg (\ opts -> opts { optMode = ModeNumericVersion }))
(NoArg (onOpts $ \ opts -> opts { optMode = ModeNumericVersion }))
"show the numeric version number and exit"
, Option "" ["html"]
(NoArg (\ opts -> opts { optMode = ModeHtml }))
(NoArg (onOpts $ \ opts -> opts { optMode = ModeHtml }))
"generate html code and exit"
-- verbosity
, Option "v" ["verbosity"]
(ReqArg (\ arg opts -> opts { optVerbosity =
classifyVerbosity arg $ optVerbosity opts}) "<n>")
"set verbosity level to <n>, one of 0 = quiet, 1 = status, 2 = info"
, Option "" ["no-verb"]
(NoArg (\ opts -> opts { optVerbosity = VerbQuiet } ))
(ReqArg parseVerbosity "n")
("set verbosity level to `n', where `n' is one of\n"
++ " 0: quiet\n 1: status\n 2: info")
-- legacy
, Option "q" ["no-verb"]
(NoArg (onOpts $ \ opts -> opts { optVerbosity = VerbQuiet } ))
"set verbosity level to quiet"
-- compilation
, Option "f" ["force"]
(NoArg (\ opts -> opts { optForce = True }))
(NoArg (onOpts $ \ opts -> opts { optForce = True }))
"force compilation of target file"
, Option "P" ["lib-dir"]
(ReqArg (\ arg opts -> opts { optLibraryPaths =
nub $ optLibraryPaths opts ++ splitSearchPath arg}) "dir:dir2:...")
"search for librares in dir:dir2:..."
(ReqArg (onOptsArg $ \ arg opts -> opts { optLibraryPaths =
nub $ optLibraryPaths opts ++ splitSearchPath arg}) "dir[:dir]")
"search for libraries in dir[:dir]"
, Option "i" ["import-dir"]
(ReqArg (\ arg opts -> opts { optImportPaths =
nub $ optImportPaths opts ++ splitSearchPath arg}) "dir:dir2:...")
"search for imports in dir:dir2:..."
(ReqArg (onOptsArg $ \ arg opts -> opts { optImportPaths =
nub $ optImportPaths opts ++ splitSearchPath arg}) "dir[:dir]")
"search for imports in dir[:dir]"
, Option "o" ["output"]
(ReqArg (\ arg opts -> opts { optOutput = Just arg }) "FILE")
"write code to FILE"
(ReqArg (onOptsArg $ \ arg opts -> opts { optOutput = Just arg }) "file")
"write code to `file'"
, Option "" ["no-subdir"]
(NoArg (\ opts -> opts { optUseSubdir = False }))
("disable writing to '" ++ currySubdir ++ "' subdirectory")
(NoArg (onOpts $ \ opts -> opts { optUseSubdir = False }))
("disable writing to `" ++ currySubdir ++ "' subdirectory")
, Option "" ["no-intf"]
(NoArg (\ opts -> opts { optInterface = False }))
(NoArg (onOpts $ \ opts -> opts { optInterface = False }))
"do not create an interface file"
, Option "" ["no-warn"]
(NoArg (\ opts -> opts { optWarn = False }))
(NoArg (onOpts $ \ opts -> opts { optWarn = False }))
"do not print warnings"
-- legacy
, Option "" ["no-overlap-warn"]
(NoArg (\ opts -> opts { optOverlapWarn = False }))
(NoArg (onOpts $ \ opts -> opts { optWarnFlags =
addFlag WarnOverlapping (optWarnFlags opts) }))
"do not print warnings for overlapping rules"
-- target types
, Option "" ["parse-only"]
(NoArg (\ opts -> opts { optTargetTypes =
(NoArg (onOpts $ \ opts -> opts { optTargetTypes =
nub $ Parsed : optTargetTypes opts }))
"generate source representation"
, Option "" ["flat"]
(NoArg (\ opts -> opts { optTargetTypes =
(NoArg (onOpts $ \ opts -> opts { optTargetTypes =
nub $ FlatCurry : optTargetTypes opts }))
"generate FlatCurry code"
, Option "" ["extended-flat"]
(NoArg (\ opts -> opts { optTargetTypes =
(NoArg (onOpts $ \ opts -> opts { optTargetTypes =
nub $ ExtendedFlatCurry : optTargetTypes opts }))
"generate FlatCurry code with source references"
, Option "" ["xml"]
(NoArg (\ opts -> opts { optTargetTypes =
(NoArg (onOpts $ \ opts -> opts { optTargetTypes =
nub $ FlatXml : optTargetTypes opts }))
"generate flat xml code"
, Option "" ["acy"]
(NoArg (\ opts -> opts { optTargetTypes =
(NoArg (onOpts $ \ opts -> opts { optTargetTypes =
nub $ AbstractCurry : optTargetTypes opts }))
"generate (type infered) AbstractCurry code"
, Option "" ["uacy"]
(NoArg (\ opts -> opts { optTargetTypes =
(NoArg (onOpts $ \ opts -> opts { optTargetTypes =
nub $ UntypedAbstractCurry : optTargetTypes opts }))
"generate untyped AbstractCurry code"
-- extensions
, Option "e" ["extended"]
(NoArg (\ opts -> opts { optExtensions =
(NoArg (onOpts $ \ opts -> opts { optExtensions =
nub $ curryExtensions ++ optExtensions opts }))
"enable extended Curry functionalities"
, Option "X" []
(ReqArg (\ arg opts -> opts { optExtensions =
nub $ classifyExtension arg : optExtensions opts }) "EXT")
("enable language extension EXT, one of " ++ show allExtensions)
-- dump
, Option "" ["dump-all"]
(NoArg (\ opts -> opts { optDumps = [minBound .. maxBound] }))
"dump everything"
, Option "" ["dump-env"]
(NoArg (\ opts -> opts { optDumpEnv = True }))
"additionally dump compilation environment for each dump level"
, Option "" ["dump-raw"]
(NoArg (\ opts -> opts { optDumpRaw = True }))
"Dump as data structure instead of pretty printing"
] ++ dumpDescriptions
dumpDescriptions :: [OptDescr (Options -> Options)]
dumpDescriptions = map toDescr dumpLevel
where toDescr (lvl, flag, text) = Option "" ["dump-" ++ flag]
(NoArg (\ opts -> opts { optDumps = nub $ lvl : optDumps opts }))
("dump " ++ text)
(ReqArg parseLanguageExtension "ext")
("enable language extension `ext', where `ext' is one of\n"
++ intercalate "\n" (map (\e -> " " ++ show e) allExtensions))
, Option "W" ["warning"]
(ReqArg parseWarnOption "opt")
("set warning option `opt', where `opt' ist one of\n"
++ renderDescriptions warnDescriptions)
, Option "d" ["dump"]
(ReqArg parseDumpOption "opt")
("set dump option `opt', where `opt' ist one of\n"
++ renderDescriptions dumpDescriptions)
]
-- |Classifies a number as a 'Verbosity'
parseVerbosity :: String -> OptErr -> OptErr
parseVerbosity "0" = onOpts $ \ opts -> opts { optVerbosity = VerbQuiet }
parseVerbosity "1" = onOpts $ \ opts -> opts { optVerbosity = VerbStatus }
parseVerbosity "2" = onOpts $ \ opts -> opts { optVerbosity = VerbInfo }
parseVerbosity opt = addErr $ "illegal verbosity `" ++ opt ++ "'\n"
parseLanguageExtension :: String -> OptErr -> OptErr
parseLanguageExtension opt = case reads opt of
[(ext, "")] -> onOpts (addExt ext)
_ -> addErr $ "unrecognized language extension `" ++ opt ++ "'\n"
where
addExt e = \opts -> opts { optExtensions = addFlag e (optExtensions opts) }
parseWarnOption :: String -> OptErr -> OptErr
parseWarnOption opt = case lookup3 opt warnDescriptions of
Just f -> onOpts f
Nothing -> addErr $ "unrecognized warning option `" ++ opt ++ "'\n"
renderDescriptions :: [(String, String, Options -> Options)] -> String
renderDescriptions ds
= intercalate "\n" $ map (\(k, d, _) -> " " ++ rpad maxLen k ++ ": " ++ d) ds
where
maxLen = maximum $ map (\(k, _, _) -> length k) ds
rpad n x = x ++ replicate (n - length x) ' '
warnDescriptions :: [(String, String, Options -> Options)]
warnDescriptions
= [ ( "all" , "turn on all warnings"
, \ opts -> opts { optWarnFlags = [minBound .. maxBound] } )
, ("none" , "turn off all warnings"
, \ opts -> opts { optWarnFlags = [] } )
, ("error", "treat warnings as errors"
, \ opts -> opts { optWarnAsError = True } )
] ++ map turnOn warnFlags ++ map turnOff warnFlags
where
turnOn (flag, name, desc)
= (name, "warn for " ++ desc
, \ opts -> opts { optWarnFlags = addFlag flag (optWarnFlags opts)})
turnOff (flag, name, desc)
= ("no-" ++ name, "do not warn for " ++ desc
, \ opts -> opts { optWarnFlags = removeFlag flag (optWarnFlags opts)})
parseDumpOption :: String -> OptErr -> OptErr
parseDumpOption opt = case lookup3 opt dumpDescriptions of
Just f -> onOpts f
Nothing -> addErr $ "unrecognized dump option `" ++ opt ++ "'"
dumpDescriptions :: [(String, String, Options -> Options)]
dumpDescriptions =
[ ( "all", "dump everything"
, \ opts -> opts { optDumps = [minBound .. maxBound] })
, ( "none", "dump nothing"
, \ opts -> opts { optDumps = [] })
, ( "env" , "additionally dump compiler environment"
, \ opts -> opts { optDumpEnv = True })
, ( "raw" , "dump as raw AST (instead of pretty printed)"
, \ opts -> opts { optDumpRaw = True })
] ++ map toDescr dumpLevel
where
toDescr (flag, name, desc)
= (name , "dump " ++ desc
, \ opts -> opts { optDumps = addFlag flag (optDumps opts)})
addFlag :: Eq a => a -> [a] -> [a]
addFlag o opts = nub $ o : opts
removeFlag :: Eq a => a -> [a] -> [a]
removeFlag o opts = filter (/= o) opts
lookup3 :: Eq a => a -> [(a, b, c)] -> Maybe c
lookup3 _ [] = Nothing
lookup3 k ((k', _, v2) : kvs)
| k == k' = Just v2
| otherwise = lookup3 k kvs
-- |Parse the command line arguments
parseOpts :: [String] -> (Options, [String], [String])
parseOpts args = (foldl (flip ($)) defaultOptions opts, files, errs) where
(opts, files, errs) = getOpt Permute options args
parseOpts args = (opts, files, errs ++ errs2)
where
(opts, errs2) = foldl (flip ($)) (defaultOptions, []) optErrs
(optErrs, files, errs) = getOpt Permute options args
-- |Check options and files and return a list of error messages
checkOpts :: Options -> [String] -> [String]
checkOpts opts files
| isJust (optOutput opts) && length files > 1
= ["cannot specify -o with multiple targets"]
| not $ null unknownExtensions
= ["unknown language extension(s): " ++ intercalate ", " unknownExtensions]
| otherwise
= []
where unknownExtensions = [ e | UnknownExtension e <- optExtensions opts ]
-- |Print the usage information of the command line tool.
usage :: String -> String
......
......@@ -38,7 +38,7 @@ import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTC)
import Env.Value (ValueEnv, ValueInfo (..), lookupValue, qualLookupValue)
-- other
import CompilerOpts (Options (..))
import CompilerOpts (Options (..), WarnFlag (..))
import qualified IL as IL
import qualified ModuleSummary
import Transformations (transType)
......@@ -752,9 +752,9 @@ flattenRecordTypeFields = concatMap (\ (ls, ty) -> map (\l -> (l, ty)) ls)
--
checkOverlapping :: Expr -> Expr -> FlatState ()
checkOverlapping expr1 expr2 = do
checkOverlapping e1 e2 = do
opts <- compilerOpts
when (optOverlapWarn opts) $ checkOverlap expr1 expr2
when (WarnOverlapping `elem` optWarnFlags opts) $ checkOverlap e1 e2
where
checkOverlap (Case _ _ _ _) _ = functionId >>= genWarning . overlappingRules
checkOverlap _ (Case _ _ _ _) = functionId >>= genWarning . overlappingRules
......
......@@ -79,7 +79,7 @@ compileModule opts fn = do
case checked of
Left errs -> abortWithMessages errs
Right (env, mdl) -> do
warn opts $ warnCheck env mdl
warn opts $ warnCheck opts env mdl
writeOutput opts fn (env, mdl)
writeOutput :: Options -> FilePath -> (CompilerEnv, CS.Module) -> IO ()
......
......@@ -2,4 +2,8 @@ test x = case x of
Just 1 -> True
Just 2 -> True
test2 (Just True) = False
\ No newline at end of file
test2 (Just True) = False
and True True = True
plus 1 1 = 2
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment