remove iteSolver option for compat with sbv 5+

This commit is contained in:
Adam C. Foltzer 2015-09-30 14:24:21 -07:00
parent 243e051df3
commit 7d81568555
9 changed files with 25 additions and 40 deletions

View File

@ -56,7 +56,7 @@ library
process >= 1.2, process >= 1.2,
QuickCheck >= 2.7, QuickCheck >= 2.7,
random >= 1.0.1, random >= 1.0.1,
sbv >= 4.3 && < 5.0, sbv (>= 4.3 && < 5.0) || (>= 5.1 && < 5.2),
smtLib >= 1.0.7, smtLib >= 1.0.7,
syb >= 0.4, syb >= 0.4,
text >= 1.1, text >= 1.1,

Binary file not shown.

View File

@ -261,7 +261,6 @@ aliases you have defined, along with their types.
\texttt{base} & \texttt{10} & numeric base for printing words \\ \texttt{base} & \texttt{10} & numeric base for printing words \\
\texttt{debug} & \texttt{off} & whether to print verbose debugging information \\ \texttt{debug} & \texttt{off} & whether to print verbose debugging information \\
\texttt{infLength} & \texttt{5} & number of elements to show from an infinite sequence \\ \texttt{infLength} & \texttt{5} & number of elements to show from an infinite sequence \\
\texttt{iteSolver} & \texttt{off} & whether \texttt{:prove} calls out for help on recursive functions \\
\texttt{prover} & \texttt{cvc4} & which SMT solver to use for \texttt{:prove} \\ \texttt{prover} & \texttt{cvc4} & which SMT solver to use for \texttt{:prove} \\
\texttt{tests} & \texttt{100} & number of tests to run for \texttt{:check} \\ \texttt{tests} & \texttt{100} & number of tests to run for \texttt{:check} \\
\texttt{warnDefaulting} & \texttt{on} & \todo[inline]{talk to Iavor} \\ \texttt{warnDefaulting} & \texttt{on} & \todo[inline]{talk to Iavor} \\

Binary file not shown.

Binary file not shown.

View File

@ -360,7 +360,6 @@ cmdProveSat isSat str = do
onlineProveSat :: Bool onlineProveSat :: Bool
-> String -> String -> Maybe FilePath -> REPL () -> String -> String -> Maybe FilePath -> REPL ()
onlineProveSat isSat str proverName mfile = do onlineProveSat isSat str proverName mfile = do
EnvBool iteSolver <- getUser "iteSolver"
EnvBool verbose <- getUser "debug" EnvBool verbose <- getUser "debug"
mSatNum <- getUserSatNum mSatNum <- getUserSatNum
let cexStr | isSat = "satisfying assignment" let cexStr | isSat = "satisfying assignment"
@ -372,7 +371,7 @@ onlineProveSat isSat str proverName mfile = do
Symbolic.satProve Symbolic.satProve
isSat isSat
mSatNum mSatNum
(proverName, iteSolver, verbose) (proverName, verbose)
(M.deDecls denv) (M.deDecls denv)
mfile mfile
(expr, schema) (expr, schema)
@ -415,13 +414,12 @@ onlineProveSat isSat str proverName mfile = do
offlineProveSat :: Bool -> String -> Maybe FilePath -> REPL () offlineProveSat :: Bool -> String -> Maybe FilePath -> REPL ()
offlineProveSat isSat str mfile = do offlineProveSat isSat str mfile = do
EnvBool useIte <- getUser "iteSolver"
EnvBool vrb <- getUser "debug" EnvBool vrb <- getUser "debug"
parseExpr <- replParseExpr str parseExpr <- replParseExpr str
exsch <- replCheckExpr parseExpr exsch <- replCheckExpr parseExpr
decls <- fmap M.deDecls getDynEnv decls <- fmap M.deDecls getDynEnv
result <- liftModuleCmd $ result <- liftModuleCmd $
Symbolic.satProveOffline isSat useIte vrb decls mfile exsch Symbolic.satProveOffline isSat vrb decls mfile exsch
case result of case result of
Symbolic.ProverError msg -> rPutStrLn msg Symbolic.ProverError msg -> rPutStrLn msg
Symbolic.EmptyResult -> return () Symbolic.EmptyResult -> return ()

View File

@ -529,8 +529,6 @@ userOptions = mkOptionMap
"The maximum number of :sat solutions to display (\"all\" for no limit)." "The maximum number of :sat solutions to display (\"all\" for no limit)."
, simpleOpt "prover" (EnvString "cvc4") checkProver $ , simpleOpt "prover" (EnvString "cvc4") checkProver $
"The external SMT solver for :prove and :sat (" ++ proverListString ++ ")." "The external SMT solver for :prove and :sat (" ++ proverListString ++ ")."
, simpleOpt "iteSolver" (EnvBool False) (const $ return Nothing)
"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) , simpleOpt "warnShadowing" (EnvBool True) (const $ return Nothing)

