------------------------------------------------------------------------------- |-- Module : Data.SBV.Provers.Prover-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental-- Portability : portable---- Provable abstraction and the connection to SMT solvers-----------------------------------------------------------------------------{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE OverlappingInstances #-}{-# LANGUAGE PatternGuards #-}{-# LANGUAGE BangPatterns #-}moduleData.SBV.Provers.Prover(SMTSolver(..),SMTConfig(..),Predicate,Provable(..),ThmResult(..),SatResult(..),AllSatResult(..),SMTResult(..),isSatisfiable,isTheorem,isSatisfiableWithin,isTheoremWithin,numberOfModels,Equality(..),prove,proveWith,sat,satWith,allSat,allSatWith,SatModel(..),getModel,displayModels,defaultSMTCfg,verboseSMTCfg,timingSMTCfg,verboseTimingSMTCfg,Yices.yices,timeout)whereimportControl.Monad(when)importControl.Concurrent(forkIO)importControl.Concurrent.Chan.Strict(newChan,writeChan,getChanContents)importData.Maybe(fromJust,isJust,catMaybes)importData.SBV.BitVectors.DataimportData.SBV.BitVectors.ModelimportData.SBV.SMT.SMTimportData.SBV.SMT.SMTLibimportqualifiedData.SBV.Provers.YicesasYicesimportData.SBV.Utils.TDiff-- | Default configuration for the SMT solver. Non-verbose, non-timing, prints results in base 10, and uses-- the Yices SMT solver.defaultSMTCfg::SMTConfigdefaultSMTCfg=SMTConfig{verbose=False,timing=False,printBase=10,solver=Yices.yices}-- | Same as 'defaultSMTCfg', except verboseverboseSMTCfg::SMTConfigverboseSMTCfg=defaultSMTCfg{verbose=True}-- | Same as 'defaultSMTCfg', except prints timing infotimingSMTCfg::SMTConfigtimingSMTCfg=defaultSMTCfg{timing=True}-- | Same as 'defaultSMTCfg', except both verbose and timing infoverboseTimingSMTCfg::SMTConfigverboseTimingSMTCfg=timingSMTCfg{verbose=True}-- We might need a better system if we add more backend solvers-- | Adds a time out of @n@ seconds to a given solver configurationtimeout::Int->SMTConfig->SMTConfigtimeoutns|nm==nameYices.yices=s{solver=Yices.timeoutn(solvers)}|True=error$"SBV.Prover.timeout: Solver "++shownm++" does not support time-outs"wherenm=name(solvers)-- | A predicate is a symbolic program that returns a (symbolic) boolean value. For all intents and-- purposes, it can be treated as an n-ary function from symbolic-values to a boolean. The 'Symbolic'-- monad captures the underlying representation, and can/should be ignored by the users of the library,-- unless you are building further utilities on top of SBV itself. Instead, simply use the 'Predicate'-- type when necessary.typePredicate=SymbolicSBool-- | A type @a@ is provable if we can turn it into a predicate.-- Note that a predicate can be made from a curried function of arbitrary arity, where-- each element is either a symbolic type or up-to a 7-tuple of symbolic-types. So-- predicates can be constructed from almost arbitrary Haskell functions that have arbitrary-- shapes. (See the instance declarations below.)classProvableawhere-- | Turns a value into a predicate, internally naming the inputs.-- In this case the sbv library will use names of the form @s1, s2@, etc. to name these variables-- Example:---- > forAll_ $ \(x::SWord8) y -> x `shiftL` 2 .== y---- is a predicate with two arguments, captured using an ordinary Haskell function. Internally,-- @x@ will be named @s0@ and @y@ will be named @s1@.forAll_::a->Predicate-- | Turns a value into a predicate, allowing users to provide names for the inputs.-- If the user does not provide enough number of names for the free variables, the remaining ones-- will be internally generated. Note that the names are only used for printing models and has no-- other significance; in particular, we do not check that they are unique. Example:---- > forAll ["x", "y"] $ \(x::SWord8) y -> x `shiftL` 2 .== y---- This is the same as above, except the variables will be named @x@ and @y@ respectively,-- simplifying the counter-examples when they are printed.forAll::[String]->a->PredicateinstanceProvablePredicatewhereforAll_=idforAll_=idinstanceProvableSBoolwhereforAll_=outputforAll_=output{-
-- The following works, but it lets us write properties that
-- are typically bogus.. Such as: prove $ \x y -> (x::SInt8) == y
instance Provable Bool where
forAll_ x = forAll_ (if x then true else false :: SBool)
forAll s x = forAll s (if x then true else false :: SBool)
-}-- Functionsinstance(SymWorda,Provablep)=>Provable(SBVa->p)whereforAll_k=free_>>=\a->forAll_$kaforAll(s:ss)k=frees>>=\a->forAllss$kaforAll[]k=forAll_k-- Arrays (memory)instance(HasSignAndSizea,HasSignAndSizeb,SymArrayarray,Provablep)=>Provable(arrayab->p)whereforAll_k=newArray_Nothing>>=\a->forAll_$kaforAll(s:ss)k=newArraysNothing>>=\a->forAllss$kaforAll[]k=forAll_k-- 2 Tupleinstance(SymWorda,SymWordb,Provablep)=>Provable((SBVa,SBVb)->p)whereforAll_k=free_>>=\a->forAll_$\b->k(a,b)forAll(s:ss)k=frees>>=\a->forAllss$\b->k(a,b)forAll[]k=forAll_k-- 3 Tupleinstance(SymWorda,SymWordb,SymWordc,Provablep)=>Provable((SBVa,SBVb,SBVc)->p)whereforAll_k=free_>>=\a->forAll_$\bc->k(a,b,c)forAll(s:ss)k=frees>>=\a->forAllss$\bc->k(a,b,c)forAll[]k=forAll_k-- 4 Tupleinstance(SymWorda,SymWordb,SymWordc,SymWordd,Provablep)=>Provable((SBVa,SBVb,SBVc,SBVd)->p)whereforAll_k=free_>>=\a->forAll_$\bcd->k(a,b,c,d)forAll(s:ss)k=frees>>=\a->forAllss$\bcd->k(a,b,c,d)forAll[]k=forAll_k-- 5 Tupleinstance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,Provablep)=>Provable((SBVa,SBVb,SBVc,SBVd,SBVe)->p)whereforAll_k=free_>>=\a->forAll_$\bcde->k(a,b,c,d,e)forAll(s:ss)k=frees>>=\a->forAllss$\bcde->k(a,b,c,d,e)forAll[]k=forAll_k-- 6 Tupleinstance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,SymWordf,Provablep)=>Provable((SBVa,SBVb,SBVc,SBVd,SBVe,SBVf)->p)whereforAll_k=free_>>=\a->forAll_$\bcdef->k(a,b,c,d,e,f)forAll(s:ss)k=frees>>=\a->forAllss$\bcdef->k(a,b,c,d,e,f)forAll[]k=forAll_k-- 7 Tupleinstance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,SymWordf,SymWordg,Provablep)=>Provable((SBVa,SBVb,SBVc,SBVd,SBVe,SBVf,SBVg)->p)whereforAll_k=free_>>=\a->forAll_$\bcdefg->k(a,b,c,d,e,f,g)forAll(s:ss)k=frees>>=\a->forAllss$\bcdefg->k(a,b,c,d,e,f,g)forAll[]k=forAll_k-- | Prove a predicate, equivalent to @'proveWith' 'defaultSMTCfg'@prove::Provablea=>a->IOThmResultprove=proveWithdefaultSMTCfg-- | Find a satisfying assignment for a predicate, equivalent to @'satWith' 'defaultSMTCfg'@sat::Provablea=>a->IOSatResultsat=satWithdefaultSMTCfg-- | Return all satisfying assignments for a predicate, equivalent to @'allSatWith' 'defaultSMTCfg'@.-- Satisfying assignments are constructed lazily, so they will be available as returned by the solver-- and on demand.---- NB. Uninterpreted constant/function values and counter-examples for array values are ignored for-- the purposes of @'allSat'@. That is, only the satisfying assignments modulo uninterpreted functions and-- array inputs will be returned. This is due to the limitation of not having a robust means of getting a-- function counter-example back from the SMT solver.allSat::Provablea=>a->IOAllSatResultallSat=allSatWithdefaultSMTCfg-- Decision procedures (with optional timeout)checkTheorem::Provablea=>MaybeInt->a->IO(MaybeBool)checkTheoremmbTop=dor<-prpcaserofThmResult(Unsatisfiable_)->return$JustTrueThmResult(Satisfiable__)->return$JustFalseThmResult(TimeOut_)->returnNothing_->error$"SBV.isTheorem: Received:\n"++showrwherepr=maybeprove(\i->proveWith(timeoutidefaultSMTCfg))mbTocheckSatisfiable::Provablea=>MaybeInt->a->IO(MaybeBool)checkSatisfiablembTop=dor<-spcaserofSatResult(Satisfiable__)->return$JustTrueSatResult(Unsatisfiable_)->return$JustFalseSatResult(TimeOut_)->returnNothing_->error$"SBV.isSatisfiable: Received: "++showrwheres=maybesat(\i->satWith(timeoutidefaultSMTCfg))mbTo-- | Checks theoremhood within the given time limit of @i@ seconds.-- Returns @Nothing@ if times out, or the result wrapped in a @Just@ otherwise.isTheoremWithin::Provablea=>Int->a->IO(MaybeBool)isTheoremWithini=checkTheorem(Justi)-- | Checks satisfiability within the given time limit of @i@ seconds.-- Returns @Nothing@ if times out, or the result wrapped in a @Just@ otherwise.isSatisfiableWithin::Provablea=>Int->a->IO(MaybeBool)isSatisfiableWithini=checkSatisfiable(Justi)-- | Checks theoremhoodisTheorem::Provablea=>a->IOBoolisTheoremp=fromJust`fmap`checkTheoremNothingp-- | Checks satisfiabilityisSatisfiable::Provablea=>a->IOBoolisSatisfiablep=fromJust`fmap`checkSatisfiableNothingp-- | Returns the number of models that satisfy the predicate, as it would-- be returned by 'allSat'. Note that the number of models is always a-- finite number, and hence this will always return a result. Of course,-- computing it might take quite long, as it literally generates and counts-- the number of satisfying models.numberOfModels::Provablea=>a->IOIntnumberOfModelsp=doAllSatResultrs<-allSatpreturn$sum$mapwalkrswherewalk(Satisfiable{})=1-- shouldn't happen, but just in casewalkr=error$"numberOfModels: Unexpected result from an allSat check: "++show(AllSatResult[r])-- | Proves the predicate using the given SMT-solverproveWith::Provablea=>SMTConfig->a->IOThmResultproveWithconfiga=generateTraceconfigFalsea>>=callSolver[]"Checking Theoremhood.."ThmResultconfig-- | Find a satisfying assignment using the given SMT-solversatWith::Provablea=>SMTConfig->a->IOSatResultsatWithconfiga=generateTraceconfigTruea>>=callSolver[]"Checking Satisfiability.."SatResultconfig-- | Find all satisfying assignments using the given SMT-solverallSatWith::Provablea=>SMTConfig->a->IOAllSatResultallSatWithconfigp=dowhen(verboseconfig)$putStrLn"** Checking Satisfiability, all solutions.."sbvPgm<-generateTraceconfigTruepresChan<-newChanletadd=writeChanresChan.Juststop=writeChanresChanNothingfinalr=addr>>stop-- only fork if non-verbose.. otherwise stdout gets garbledforkio=ifverboseconfigthenioelseforkIOio>>return()fork$gosbvPgmaddstopfinal(1::Int)[]results<-getChanContentsresChanreturn$AllSatResult$mapfromJust$takeWhileisJustresultswheregosbvPgmaddstopfinal=loopwhereloop!nnonEqConsts=doSatResultr<-callSolvernonEqConsts("Looking for solution "++shown)SatResultconfigsbvPgmcaserofSatisfiable_(SMTModel[]__)->finalrUnknown_(SMTModel[]__)->finalrProofError__->finalrTimeOut_->stopUnsatisfiable_->stopSatisfiable_model->addr>>loop(n+1)(modelAssocsmodel:nonEqConsts)Unknown_model->addr>>loop(n+1)(modelAssocsmodel:nonEqConsts)callSolver::[[(String,CW)]]->String->(SMTResult->b)->SMTConfig->([NamedSymVar],[(String,UnintKind)],SMTLibPgm)->IObcallSolvernonEqConstraintscheckMsgwrapconfig(inps,modelMap,smtLibPgm)=doletmsg=when(verboseconfig).putStrLn.("** "++)msgcheckMsgletfinalPgm=addNonEqConstraintsnonEqConstraintssmtLibPgmmsg$"Generated SMTLib program:\n"++finalPgmsmtAnswer<-engine(solverconfig)configinpsmodelMapfinalPgmmsg"Done.."return$wrapsmtAnswergenerateTrace::Provablea=>SMTConfig->Bool->a->IO([NamedSymVar],[(String,UnintKind)],SMTLibPgm)generateTraceconfigisSatpredicate=doletmsg=when(verboseconfig).putStrLn.("** "++)isTiming=timingconfigmsg"Starting symbolic simulation.."res<-timeIfisTiming"problem construction"$runSymbolic$forAll_predicatemsg$"Generated symbolic trace:\n"++showresmsg"Translating to SMT-Lib.."caseresofResultisconststblsarrsuispgm[o@(SW{})]->timeIfisTiming"translation"$letuiMap=catMaybes(maparrayUIKindarrs)++mapunintFnUIKinduisinreturn(is,uiMap,toSMTLibisSatisconststblsarrsuispgmo)_->error$"SBVProver.callSolver: Impossible happened: "++showres-- | Equality as a proof method. Allows for-- very concise construction of equivalence proofs, which is very typical in-- bit-precise proofs.infix4===classEqualityawhere(===)::a->a->IOThmResultinstance(SymWorda,EqSymbolicz)=>Equality(SBVa->z)wherek===l=prove$\a->ka.==lainstance(SymWorda,SymWordb,EqSymbolicz)=>Equality(SBVa->SBVb->z)wherek===l=prove$\ab->kab.==labinstance(SymWorda,SymWordb,EqSymbolicz)=>Equality((SBVa,SBVb)->z)wherek===l=prove$\ab->k(a,b).==l(a,b)instance(SymWorda,SymWordb,SymWordc,EqSymbolicz)=>Equality(SBVa->SBVb->SBVc->z)wherek===l=prove$\abc->kabc.==labcinstance(SymWorda,SymWordb,SymWordc,EqSymbolicz)=>Equality((SBVa,SBVb,SBVc)->z)wherek===l=prove$\abc->k(a,b,c).==l(a,b,c)instance(SymWorda,SymWordb,SymWordc,SymWordd,EqSymbolicz)=>Equality(SBVa->SBVb->SBVc->SBVd->z)wherek===l=prove$\abcd->kabcd.==labcdinstance(SymWorda,SymWordb,SymWordc,SymWordd,EqSymbolicz)=>Equality((SBVa,SBVb,SBVc,SBVd)->z)wherek===l=prove$\abcd->k(a,b,c,d).==l(a,b,c,d)instance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,EqSymbolicz)=>Equality(SBVa->SBVb->SBVc->SBVd->SBVe->z)wherek===l=prove$\abcde->kabcde.==labcdeinstance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,EqSymbolicz)=>Equality((SBVa,SBVb,SBVc,SBVd,SBVe)->z)wherek===l=prove$\abcde->k(a,b,c,d,e).==l(a,b,c,d,e)instance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,SymWordf,EqSymbolicz)=>Equality(SBVa->SBVb->SBVc->SBVd->SBVe->SBVf->z)wherek===l=prove$\abcdef->kabcdef.==labcdefinstance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,SymWordf,EqSymbolicz)=>Equality((SBVa,SBVb,SBVc,SBVd,SBVe,SBVf)->z)wherek===l=prove$\abcdef->k(a,b,c,d,e,f).==l(a,b,c,d,e,f)instance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,SymWordf,SymWordg,EqSymbolicz)=>Equality(SBVa->SBVb->SBVc->SBVd->SBVe->SBVf->SBVg->z)wherek===l=prove$\abcdefg->kabcdefg.==labcdefginstance(SymWorda,SymWordb,SymWordc,SymWordd,SymWorde,SymWordf,SymWordg,EqSymbolicz)=>Equality((SBVa,SBVb,SBVc,SBVd,SBVe,SBVf,SBVg)->z)wherek===l=prove$\abcdefg->k(a,b,c,d,e,f,g).==l(a,b,c,d,e,f,g)