mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
Command line flag -s/-q now silences all warnings
These flags now do what the say.
This commit is contained in:
@@ -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" $
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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 =
|
||||||
|
|||||||
Reference in New Issue
Block a user