mirror of
https://github.com/GaloisInc/cryptol.git
synced 2025-01-05 23:17:42 +03:00
Add a prover-validate flag and pass it to SBV (default: off)
This should address the issue reported in https://github.com/GaloisInc/cryptol/issues/558
This commit is contained in:
parent
f3a26e24b7
commit
375166d06f
@ -574,6 +574,7 @@ onlineProveSat isSat str mfile = do
|
|||||||
proverName <- getKnownUser "prover"
|
proverName <- getKnownUser "prover"
|
||||||
verbose <- getKnownUser "debug"
|
verbose <- getKnownUser "debug"
|
||||||
satNum <- getUserSatNum
|
satNum <- getUserSatNum
|
||||||
|
modelValidate <- getUserProverValidate
|
||||||
parseExpr <- replParseExpr str
|
parseExpr <- replParseExpr str
|
||||||
(_, expr, schema) <- replCheckExpr parseExpr
|
(_, expr, schema) <- replCheckExpr parseExpr
|
||||||
validEvalContext expr
|
validEvalContext expr
|
||||||
@ -584,6 +585,7 @@ onlineProveSat isSat str mfile = do
|
|||||||
pcQueryType = if isSat then SatQuery satNum else ProveQuery
|
pcQueryType = if isSat then SatQuery satNum else ProveQuery
|
||||||
, pcProverName = proverName
|
, pcProverName = proverName
|
||||||
, pcVerbose = verbose
|
, pcVerbose = verbose
|
||||||
|
, pcValidate = modelValidate
|
||||||
, pcProverStats = timing
|
, pcProverStats = timing
|
||||||
, pcExtraDecls = decls
|
, pcExtraDecls = decls
|
||||||
, pcSmtFile = mfile
|
, pcSmtFile = mfile
|
||||||
@ -597,6 +599,7 @@ onlineProveSat isSat str mfile = do
|
|||||||
offlineProveSat :: Bool -> String -> Maybe FilePath -> REPL (Either String String)
|
offlineProveSat :: Bool -> String -> Maybe FilePath -> REPL (Either String String)
|
||||||
offlineProveSat isSat str mfile = do
|
offlineProveSat isSat str mfile = do
|
||||||
verbose <- getKnownUser "debug"
|
verbose <- getKnownUser "debug"
|
||||||
|
modelValidate <- getUserProverValidate
|
||||||
parseExpr <- replParseExpr str
|
parseExpr <- replParseExpr str
|
||||||
(_, expr, schema) <- replCheckExpr parseExpr
|
(_, expr, schema) <- replCheckExpr parseExpr
|
||||||
decls <- fmap M.deDecls getDynEnv
|
decls <- fmap M.deDecls getDynEnv
|
||||||
@ -605,6 +608,7 @@ offlineProveSat isSat str mfile = do
|
|||||||
pcQueryType = if isSat then SatQuery (SomeSat 0) else ProveQuery
|
pcQueryType = if isSat then SatQuery (SomeSat 0) else ProveQuery
|
||||||
, pcProverName = "offline"
|
, pcProverName = "offline"
|
||||||
, pcVerbose = verbose
|
, pcVerbose = verbose
|
||||||
|
, pcValidate = modelValidate
|
||||||
, pcProverStats = timing
|
, pcProverStats = timing
|
||||||
, pcExtraDecls = decls
|
, pcExtraDecls = decls
|
||||||
, pcSmtFile = mfile
|
, pcSmtFile = mfile
|
||||||
|
@ -62,6 +62,7 @@ module Cryptol.REPL.Monad (
|
|||||||
, userOptions
|
, userOptions
|
||||||
, getUserSatNum
|
, getUserSatNum
|
||||||
, getUserShowProverStats
|
, getUserShowProverStats
|
||||||
|
, getUserProverValidate
|
||||||
|
|
||||||
-- ** Configurable Output
|
-- ** Configurable Output
|
||||||
, getPutStr
|
, getPutStr
|
||||||
@ -709,6 +710,9 @@ badIsEnv x = panic "fromEnvVal" [ "[REPL] Expected a `" ++ x ++ "` value." ]
|
|||||||
getUserShowProverStats :: REPL Bool
|
getUserShowProverStats :: REPL Bool
|
||||||
getUserShowProverStats = getKnownUser "prover-stats"
|
getUserShowProverStats = getKnownUser "prover-stats"
|
||||||
|
|
||||||
|
getUserProverValidate :: REPL Bool
|
||||||
|
getUserProverValidate = getKnownUser "prover-validate"
|
||||||
|
|
||||||
-- Environment Options ---------------------------------------------------------
|
-- Environment Options ---------------------------------------------------------
|
||||||
|
|
||||||
type OptionMap = Trie OptionDescr
|
type OptionMap = Trie OptionDescr
|
||||||
@ -795,6 +799,9 @@ userOptions = mkOptionMap
|
|||||||
|
|
||||||
, simpleOpt "prover-stats" (EnvBool True) noCheck
|
, simpleOpt "prover-stats" (EnvBool True) noCheck
|
||||||
"Enable prover timing statistics."
|
"Enable prover timing statistics."
|
||||||
|
|
||||||
|
, simpleOpt "prover-validate" (EnvBool False) noCheck
|
||||||
|
"Validate :sat examples and :prove counter-examples for correctness."
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
@ -93,6 +93,8 @@ data ProverCommand = ProverCommand {
|
|||||||
-- ^ Which prover to use (one of the strings in 'proverConfigs')
|
-- ^ Which prover to use (one of the strings in 'proverConfigs')
|
||||||
, pcVerbose :: Bool
|
, pcVerbose :: Bool
|
||||||
-- ^ Verbosity flag passed to SBV
|
-- ^ Verbosity flag passed to SBV
|
||||||
|
, pcValidate :: Bool
|
||||||
|
-- ^ Model validation flag passed to SBV
|
||||||
, pcProverStats :: !(IORef ProverStats)
|
, pcProverStats :: !(IORef ProverStats)
|
||||||
-- ^ Record timing information here
|
-- ^ Record timing information here
|
||||||
, pcExtraDecls :: [DeclGroup]
|
, pcExtraDecls :: [DeclGroup]
|
||||||
@ -148,7 +150,10 @@ satProve ProverCommand {..} =
|
|||||||
}]
|
}]
|
||||||
|
|
||||||
|
|
||||||
let provers' = [ p { SBV.timing = SaveTiming pcProverStats, SBV.verbose = pcVerbose } | p <- provers ]
|
let provers' = [ p { SBV.timing = SaveTiming pcProverStats
|
||||||
|
, SBV.verbose = pcVerbose
|
||||||
|
, SBV.validateModel = pcValidate
|
||||||
|
} | p <- provers ]
|
||||||
let tyFn = if isSat then existsFinType else forallFinType
|
let tyFn = if isSat then existsFinType else forallFinType
|
||||||
let lPutStrLn = M.withLogger logPutStrLn
|
let lPutStrLn = M.withLogger logPutStrLn
|
||||||
let doEval :: MonadIO m => Eval.Eval a -> m a
|
let doEval :: MonadIO m => Eval.Eval a -> m a
|
||||||
|
Loading…
Reference in New Issue
Block a user