mirror of
https://github.com/GaloisInc/cryptol.git
synced 2024-12-01 08:32:23 +03:00
remove iteSolver option for compat with sbv 5+
This commit is contained in:
parent
243e051df3
commit
7d81568555
@ -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.
@ -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} \\
|
||||||
|
BIN
docs/Syntax.pdf
BIN
docs/Syntax.pdf
Binary file not shown.
Binary file not shown.
@ -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 ()
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user