GaloisInc/cryptol
1
1
Fork 0
mirror of https://github.com/GaloisInc/cryptol.git synced 2024-12-18 21:41:52 +03:00
Code Issues Projects Releases Wiki Activity

add warnShadowing REPL option

Browse Source
This commit is contained in:
Adam C. Foltzer 2015-02-16 14:32:33 -08:00
parent 6159d223df
commit 197dc97814
2 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
cryptol/REPL/Command.hs
View File

@ -35,6 +35,7 @@ import REPL.Trie
import qualified Cryptol.ModuleSystem as M import qualified Cryptol.ModuleSystem as M
import qualified Cryptol.ModuleSystem.Base as M (preludeName) import qualified Cryptol.ModuleSystem.Base as M (preludeName)
import qualified Cryptol.ModuleSystem.NamingEnv as M import qualified Cryptol.ModuleSystem.NamingEnv as M
import qualified Cryptol.ModuleSystem.Renamer as M (RenamerWarning(SymbolShadowed))
import qualified Cryptol.Eval.Value as E import qualified Cryptol.Eval.Value as E
import qualified Cryptol.Testing.Random as TestR import qualified Cryptol.Testing.Random as TestR
@ -691,18 +692,30 @@ liftModuleCmd cmd = moduleCmdResult =<< io . cmd =<< getModuleEnv
moduleCmdResult :: M.ModuleRes a -> REPL a moduleCmdResult :: M.ModuleRes a -> REPL a
moduleCmdResult (res,ws0) = do moduleCmdResult (res,ws0) = do
EnvBool yes <- getUser "warnDefaulting" EnvBool warnDefaulting <- getUser "warnDefaulting"
EnvBool warnShadowing <- getUser "warnShadowing"
-- XXX: let's generalize this pattern
let isDefaultWarn (T.DefaultingTo _ _) = True let isDefaultWarn (T.DefaultingTo _ _) = True
isDefaultWarn _ = False isDefaultWarn _ = False
filterDefaults w | warnDefaulting = Just w
filterDefaults (M.TypeCheckWarnings xs) = filterDefaults (M.TypeCheckWarnings xs) =
case filter (not . isDefaultWarn . snd) xs of case filter (not . isDefaultWarn . snd) xs of
[] -> Nothing [] -> Nothing
ys -> Just (M.TypeCheckWarnings ys) ys -> Just (M.TypeCheckWarnings ys)
filterDefaults w = Just w filterDefaults w = Just w
let ws = if yes then ws0 isShadowWarn (M.SymbolShadowed _ _) = True
else mapMaybe filterDefaults ws0 isShadowWarn _ = False
filterShadowing w | warnShadowing = Just w
filterShadowing (M.RenamerWarnings xs) =
case filter (not . isShadowWarn) xs of
[] -> Nothing
ys -> Just (M.RenamerWarnings ys)
filterShadowing w = Just w
let ws = mapMaybe filterDefaults . mapMaybe filterShadowing $ ws0
mapM_ (rPrint . pp) ws mapM_ (rPrint . pp) ws
case res of case res of
Right (a,me') -> setModuleEnv me' >> return a Right (a,me') -> setModuleEnv me' >> return a

2
cryptol/REPL/Monad.hs
View File

@ -521,6 +521,8 @@ userOptions = mkOptionMap
"Use smt solver to filter conditional branches in proofs." "Use smt solver to filter conditional branches in proofs."
, simpleOpt "warnDefaulting" (EnvBool True) (const $ return Nothing) , simpleOpt "warnDefaulting" (EnvBool True) (const $ return Nothing)
"Choose if we should display warnings when defaulting." "Choose if we should display warnings when defaulting."
, simpleOpt "warnShadowing" (EnvBool True) (const $ return Nothing)
"Choose if we should display warnings when shadowing symbols."
, simpleOpt "smtfile" (EnvString "-") (const $ return Nothing) , simpleOpt "smtfile" (EnvString "-") (const $ return Nothing)
"The file to use for SMT-Lib scripts (for debugging or offline proving)" "The file to use for SMT-Lib scripts (for debugging or offline proving)"
, OptionDescr "mono-binds" (EnvBool True) (const $ return Nothing) , OptionDescr "mono-binds" (EnvBool True) (const $ return Nothing)