View File

@ -41,6 +41,14 @@ import Data.Monoid (Monoid(..))
import Data.Traversable (traverse) import Data.Traversable (traverse)
#endif #endif
#if MIN_VERSION_sbv(5,1,0)
smtMode :: SBV.SMTLibVersion
smtMode = SBV.SMTLib2
#else
smtMode :: Bool
smtMode = True
#endif
-- External interface ---------------------------------------------------------- -- External interface ----------------------------------------------------------
proverConfigs :: [(String, SBV.SMTConfig)] proverConfigs :: [(String, SBV.SMTConfig)]
@ -83,12 +91,12 @@ thmSMTResults (SBV.ThmResult r) = [r]
satProve :: Bool satProve :: Bool
-> Maybe Int -- ^ satNum -> Maybe Int -- ^ satNum
-> (String, Bool, Bool) -> (String, Bool)
-> [DeclGroup] -> [DeclGroup]
-> Maybe FilePath -> Maybe FilePath
-> (Expr, Schema) -> (Expr, Schema)
-> M.ModuleCmd ProverResult -> M.ModuleCmd ProverResult
satProve isSat mSatNum (proverName, useSolverIte, verbose) edecls mfile (expr, schema) = protectStack useSolverIte $ \modEnv -> do satProve isSat mSatNum (proverName, verbose) edecls mfile (expr, schema) = protectStack $ \modEnv -> do
let extDgs = allDeclGroups modEnv ++ edecls let extDgs = allDeclGroups modEnv ++ edecls
provers <- provers <-
case proverName of case proverName of
@ -109,7 +117,7 @@ satProve isSat mSatNum (proverName, useSolverIte, verbose) edecls mfile (expr, s
case predArgTypes schema of case predArgTypes schema of
Left msg -> return (Right (ProverError msg, modEnv), []) Left msg -> return (Right (ProverError msg, modEnv), [])
Right ts -> do when verbose $ putStrLn "Simulating..." Right ts -> do when verbose $ putStrLn "Simulating..."
let env = evalDecls (emptyEnv useSolverIte) extDgs let env = evalDecls emptyEnv extDgs
let v = evalExpr env expr let v = evalExpr env expr
results' <- runFn $ do results' <- runFn $ do
args <- mapM tyFn ts args <- mapM tyFn ts
@ -147,14 +155,13 @@ satProve isSat mSatNum (proverName, useSolverIte, verbose) edecls mfile (expr, s
return (Right (esatexprs, modEnv), []) return (Right (esatexprs, modEnv), [])
satProveOffline :: Bool satProveOffline :: Bool
-> Bool
-> Bool -> Bool
-> [DeclGroup] -> [DeclGroup]
-> Maybe FilePath -> Maybe FilePath
-> (Expr, Schema) -> (Expr, Schema)
-> M.ModuleCmd ProverResult -> M.ModuleCmd ProverResult
satProveOffline isSat useIte vrb edecls mfile (expr, schema) = satProveOffline isSat vrb edecls mfile (expr, schema) =
protectStack useIte $ \modEnv -> do protectStack $ \modEnv -> do
let extDgs = allDeclGroups modEnv ++ edecls let extDgs = allDeclGroups modEnv ++ edecls
let tyFn = if isSat then existsFinType else forallFinType let tyFn = if isSat then existsFinType else forallFinType
let filename = fromMaybe "standard output" mfile let filename = fromMaybe "standard output" mfile
@ -162,11 +169,11 @@ satProveOffline isSat useIte vrb edecls mfile (expr, schema) =
Left msg -> return (Right (ProverError msg, modEnv), []) Left msg -> return (Right (ProverError msg, modEnv), [])
Right ts -> Right ts ->
do when vrb $ putStrLn "Simulating..." do when vrb $ putStrLn "Simulating..."
let env = evalDecls (emptyEnv useIte) extDgs let env = evalDecls emptyEnv extDgs
let v = evalExpr env expr let v = evalExpr env expr
let satWord | isSat = "satisfiability" let satWord | isSat = "satisfiability"
| otherwise = "validity" | otherwise = "validity"
txt <- SBV.compileToSMTLib True isSat $ do txt <- SBV.compileToSMTLib smtMode isSat $ do
args <- mapM tyFn ts args <- mapM tyFn ts
b <- return $! fromVBit (foldl fromVFun v args) b <- return $! fromVBit (foldl fromVFun v args)
liftIO $ putStrLn $ liftIO $ putStrLn $
@ -180,16 +187,12 @@ satProveOffline isSat useIte vrb edecls mfile (expr, schema) =
Nothing -> putStr txt Nothing -> putStr txt
return (Right (EmptyResult, modEnv), []) return (Right (EmptyResult, modEnv), [])
protectStack :: Bool protectStack :: M.ModuleCmd ProverResult
-> M.ModuleCmd ProverResult -> M.ModuleCmd ProverResult
-> M.ModuleCmd ProverResult protectStack cmd modEnv = X.catchJust isOverflow (cmd modEnv) handler
protectStack usingITE cmd modEnv = X.catchJust isOverflow (cmd modEnv) handler
where isOverflow X.StackOverflow = Just () where isOverflow X.StackOverflow = Just ()
isOverflow _ = Nothing isOverflow _ = Nothing
msg | usingITE = msgBase msg = "Symbolic evaluation failed to terminate."
| otherwise = msgBase ++ "\n" ++
"Using ':set iteSolver=on' might help."
msgBase = "Symbolic evaluation failed to terminate."
handler () = return (Right (ProverError msg, modEnv), []) handler () = return (Right (ProverError msg, modEnv), [])
parseValues :: [FinType] -> [SBV.CW] -> ([Eval.Value], [SBV.CW]) parseValues :: [FinType] -> [SBV.CW] -> ([Eval.Value], [SBV.CW])
@ -289,24 +292,21 @@ existsFinType ty =
data Env = Env data Env = Env
{ envVars :: Map.Map QName Value { envVars :: Map.Map QName Value
, envTypes :: Map.Map TVar TValue , envTypes :: Map.Map TVar TValue
, envIteSolver :: Bool
} }
instance Monoid Env where instance Monoid Env where
mempty = Env mempty = Env
{ envVars = Map.empty { envVars = Map.empty
, envTypes = Map.empty , envTypes = Map.empty
, envIteSolver = False
} }
mappend l r = Env mappend l r = Env
{ envVars = Map.union (envVars l) (envVars r) { envVars = Map.union (envVars l) (envVars r)
, envTypes = Map.union (envTypes l) (envTypes r) , envTypes = Map.union (envTypes l) (envTypes r)
, envIteSolver = envIteSolver l || envIteSolver r
} }
emptyEnv :: Bool -> Env emptyEnv :: Env
emptyEnv useIteSolver = Env Map.empty Map.empty useIteSolver emptyEnv = mempty
-- | Bind a variable in the evaluation environment. -- | Bind a variable in the evaluation environment.
bindVar :: (QName, Value) -> Env -> Env bindVar :: (QName, Value) -> Env -> Env
@ -334,8 +334,7 @@ evalExpr env expr =
ETuple es -> VTuple (map eval es) ETuple es -> VTuple (map eval es)
ERec fields -> VRecord [ (f, eval e) | (f, e) <- fields ] ERec fields -> VRecord [ (f, eval e) | (f, e) <- fields ]
ESel e sel -> evalSel sel (eval e) ESel e sel -> evalSel sel (eval e)
EIf b e1 e2 -> evalIf (fromVBit (eval b)) (eval e1) (eval e2) EIf b e1 e2 -> iteValue (fromVBit (eval b)) (eval e1) (eval e2)
where evalIf = if envIteSolver env then sBranchValue else iteValue
EComp ty e mss -> evalComp env (evalType env ty) e mss EComp ty e mss -> evalComp env (evalType env ty) e mss
EVar n -> case lookupVar n env of EVar n -> case lookupVar n env of
Just x -> x Just x -> x

View File

@ -23,7 +23,7 @@ module Cryptol.Symbolic.Value
, fromVBit, fromVFun, fromVPoly, fromVTuple, fromVRecord, lookupRecord , fromVBit, fromVFun, fromVPoly, fromVTuple, fromVRecord, lookupRecord
, fromSeq, fromVWord , fromSeq, fromVWord
, evalPanic , evalPanic
, iteValue, sBranchValue, mergeValue , iteValue, mergeValue
) )
where where
@ -75,15 +75,6 @@ iteValue c x y =
Just False -> y Just False -> y
Nothing -> mergeValue True c x y Nothing -> mergeValue True c x y
sBranchValue :: SBool -> Value -> Value -> Value
sBranchValue t x y =
case svAsBool c of
Just True -> x
Just False -> y
Nothing -> mergeValue False c x y
where
c = svReduceInPathCondition t
mergeValue :: Bool -> SBool -> Value -> Value -> Value mergeValue :: Bool -> SBool -> Value -> Value -> Value
mergeValue f c v1 v2 = mergeValue f c v1 v2 =
case (v1, v2) of case (v1, v2) of