Command line flag -s/-q now silences all warnings

These flags now do what the say.
This commit is contained in:
hallgren
2014-08-22 00:30:33 +00:00
parent 21f429caf8
commit 8dfaf2ef65
3 changed files with 16 additions and 13 deletions

View File

@@ -125,8 +125,7 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
return $ updateTree (c,CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js return $ updateTree (c,CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js
Bad _ -> do noLinOf c Bad _ -> do noLinOf c
return js return js
where noLinOf c = when (verbAtLeast opts Normal) $ where noLinOf c = checkWarn ("no linearization of" <+> c)
checkWarn ("no linearization of" <+> c)
AbsCat (Just _) -> case lookupIdent c js of AbsCat (Just _) -> case lookupIdent c js of
Ok (AnyInd _ _) -> return js Ok (AnyInd _ _) -> return js
Ok (CncCat (Just _) _ _ _ _) -> return js Ok (CncCat (Just _) _ _ _ _) -> return js
@@ -157,9 +156,8 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
-- | General Principle: only Just-values are checked. -- | General Principle: only Just-values are checked.
-- A May-value has always been checked in its origin module. -- A May-value has always been checked in its origin module.
checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
checkInfo opts cwd sgr (m,mo) c info = do checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
checkInModule cwd mo NoLoc empty $ checkReservedId c
checkReservedId c
case info of case info of
AbsCat (Just (L loc cont)) -> AbsCat (Just (L loc cont)) ->
mkCheck loc "the category" $ mkCheck loc "the category" $

View File

@@ -20,7 +20,7 @@ import GF.Grammar.Binary(decodeModule,encodeModule)
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,liftIO,ePutStrLn,putPointE,putStrE) import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,liftIO,ePutStrLn,putPointE,putStrE)
import GF.Infra.CheckM(runCheck) import GF.Infra.CheckM(runCheck')
import GF.Data.Operations(liftErr,(+++)) import GF.Data.Operations(liftErr,(+++))
import GF.System.Directory(doesFileExist,getCurrentDirectory) import GF.System.Directory(doesFileExist,getCurrentDirectory)
@@ -67,7 +67,7 @@ reuseGFO opts srcgr file =
let sm1 = unsubexpModule sm0 let sm1 = unsubexpModule sm0
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
(sm,warnings) <- -- putPointE Normal opts "creating indirections" $ (sm,warnings) <- -- putPointE Normal opts "creating indirections" $
runCheck $ extendModule cwd srcgr sm1 runCheck' opts $ extendModule cwd srcgr sm1
warnOut opts warnings warnOut opts warnings
if flag optTagsOnly opts if flag optTagsOnly opts
@@ -114,7 +114,7 @@ compileSourceModule opts cwd mb_gfFile gr =
putpp s = if null s then id else putPointE Verbose opts (" "++s++" ") putpp s = if null s then id else putPointE Verbose opts (" "++s++" ")
-- * Running a compiler pass, with impedance matching -- * Running a compiler pass, with impedance matching
runPass = runPass' fst fst snd (liftErr . runCheck) runPass = runPass' fst fst snd (liftErr . runCheck' opts)
runPassE = runPass2e liftErr runPassE = runPass2e liftErr
runPassI = runPass2e id id Canon runPassI = runPass2e id id Canon
runPass2e lift f = runPass' id f (const "") lift runPass2e lift f = runPass' id f (const "") lift

View File

@@ -13,7 +13,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Infra.CheckM module GF.Infra.CheckM
(Check, CheckResult, Message, runCheck, (Check, CheckResult, Message, runCheck, runCheck',
checkError, checkCond, checkWarn, checkWarnings, checkAccumError, checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
checkIn, checkInModule, checkMap, checkMapRecover, checkIn, checkInModule, checkMap, checkMapRecover,
parallelCheck, accumulateError, commitCheck, parallelCheck, accumulateError, commitCheck,
@@ -23,6 +23,7 @@ import GF.Data.Operations
--import GF.Infra.Ident --import GF.Infra.Ident
--import GF.Grammar.Grammar(msrc) -- ,Context --import GF.Grammar.Grammar(msrc) -- ,Context
import GF.Infra.Location(ppLocation,sourcePath) import GF.Infra.Location(ppLocation,sourcePath)
import GF.Infra.Option(Options,noOptions,verbAtLeast,Verbosity(..))
import qualified Data.Map as Map import qualified Data.Map as Map
import GF.Text.Pretty import GF.Text.Pretty
@@ -98,15 +99,19 @@ commitCheck c =
list = vcat . reverse list = vcat . reverse
-- | Run an error check, report errors and warnings -- | Run an error check, report errors and warnings
runCheck :: ErrorMonad m => Check a -> m (a,String) runCheck c = runCheck' noOptions c
runCheck c =
-- | Run an error check, report errors and (optionally) warnings
runCheck' :: ErrorMonad m => Options -> Check a -> m (a,String)
runCheck' opts c =
case unCheck c {-[]-} ([],[]) of case unCheck c {-[]-} ([],[]) of
(([],ws),Success v) -> return (v,render (list ws)) (([],ws),Success v) -> return (v,render (wlist ws))
(msgs ,Success v) -> bad msgs (msgs ,Success v) -> bad msgs
((es,ws),Fail e) -> bad ((e:es),ws) ((es,ws),Fail e) -> bad ((e:es),ws)
where where
bad (es,ws) = raise (render $ list ws $$ list es) bad (es,ws) = raise (render $ wlist ws $$ list es)
list = vcat . reverse list = vcat . reverse
wlist ws = if verbAtLeast opts Normal then list ws else empty
parallelCheck :: [Check a] -> Check [a] parallelCheck :: [Check a] -> Check [a]
parallelCheck cs = parallelCheck cs =