{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -Werror -fno-warn-orphans #-}
module Data.SBV.Core.Symbolic
( NodeId(..)
, SV(..), swKind, trueSV, falseSV
, Op(..), PBOp(..), OvOp(..), FPOp(..), StrOp(..), SeqOp(..), SetOp(..), RegExp(..)
, Quantifier(..), needsExistentials
, RoundingMode(..)
, SBVType(..), svUninterpreted, newUninterpreted
, SVal(..)
, svMkSymVar, sWordN, sWordN_, sIntN, sIntN_
, ArrayContext(..), ArrayInfo
, svToSV, svToSymSV, forceSVArg
, SBVExpr(..), newExpr, isCodeGenMode, isSafetyCheckingIStage, isRunIStage, isSetupIStage
, Cached, cache, uncache, modifyState, modifyIncState
, ArrayIndex(..), FArrayIndex(..), uncacheAI, uncacheFAI
, NamedSymVar
, getSValPathCondition, extendSValPathCondition
, getTableIndex
, SBVPgm(..), MonadSymbolic(..), SymbolicT, Symbolic, runSymbolic, State(..), withNewIncState, IncState(..), incrementInternalCounter
, inSMTMode, SBVRunMode(..), IStage(..), Result(..)
, registerKind, registerLabel, recordObservable
, addAssertion, addNewSMTOption, imposeConstraint, internalConstraint, internalVariable
, SMTLibPgm(..), SMTLibVersion(..), smtLibVersionExtension
, SolverCapabilities(..)
, extractSymbolicSimulationState
, OptimizeStyle(..), Objective(..), Penalty(..), objectiveName, addSValOptGoal
, MonadQuery(..), QueryT(..), Query, Queriable(..), Fresh(..), QueryState(..), QueryContext(..)
, SMTScript(..), Solver(..), SMTSolver(..), SMTResult(..), SMTModel(..), SMTConfig(..), SMTEngine
, validationRequested, outputSVal
) where
import Control.Arrow (first, second, (***))
import Control.DeepSeq (NFData(..))
import Control.Monad (when)
import Control.Monad.Except (MonadError, ExceptT)
import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT,
mapReaderT)
import Control.Monad.State.Lazy (MonadState)
import Control.Monad.Trans (MonadIO(liftIO), MonadTrans(lift))
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Writer.Strict (MonadWriter)
import Data.Char (isAlpha, isAlphaNum, toLower)
import Data.IORef (IORef, newIORef, readIORef)
import Data.List (intercalate, sortBy)
import Data.Maybe (isJust, fromJust, fromMaybe)
import Data.String (IsString(fromString))
import Data.Time (getCurrentTime, UTCTime)
import GHC.Stack
import qualified Control.Monad.State.Lazy as LS
import qualified Control.Monad.State.Strict as SS
import qualified Control.Monad.Writer.Lazy as LW
import qualified Control.Monad.Writer.Strict as SW
import qualified Data.IORef as R (modifyIORef')
import qualified Data.Generics as G (Data(..))
import qualified Data.IntMap.Strict as IMap (IntMap, empty, toAscList, lookup, insertWith)
import qualified Data.Map.Strict as Map (Map, empty, toList, lookup, insert, size)
import qualified Data.Set as Set (Set, empty, toList, insert, member)
import qualified Data.Foldable as F (toList)
import qualified Data.Sequence as S (Seq, empty, (|>))
import System.Mem.StableName
import Data.SBV.Core.Kind
import Data.SBV.Core.Concrete
import Data.SBV.SMT.SMTLibNames
import Data.SBV.Utils.TDiff (Timing)
import Data.SBV.Utils.Lib (stringToQFS)
import Data.SBV.Control.Types
#if MIN_VERSION_base(4,11,0)
import Control.Monad.Fail as Fail
#endif
newtype NodeId = NodeId Int deriving (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c== :: NodeId -> NodeId -> Bool
Eq, Eq NodeId
Eq NodeId =>
(NodeId -> NodeId -> Ordering)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> Ord NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmax :: NodeId -> NodeId -> NodeId
>= :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c< :: NodeId -> NodeId -> Bool
compare :: NodeId -> NodeId -> Ordering
$ccompare :: NodeId -> NodeId -> Ordering
$cp1Ord :: Eq NodeId
Ord)
data SV = SV !Kind !NodeId
instance Eq SV where
SV _ n1 :: NodeId
n1 == :: SV -> SV -> Bool
== SV _ n2 :: NodeId
n2 = NodeId
n1 NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
n2
instance Ord SV where
SV _ n1 :: NodeId
n1 compare :: SV -> SV -> Ordering
`compare` SV _ n2 :: NodeId
n2 = NodeId
n1 NodeId -> NodeId -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NodeId
n2
instance HasKind SV where
kindOf :: SV -> Kind
kindOf (SV k :: Kind
k _) = Kind
k
instance Show SV where
show :: SV -> String
show (SV _ (NodeId n :: Int
n)) = case Int
n of
-2 -> "false"
-1 -> "true"
_ -> 's' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n
swKind :: SV -> Kind
swKind :: SV -> Kind
swKind (SV k :: Kind
k _) = Kind
k
forceSVArg :: SV -> IO ()
forceSVArg :: SV -> IO ()
forceSVArg (SV k :: Kind
k n :: NodeId
n) = Kind
k Kind -> IO () -> IO ()
forall a b. a -> b -> b
`seq` NodeId
n NodeId -> IO () -> IO ()
forall a b. a -> b -> b
`seq` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
falseSV :: SV
falseSV :: SV
falseSV = Kind -> NodeId -> SV
SV Kind
KBool (NodeId -> SV) -> NodeId -> SV
forall a b. (a -> b) -> a -> b
$ Int -> NodeId
NodeId (-2)
trueSV :: SV
trueSV :: SV
trueSV = Kind -> NodeId -> SV
SV Kind
KBool (NodeId -> SV) -> NodeId -> SV
forall a b. (a -> b) -> a -> b
$ Int -> NodeId
NodeId (-1)
data Op = Plus
| Times
| Minus
| UNeg
| Abs
| Quot
| Rem
| Equal
| NotEqual
| LessThan
| GreaterThan
| LessEq
| GreaterEq
| Ite
| And
| Or
| XOr
| Not
| Shl
| Shr
| Rol Int
| Ror Int
| Int Int
| Join
| LkUp (Int, Kind, Kind, Int) !SV !SV
| ArrEq ArrayIndex ArrayIndex
| ArrRead ArrayIndex
| KindCast Kind Kind
| Uninterpreted String
| Label String
| IEEEFP FPOp
| PseudoBoolean PBOp
| OverflowOp OvOp
| StrOp StrOp
| SeqOp SeqOp
| SetOp SetOp
| TupleConstructor Int
| TupleAccess Int Int
| EitherConstructor Kind Kind Bool
| EitherIs Kind Kind Bool
| EitherAccess Bool
| MaybeConstructor Kind Bool
| MaybeIs Kind Bool
| MaybeAccess
deriving (Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq, Eq Op
Eq Op =>
(Op -> Op -> Ordering)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Op)
-> (Op -> Op -> Op)
-> Ord Op
Op -> Op -> Bool
Op -> Op -> Ordering
Op -> Op -> Op
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Op -> Op -> Op
$cmin :: Op -> Op -> Op
max :: Op -> Op -> Op
$cmax :: Op -> Op -> Op
>= :: Op -> Op -> Bool
$c>= :: Op -> Op -> Bool
> :: Op -> Op -> Bool
$c> :: Op -> Op -> Bool
<= :: Op -> Op -> Bool
$c<= :: Op -> Op -> Bool
< :: Op -> Op -> Bool
$c< :: Op -> Op -> Bool
compare :: Op -> Op -> Ordering
$ccompare :: Op -> Op -> Ordering
$cp1Ord :: Eq Op
Ord)
data FPOp = FP_Cast Kind Kind SV
| FP_Reinterpret Kind Kind
| FP_Abs
| FP_Neg
| FP_Add
| FP_Sub
| FP_Mul
| FP_Div
| FP_FMA
| FP_Sqrt
| FP_Rem
| FP_RoundToIntegral
| FP_Min
| FP_Max
| FP_ObjEqual
| FP_IsNormal
| FP_IsSubnormal
| FP_IsZero
| FP_IsInfinite
| FP_IsNaN
| FP_IsNegative
| FP_IsPositive
deriving (FPOp -> FPOp -> Bool
(FPOp -> FPOp -> Bool) -> (FPOp -> FPOp -> Bool) -> Eq FPOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FPOp -> FPOp -> Bool
$c/= :: FPOp -> FPOp -> Bool
== :: FPOp -> FPOp -> Bool
$c== :: FPOp -> FPOp -> Bool
Eq, Eq FPOp
Eq FPOp =>
(FPOp -> FPOp -> Ordering)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> FPOp)
-> (FPOp -> FPOp -> FPOp)
-> Ord FPOp
FPOp -> FPOp -> Bool
FPOp -> FPOp -> Ordering
FPOp -> FPOp -> FPOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FPOp -> FPOp -> FPOp
$cmin :: FPOp -> FPOp -> FPOp
max :: FPOp -> FPOp -> FPOp
$cmax :: FPOp -> FPOp -> FPOp
>= :: FPOp -> FPOp -> Bool
$c>= :: FPOp -> FPOp -> Bool
> :: FPOp -> FPOp -> Bool
$c> :: FPOp -> FPOp -> Bool
<= :: FPOp -> FPOp -> Bool
$c<= :: FPOp -> FPOp -> Bool
< :: FPOp -> FPOp -> Bool
$c< :: FPOp -> FPOp -> Bool
compare :: FPOp -> FPOp -> Ordering
$ccompare :: FPOp -> FPOp -> Ordering
$cp1Ord :: Eq FPOp
Ord)
instance Show FPOp where
show :: FPOp -> String
show (FP_Cast f :: Kind
f t :: Kind
t r :: SV
r) = "(FP_Cast: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", using RM [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ "])"
show (FP_Reinterpret f :: Kind
f t :: Kind
t) = case (Kind
f, Kind
t) of
(KBounded False 32, KFloat) -> "(_ to_fp 8 24)"
(KBounded False 64, KDouble) -> "(_ to_fp 11 53)"
_ -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "SBV.FP_Reinterpret: Unexpected conversion: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
t
show FP_Abs = "fp.abs"
show FP_Neg = "fp.neg"
show FP_Add = "fp.add"
show FP_Sub = "fp.sub"
show FP_Mul = "fp.mul"
show FP_Div = "fp.div"
show FP_FMA = "fp.fma"
show FP_Sqrt = "fp.sqrt"
show FP_Rem = "fp.rem"
show FP_RoundToIntegral = "fp.roundToIntegral"
show FP_Min = "fp.min"
show FP_Max = "fp.max"
show FP_ObjEqual = "="
show FP_IsNormal = "fp.isNormal"
show FP_IsSubnormal = "fp.isSubnormal"
show FP_IsZero = "fp.isZero"
show FP_IsInfinite = "fp.isInfinite"
show FP_IsNaN = "fp.isNaN"
show FP_IsNegative = "fp.isNegative"
show FP_IsPositive = "fp.isPositive"
data PBOp = PB_AtMost Int
| PB_AtLeast Int
| PB_Exactly Int
| PB_Le [Int] Int
| PB_Ge [Int] Int
| PB_Eq [Int] Int
deriving (PBOp -> PBOp -> Bool
(PBOp -> PBOp -> Bool) -> (PBOp -> PBOp -> Bool) -> Eq PBOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBOp -> PBOp -> Bool
$c/= :: PBOp -> PBOp -> Bool
== :: PBOp -> PBOp -> Bool
$c== :: PBOp -> PBOp -> Bool
Eq, Eq PBOp
Eq PBOp =>
(PBOp -> PBOp -> Ordering)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> PBOp)
-> (PBOp -> PBOp -> PBOp)
-> Ord PBOp
PBOp -> PBOp -> Bool
PBOp -> PBOp -> Ordering
PBOp -> PBOp -> PBOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PBOp -> PBOp -> PBOp
$cmin :: PBOp -> PBOp -> PBOp
max :: PBOp -> PBOp -> PBOp
$cmax :: PBOp -> PBOp -> PBOp
>= :: PBOp -> PBOp -> Bool
$c>= :: PBOp -> PBOp -> Bool
> :: PBOp -> PBOp -> Bool
$c> :: PBOp -> PBOp -> Bool
<= :: PBOp -> PBOp -> Bool
$c<= :: PBOp -> PBOp -> Bool
< :: PBOp -> PBOp -> Bool
$c< :: PBOp -> PBOp -> Bool
compare :: PBOp -> PBOp -> Ordering
$ccompare :: PBOp -> PBOp -> Ordering
$cp1Ord :: Eq PBOp
Ord, Int -> PBOp -> ShowS
[PBOp] -> ShowS
PBOp -> String
(Int -> PBOp -> ShowS)
-> (PBOp -> String) -> ([PBOp] -> ShowS) -> Show PBOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBOp] -> ShowS
$cshowList :: [PBOp] -> ShowS
show :: PBOp -> String
$cshow :: PBOp -> String
showsPrec :: Int -> PBOp -> ShowS
$cshowsPrec :: Int -> PBOp -> ShowS
Show)
data OvOp = Overflow_SMul_OVFL
| Overflow_SMul_UDFL
| Overflow_UMul_OVFL
deriving (OvOp -> OvOp -> Bool
(OvOp -> OvOp -> Bool) -> (OvOp -> OvOp -> Bool) -> Eq OvOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OvOp -> OvOp -> Bool
$c/= :: OvOp -> OvOp -> Bool
== :: OvOp -> OvOp -> Bool
$c== :: OvOp -> OvOp -> Bool
Eq, Eq OvOp
Eq OvOp =>
(OvOp -> OvOp -> Ordering)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> OvOp)
-> (OvOp -> OvOp -> OvOp)
-> Ord OvOp
OvOp -> OvOp -> Bool
OvOp -> OvOp -> Ordering
OvOp -> OvOp -> OvOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OvOp -> OvOp -> OvOp
$cmin :: OvOp -> OvOp -> OvOp
max :: OvOp -> OvOp -> OvOp
$cmax :: OvOp -> OvOp -> OvOp
>= :: OvOp -> OvOp -> Bool
$c>= :: OvOp -> OvOp -> Bool
> :: OvOp -> OvOp -> Bool
$c> :: OvOp -> OvOp -> Bool
<= :: OvOp -> OvOp -> Bool
$c<= :: OvOp -> OvOp -> Bool
< :: OvOp -> OvOp -> Bool
$c< :: OvOp -> OvOp -> Bool
compare :: OvOp -> OvOp -> Ordering
$ccompare :: OvOp -> OvOp -> Ordering
$cp1Ord :: Eq OvOp
Ord)
instance Show OvOp where
show :: OvOp -> String
show Overflow_SMul_OVFL = "bvsmul_noovfl"
show Overflow_SMul_UDFL = "bvsmul_noudfl"
show Overflow_UMul_OVFL = "bvumul_noovfl"
data StrOp = StrConcat
| StrLen
| StrUnit
| StrNth
| StrSubstr
| StrIndexOf
| StrContains
| StrPrefixOf
| StrSuffixOf
| StrReplace
| StrStrToNat
| StrNatToStr
| StrInRe RegExp
deriving (StrOp -> StrOp -> Bool
(StrOp -> StrOp -> Bool) -> (StrOp -> StrOp -> Bool) -> Eq StrOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrOp -> StrOp -> Bool
$c/= :: StrOp -> StrOp -> Bool
== :: StrOp -> StrOp -> Bool
$c== :: StrOp -> StrOp -> Bool
Eq, Eq StrOp
Eq StrOp =>
(StrOp -> StrOp -> Ordering)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> StrOp)
-> (StrOp -> StrOp -> StrOp)
-> Ord StrOp
StrOp -> StrOp -> Bool
StrOp -> StrOp -> Ordering
StrOp -> StrOp -> StrOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StrOp -> StrOp -> StrOp
$cmin :: StrOp -> StrOp -> StrOp
max :: StrOp -> StrOp -> StrOp
$cmax :: StrOp -> StrOp -> StrOp
>= :: StrOp -> StrOp -> Bool
$c>= :: StrOp -> StrOp -> Bool
> :: StrOp -> StrOp -> Bool
$c> :: StrOp -> StrOp -> Bool
<= :: StrOp -> StrOp -> Bool
$c<= :: StrOp -> StrOp -> Bool
< :: StrOp -> StrOp -> Bool
$c< :: StrOp -> StrOp -> Bool
compare :: StrOp -> StrOp -> Ordering
$ccompare :: StrOp -> StrOp -> Ordering
$cp1Ord :: Eq StrOp
Ord)
data RegExp = Literal String
| All
| None
| Range Char Char
| Conc [RegExp]
| KStar RegExp
| KPlus RegExp
| Opt RegExp
| Loop Int Int RegExp
| Union [RegExp]
| Inter RegExp RegExp
deriving (RegExp -> RegExp -> Bool
(RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool) -> Eq RegExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegExp -> RegExp -> Bool
$c/= :: RegExp -> RegExp -> Bool
== :: RegExp -> RegExp -> Bool
$c== :: RegExp -> RegExp -> Bool
Eq, Eq RegExp
Eq RegExp =>
(RegExp -> RegExp -> Ordering)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> RegExp)
-> (RegExp -> RegExp -> RegExp)
-> Ord RegExp
RegExp -> RegExp -> Bool
RegExp -> RegExp -> Ordering
RegExp -> RegExp -> RegExp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RegExp -> RegExp -> RegExp
$cmin :: RegExp -> RegExp -> RegExp
max :: RegExp -> RegExp -> RegExp
$cmax :: RegExp -> RegExp -> RegExp
>= :: RegExp -> RegExp -> Bool
$c>= :: RegExp -> RegExp -> Bool
> :: RegExp -> RegExp -> Bool
$c> :: RegExp -> RegExp -> Bool
<= :: RegExp -> RegExp -> Bool
$c<= :: RegExp -> RegExp -> Bool
< :: RegExp -> RegExp -> Bool
$c< :: RegExp -> RegExp -> Bool
compare :: RegExp -> RegExp -> Ordering
$ccompare :: RegExp -> RegExp -> Ordering
$cp1Ord :: Eq RegExp
Ord)
instance IsString RegExp where
fromString :: String -> RegExp
fromString = String -> RegExp
Literal
instance Num RegExp where
Conc xs :: [RegExp]
xs * :: RegExp -> RegExp -> RegExp
* y :: RegExp
y = [RegExp] -> RegExp
Conc ([RegExp]
xs [RegExp] -> [RegExp] -> [RegExp]
forall a. [a] -> [a] -> [a]
++ [RegExp
y])
x :: RegExp
x * Conc ys :: [RegExp]
ys = [RegExp] -> RegExp
Conc (RegExp
x RegExp -> [RegExp] -> [RegExp]
forall a. a -> [a] -> [a]
: [RegExp]
ys)
x :: RegExp
x * y :: RegExp
y = [RegExp] -> RegExp
Conc [RegExp
x, RegExp
y]
Union xs :: [RegExp]
xs + :: RegExp -> RegExp -> RegExp
+ y :: RegExp
y = [RegExp] -> RegExp
Union ([RegExp]
xs [RegExp] -> [RegExp] -> [RegExp]
forall a. [a] -> [a] -> [a]
++ [RegExp
y])
x :: RegExp
x + Union ys :: [RegExp]
ys = [RegExp] -> RegExp
Union (RegExp
x RegExp -> [RegExp] -> [RegExp]
forall a. a -> [a] -> [a]
: [RegExp]
ys)
x :: RegExp
x + y :: RegExp
y = [RegExp] -> RegExp
Union [RegExp
x, RegExp
y]
abs :: RegExp -> RegExp
abs = String -> RegExp -> RegExp
forall a. HasCallStack => String -> a
error "Num.RegExp: no abs method"
signum :: RegExp -> RegExp
signum = String -> RegExp -> RegExp
forall a. HasCallStack => String -> a
error "Num.RegExp: no signum method"
fromInteger :: Integer -> RegExp
fromInteger x :: Integer
x
| Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = RegExp
None
| Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = String -> RegExp
Literal ""
| Bool
True = String -> RegExp
forall a. HasCallStack => String -> a
error (String -> RegExp) -> String -> RegExp
forall a b. (a -> b) -> a -> b
$ "Num.RegExp: Only 0 and 1 makes sense as a reg-exp, no meaning for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
x
negate :: RegExp -> RegExp
negate = String -> RegExp -> RegExp
forall a. HasCallStack => String -> a
error "Num.RegExp: no negate method"
instance Show RegExp where
show :: RegExp -> String
show (Literal s :: String
s) = "(str.to.re \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
stringToQFS String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\")"
show All = "re.allchar"
show None = "re.nostr"
show (Range ch1 :: Char
ch1 ch2 :: Char
ch2) = "(re.range \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
stringToQFS [Char
ch1] String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
stringToQFS [Char
ch2] String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\")"
show (Conc []) = Integer -> String
forall a. Show a => a -> String
show (1 :: Integer)
show (Conc [x :: RegExp
x]) = RegExp -> String
forall a. Show a => a -> String
show RegExp
x
show (Conc xs :: [RegExp]
xs) = "(re.++ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((RegExp -> String) -> [RegExp] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RegExp -> String
forall a. Show a => a -> String
show [RegExp]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (KStar r :: RegExp
r) = "(re.* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (KPlus r :: RegExp
r) = "(re.+ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (Opt r :: RegExp
r) = "(re.opt " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (Loop lo :: Int
lo hi :: Int
hi r :: RegExp
r)
| Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0, Int
hi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lo = "((_ re.loop " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lo String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hi String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
| Bool
True = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "Invalid regular-expression Loop with arguments: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
lo, Int
hi)
show (Inter r1 :: RegExp
r1 r2 :: RegExp
r2) = "(re.inter " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
r1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
r2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (Union []) = "re.nostr"
show (Union [x :: RegExp
x]) = RegExp -> String
forall a. Show a => a -> String
show RegExp
x
show (Union xs :: [RegExp]
xs) = "(re.union " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((RegExp -> String) -> [RegExp] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RegExp -> String
forall a. Show a => a -> String
show [RegExp]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show StrOp where
show :: StrOp -> String
show StrConcat = "str.++"
show StrLen = "str.len"
show StrUnit = "seq.unit"
show StrNth = "seq.nth"
show StrSubstr = "str.substr"
show StrIndexOf = "str.indexof"
show StrContains = "str.contains"
show StrPrefixOf = "str.prefixof"
show StrSuffixOf = "str.suffixof"
show StrReplace = "str.replace"
show StrStrToNat = "str.to.int"
show StrNatToStr = "int.to.str"
show (StrInRe s :: RegExp
s) = "str.in.re " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> String
forall a. Show a => a -> String
show RegExp
s
data SeqOp = SeqConcat
| SeqLen
| SeqUnit
| SeqNth
| SeqSubseq
| SeqIndexOf
| SeqContains
| SeqPrefixOf
| SeqSuffixOf
| SeqReplace
deriving (SeqOp -> SeqOp -> Bool
(SeqOp -> SeqOp -> Bool) -> (SeqOp -> SeqOp -> Bool) -> Eq SeqOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqOp -> SeqOp -> Bool
$c/= :: SeqOp -> SeqOp -> Bool
== :: SeqOp -> SeqOp -> Bool
$c== :: SeqOp -> SeqOp -> Bool
Eq, Eq SeqOp
Eq SeqOp =>
(SeqOp -> SeqOp -> Ordering)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> SeqOp)
-> (SeqOp -> SeqOp -> SeqOp)
-> Ord SeqOp
SeqOp -> SeqOp -> Bool
SeqOp -> SeqOp -> Ordering
SeqOp -> SeqOp -> SeqOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SeqOp -> SeqOp -> SeqOp
$cmin :: SeqOp -> SeqOp -> SeqOp
max :: SeqOp -> SeqOp -> SeqOp
$cmax :: SeqOp -> SeqOp -> SeqOp
>= :: SeqOp -> SeqOp -> Bool
$c>= :: SeqOp -> SeqOp -> Bool
> :: SeqOp -> SeqOp -> Bool
$c> :: SeqOp -> SeqOp -> Bool
<= :: SeqOp -> SeqOp -> Bool
$c<= :: SeqOp -> SeqOp -> Bool
< :: SeqOp -> SeqOp -> Bool
$c< :: SeqOp -> SeqOp -> Bool
compare :: SeqOp -> SeqOp -> Ordering
$ccompare :: SeqOp -> SeqOp -> Ordering
$cp1Ord :: Eq SeqOp
Ord)
instance Show SeqOp where
show :: SeqOp -> String
show SeqConcat = "seq.++"
show SeqLen = "seq.len"
show SeqUnit = "seq.unit"
show SeqNth = "seq.nth"
show SeqSubseq = "seq.extract"
show SeqIndexOf = "seq.indexof"
show SeqContains = "seq.contains"
show SeqPrefixOf = "seq.prefixof"
show SeqSuffixOf = "seq.suffixof"
show SeqReplace = "seq.replace"
data SetOp = SetEqual
| SetMember
| SetInsert
| SetDelete
| SetIntersect
| SetUnion
| SetSubset
| SetDifference
| SetComplement
| SetHasSize
deriving (SetOp -> SetOp -> Bool
(SetOp -> SetOp -> Bool) -> (SetOp -> SetOp -> Bool) -> Eq SetOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetOp -> SetOp -> Bool
$c/= :: SetOp -> SetOp -> Bool
== :: SetOp -> SetOp -> Bool
$c== :: SetOp -> SetOp -> Bool
Eq, Eq SetOp
Eq SetOp =>
(SetOp -> SetOp -> Ordering)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> SetOp)
-> (SetOp -> SetOp -> SetOp)
-> Ord SetOp
SetOp -> SetOp -> Bool
SetOp -> SetOp -> Ordering
SetOp -> SetOp -> SetOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SetOp -> SetOp -> SetOp
$cmin :: SetOp -> SetOp -> SetOp
max :: SetOp -> SetOp -> SetOp
$cmax :: SetOp -> SetOp -> SetOp
>= :: SetOp -> SetOp -> Bool
$c>= :: SetOp -> SetOp -> Bool
> :: SetOp -> SetOp -> Bool
$c> :: SetOp -> SetOp -> Bool
<= :: SetOp -> SetOp -> Bool
$c<= :: SetOp -> SetOp -> Bool
< :: SetOp -> SetOp -> Bool
$c< :: SetOp -> SetOp -> Bool
compare :: SetOp -> SetOp -> Ordering
$ccompare :: SetOp -> SetOp -> Ordering
$cp1Ord :: Eq SetOp
Ord)
instance Show SetOp where
show :: SetOp -> String
show SetEqual = "=="
show SetMember = "Set.member"
show SetInsert = "Set.insert"
show SetDelete = "Set.delete"
show SetIntersect = "Set.intersect"
show SetUnion = "Set.union"
show SetSubset = "Set.subset"
show SetDifference = "Set.difference"
show SetComplement = "Set.complement"
show SetHasSize = "Set.setHasSize"
instance Show Op where
show :: Op -> String
show Shl = "<<"
show Shr = ">>"
show (Rol i :: Int
i) = "<<<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
show (Ror i :: Int
i) = ">>>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
show (Extract i :: Int
i j :: Int
j) = "choose [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]"
show (LkUp (ti :: Int
ti, at :: Kind
at, rt :: Kind
rt, l :: Int
l) i :: SV
i e :: SV
e)
= "lookup(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tinfo String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
where tinfo :: String
tinfo = "table" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ti String -> ShowS
forall a. [a] -> [a] -> [a]
++ "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
at String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
rt String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (ArrEq i :: ArrayIndex
i j :: ArrayIndex
j) = "array_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArrayIndex -> String
forall a. Show a => a -> String
show ArrayIndex
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ " == array_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArrayIndex -> String
forall a. Show a => a -> String
show ArrayIndex
j
show (ArrRead i :: ArrayIndex
i) = "select array_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArrayIndex -> String
forall a. Show a => a -> String
show ArrayIndex
i
show (KindCast fr :: Kind
fr to :: Kind
to) = "cast_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
fr String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
to
show (Uninterpreted i :: String
i) = "[uninterpreted] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
i
show (Label s :: String
s) = "[label] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
show (IEEEFP w :: FPOp
w) = FPOp -> String
forall a. Show a => a -> String
show FPOp
w
show (PseudoBoolean p :: PBOp
p) = PBOp -> String
forall a. Show a => a -> String
show PBOp
p
show (OverflowOp o :: OvOp
o) = OvOp -> String
forall a. Show a => a -> String
show OvOp
o
show (StrOp s :: StrOp
s) = StrOp -> String
forall a. Show a => a -> String
show StrOp
s
show (SeqOp s :: SeqOp
s) = SeqOp -> String
forall a. Show a => a -> String
show SeqOp
s
show (SetOp s :: SetOp
s) = SetOp -> String
forall a. Show a => a -> String
show SetOp
s
show (TupleConstructor 0) = "mkSBVTuple0"
show (TupleConstructor n :: Int
n) = "mkSBVTuple" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
show (TupleAccess i :: Int
i n :: Int
n) = "proj_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_SBVTuple" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
show (EitherConstructor k1 :: Kind
k1 k2 :: Kind
k2 False) = "(_ left_SBVEither " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (EitherConstructor k1 :: Kind
k1 k2 :: Kind
k2 True ) = "(_ right_SBVEither " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (EitherIs k1 :: Kind
k1 k2 :: Kind
k2 False) = "(_ is (left_SBVEither (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "))"
show (EitherIs k1 :: Kind
k1 k2 :: Kind
k2 True ) = "(_ is (right_SBVEither (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "))"
show (EitherAccess False) = "get_left_SBVEither"
show (EitherAccess True ) = "get_right_SBVEither"
show (MaybeConstructor k :: Kind
k False) = "(_ nothing_SBVMaybe " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind
KMaybe Kind
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (MaybeConstructor k :: Kind
k True) = "(_ just_SBVMaybe " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind
KMaybe Kind
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (MaybeIs k :: Kind
k False) = "(_ is (nothing_SBVMaybe () " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind
KMaybe Kind
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "))"
show (MaybeIs k :: Kind
k True ) = "(_ is (just_SBVMaybe (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (Kind -> Kind
KMaybe Kind
k) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "))"
show MaybeAccess = "get_just_SBVMaybe"
show op :: Op
op
| Just s :: String
s <- Op
op Op -> [(Op, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Op, String)]
syms = String
s
| Bool
True = ShowS
forall a. HasCallStack => String -> a
error "impossible happened; can't find op!"
where syms :: [(Op, String)]
syms = [ (Op
Plus, "+"), (Op
Times, "*"), (Op
Minus, "-"), (Op
UNeg, "-"), (Op
Abs, "abs")
, (Op
Quot, "quot")
, (Op
Rem, "rem")
, (Op
Equal, "=="), (Op
NotEqual, "/=")
, (Op
LessThan, "<"), (Op
GreaterThan, ">"), (Op
LessEq, "<="), (Op
GreaterEq, ">=")
, (Op
Ite, "if_then_else")
, (Op
And, "&"), (Op
Or, "|"), (Op
XOr, "^"), (Op
Not, "~")
, (Op
Join, "#")
]
data Quantifier = ALL | EX deriving Quantifier -> Quantifier -> Bool
(Quantifier -> Quantifier -> Bool)
-> (Quantifier -> Quantifier -> Bool) -> Eq Quantifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quantifier -> Quantifier -> Bool
$c/= :: Quantifier -> Quantifier -> Bool
== :: Quantifier -> Quantifier -> Bool
$c== :: Quantifier -> Quantifier -> Bool
Eq
instance Show Quantifier where
show :: Quantifier -> String
show ALL = "Forall"
show EX = "Exists"
needsExistentials :: [Quantifier] -> Bool
needsExistentials :: [Quantifier] -> Bool
needsExistentials = (Quantifier
EX Quantifier -> [Quantifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
newtype SBVType = SBVType [Kind]
deriving (SBVType -> SBVType -> Bool
(SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool) -> Eq SBVType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SBVType -> SBVType -> Bool
$c/= :: SBVType -> SBVType -> Bool
== :: SBVType -> SBVType -> Bool
$c== :: SBVType -> SBVType -> Bool
Eq, Eq SBVType
Eq SBVType =>
(SBVType -> SBVType -> Ordering)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> SBVType)
-> (SBVType -> SBVType -> SBVType)
-> Ord SBVType
SBVType -> SBVType -> Bool
SBVType -> SBVType -> Ordering
SBVType -> SBVType -> SBVType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SBVType -> SBVType -> SBVType
$cmin :: SBVType -> SBVType -> SBVType
max :: SBVType -> SBVType -> SBVType
$cmax :: SBVType -> SBVType -> SBVType
>= :: SBVType -> SBVType -> Bool
$c>= :: SBVType -> SBVType -> Bool
> :: SBVType -> SBVType -> Bool
$c> :: SBVType -> SBVType -> Bool
<= :: SBVType -> SBVType -> Bool
$c<= :: SBVType -> SBVType -> Bool
< :: SBVType -> SBVType -> Bool
$c< :: SBVType -> SBVType -> Bool
compare :: SBVType -> SBVType -> Ordering
$ccompare :: SBVType -> SBVType -> Ordering
$cp1Ord :: Eq SBVType
Ord)
instance Show SBVType where
show :: SBVType -> String
show (SBVType []) = ShowS
forall a. HasCallStack => String -> a
error "SBV: internal error, empty SBVType"
show (SBVType xs :: [Kind]
xs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " -> " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Kind -> String) -> [Kind] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Kind -> String
forall a. Show a => a -> String
show [Kind]
xs
data SBVExpr = SBVApp !Op ![SV]
deriving (SBVExpr -> SBVExpr -> Bool
(SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool) -> Eq SBVExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SBVExpr -> SBVExpr -> Bool
$c/= :: SBVExpr -> SBVExpr -> Bool
== :: SBVExpr -> SBVExpr -> Bool
$c== :: SBVExpr -> SBVExpr -> Bool
Eq, Eq SBVExpr
Eq SBVExpr =>
(SBVExpr -> SBVExpr -> Ordering)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> SBVExpr)
-> (SBVExpr -> SBVExpr -> SBVExpr)
-> Ord SBVExpr
SBVExpr -> SBVExpr -> Bool
SBVExpr -> SBVExpr -> Ordering
SBVExpr -> SBVExpr -> SBVExpr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SBVExpr -> SBVExpr -> SBVExpr
$cmin :: SBVExpr -> SBVExpr -> SBVExpr
max :: SBVExpr -> SBVExpr -> SBVExpr
$cmax :: SBVExpr -> SBVExpr -> SBVExpr
>= :: SBVExpr -> SBVExpr -> Bool
$c>= :: SBVExpr -> SBVExpr -> Bool
> :: SBVExpr -> SBVExpr -> Bool
$c> :: SBVExpr -> SBVExpr -> Bool
<= :: SBVExpr -> SBVExpr -> Bool
$c<= :: SBVExpr -> SBVExpr -> Bool
< :: SBVExpr -> SBVExpr -> Bool
$c< :: SBVExpr -> SBVExpr -> Bool
compare :: SBVExpr -> SBVExpr -> Ordering
$ccompare :: SBVExpr -> SBVExpr -> Ordering
$cp1Ord :: Eq SBVExpr
Ord)
reorder :: SBVExpr -> SBVExpr
reorder :: SBVExpr -> SBVExpr
reorder s :: SBVExpr
s = case SBVExpr
s of
SBVApp op :: Op
op [a :: SV
a, b :: SV
b] | Op -> Bool
isCommutative Op
op Bool -> Bool -> Bool
&& SV
a SV -> SV -> Bool
forall a. Ord a => a -> a -> Bool
> SV
b -> Op -> [SV] -> SBVExpr
SBVApp Op
op [SV
b, SV
a]
_ -> SBVExpr
s
where isCommutative :: Op -> Bool
isCommutative :: Op -> Bool
isCommutative o :: Op
o = Op
o Op -> [Op] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Op
Plus, Op
Times, Op
Equal, Op
NotEqual, Op
And, Op
Or, Op
XOr]
instance Show SBVExpr where
show :: SBVExpr -> String
show (SBVApp Ite [t :: SV
t, a :: SV
a, b :: SV
b]) = [String] -> String
unwords ["if", SV -> String
forall a. Show a => a -> String
show SV
t, "then", SV -> String
forall a. Show a => a -> String
show SV
a, "else", SV -> String
forall a. Show a => a -> String
show SV
b]
show (SBVApp Shl [a :: SV
a, i :: SV
i]) = [String] -> String
unwords [SV -> String
forall a. Show a => a -> String
show SV
a, "<<", SV -> String
forall a. Show a => a -> String
show SV
i]
show (SBVApp Shr [a :: SV
a, i :: SV
i]) = [String] -> String
unwords [SV -> String
forall a. Show a => a -> String
show SV
a, ">>", SV -> String
forall a. Show a => a -> String
show SV
i]
show (SBVApp (Rol i :: Int
i) [a :: SV
a]) = [String] -> String
unwords [SV -> String
forall a. Show a => a -> String
show SV
a, "<<<", Int -> String
forall a. Show a => a -> String
show Int
i]
show (SBVApp (Ror i :: Int
i) [a :: SV
a]) = [String] -> String
unwords [SV -> String
forall a. Show a => a -> String
show SV
a, ">>>", Int -> String
forall a. Show a => a -> String
show Int
i]
show (SBVApp (PseudoBoolean pb :: PBOp
pb) args :: [SV]
args) = [String] -> String
unwords (PBOp -> String
forall a. Show a => a -> String
show PBOp
pb String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (SV -> String) -> [SV] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SV -> String
forall a. Show a => a -> String
show [SV]
args)
show (SBVApp (OverflowOp op :: OvOp
op) args :: [SV]
args) = [String] -> String
unwords (OvOp -> String
forall a. Show a => a -> String
show OvOp
op String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (SV -> String) -> [SV] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SV -> String
forall a. Show a => a -> String
show [SV]
args)
show (SBVApp op :: Op
op [a :: SV
a, b :: SV
b]) = [String] -> String
unwords [SV -> String
forall a. Show a => a -> String
show SV
a, Op -> String
forall a. Show a => a -> String
show Op
op, SV -> String
forall a. Show a => a -> String
show SV
b]
show (SBVApp op :: Op
op args :: [SV]
args) = [String] -> String
unwords (Op -> String
forall a. Show a => a -> String
show Op
op String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (SV -> String) -> [SV] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SV -> String
forall a. Show a => a -> String
show [SV]
args)
newtype SBVPgm = SBVPgm {SBVPgm -> Seq (SV, SBVExpr)
pgmAssignments :: S.Seq (SV, SBVExpr)}
type NamedSymVar = (SV, String)
data OptimizeStyle = Lexicographic
| Independent
| Pareto (Maybe Int)
deriving (OptimizeStyle -> OptimizeStyle -> Bool
(OptimizeStyle -> OptimizeStyle -> Bool)
-> (OptimizeStyle -> OptimizeStyle -> Bool) -> Eq OptimizeStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptimizeStyle -> OptimizeStyle -> Bool
$c/= :: OptimizeStyle -> OptimizeStyle -> Bool
== :: OptimizeStyle -> OptimizeStyle -> Bool
$c== :: OptimizeStyle -> OptimizeStyle -> Bool
Eq, Int -> OptimizeStyle -> ShowS
[OptimizeStyle] -> ShowS
OptimizeStyle -> String
(Int -> OptimizeStyle -> ShowS)
-> (OptimizeStyle -> String)
-> ([OptimizeStyle] -> ShowS)
-> Show OptimizeStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptimizeStyle] -> ShowS
$cshowList :: [OptimizeStyle] -> ShowS
show :: OptimizeStyle -> String
$cshow :: OptimizeStyle -> String
showsPrec :: Int -> OptimizeStyle -> ShowS
$cshowsPrec :: Int -> OptimizeStyle -> ShowS
Show)
data Penalty = DefaultPenalty
| Penalty Rational (Maybe String)
deriving Int -> Penalty -> ShowS
[Penalty] -> ShowS
Penalty -> String
(Int -> Penalty -> ShowS)
-> (Penalty -> String) -> ([Penalty] -> ShowS) -> Show Penalty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Penalty] -> ShowS
$cshowList :: [Penalty] -> ShowS
show :: Penalty -> String
$cshow :: Penalty -> String
showsPrec :: Int -> Penalty -> ShowS
$cshowsPrec :: Int -> Penalty -> ShowS
Show
data Objective a = Minimize String a
| Maximize String a
| AssertWithPenalty String a Penalty
deriving (Int -> Objective a -> ShowS
[Objective a] -> ShowS
Objective a -> String
(Int -> Objective a -> ShowS)
-> (Objective a -> String)
-> ([Objective a] -> ShowS)
-> Show (Objective a)
forall a. Show a => Int -> Objective a -> ShowS
forall a. Show a => [Objective a] -> ShowS
forall a. Show a => Objective a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Objective a] -> ShowS
$cshowList :: forall a. Show a => [Objective a] -> ShowS
show :: Objective a -> String
$cshow :: forall a. Show a => Objective a -> String
showsPrec :: Int -> Objective a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Objective a -> ShowS
Show, a -> Objective b -> Objective a
(a -> b) -> Objective a -> Objective b
(forall a b. (a -> b) -> Objective a -> Objective b)
-> (forall a b. a -> Objective b -> Objective a)
-> Functor Objective
forall a b. a -> Objective b -> Objective a
forall a b. (a -> b) -> Objective a -> Objective b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Objective b -> Objective a
$c<$ :: forall a b. a -> Objective b -> Objective a
fmap :: (a -> b) -> Objective a -> Objective b
$cfmap :: forall a b. (a -> b) -> Objective a -> Objective b
Functor)
objectiveName :: Objective a -> String
objectiveName :: Objective a -> String
objectiveName (Minimize s :: String
s _) = String
s
objectiveName (Maximize s :: String
s _) = String
s
objectiveName (AssertWithPenalty s :: String
s _ _) = String
s
data QueryState = QueryState { QueryState -> Maybe Int -> String -> IO String
queryAsk :: Maybe Int -> String -> IO String
, QueryState -> Maybe Int -> String -> IO ()
querySend :: Maybe Int -> String -> IO ()
, QueryState -> Maybe Int -> IO String
queryRetrieveResponse :: Maybe Int -> IO String
, QueryState -> SMTConfig
queryConfig :: SMTConfig
, QueryState -> IO ()
queryTerminate :: IO ()
, QueryState -> Maybe Int
queryTimeOutValue :: Maybe Int
, QueryState -> Int
queryAssertionStackDepth :: Int
}
class Monad m => MonadQuery m where
queryState :: m State
default queryState :: (MonadTrans t, MonadQuery m', m ~ t m') => m State
queryState = m' State -> t m' State
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' State
forall (m :: * -> *). MonadQuery m => m State
queryState
instance MonadQuery m => MonadQuery (ExceptT e m)
instance MonadQuery m => MonadQuery (MaybeT m)
instance MonadQuery m => MonadQuery (ReaderT r m)
instance MonadQuery m => MonadQuery (SS.StateT s m)
instance MonadQuery m => MonadQuery (LS.StateT s m)
instance (MonadQuery m, Monoid w) => MonadQuery (SW.WriterT w m)
instance (MonadQuery m, Monoid w) => MonadQuery (LW.WriterT w m)
newtype QueryT m a = QueryT { QueryT m a -> ReaderT State m a
runQueryT :: ReaderT State m a }
deriving (Functor (QueryT m)
a -> QueryT m a
Functor (QueryT m) =>
(forall a. a -> QueryT m a)
-> (forall a b. QueryT m (a -> b) -> QueryT m a -> QueryT m b)
-> (forall a b c.
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c)
-> (forall a b. QueryT m a -> QueryT m b -> QueryT m b)
-> (forall a b. QueryT m a -> QueryT m b -> QueryT m a)
-> Applicative (QueryT m)
QueryT m a -> QueryT m b -> QueryT m b
QueryT m a -> QueryT m b -> QueryT m a
QueryT m (a -> b) -> QueryT m a -> QueryT m b
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
forall a. a -> QueryT m a
forall a b. QueryT m a -> QueryT m b -> QueryT m a
forall a b. QueryT m a -> QueryT m b -> QueryT m b
forall a b. QueryT m (a -> b) -> QueryT m a -> QueryT m b
forall a b c.
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (QueryT m)
forall (m :: * -> *) a. Applicative m => a -> QueryT m a
forall (m :: * -> *) a b.
Applicative m =>
QueryT m a -> QueryT m b -> QueryT m a
forall (m :: * -> *) a b.
Applicative m =>
QueryT m a -> QueryT m b -> QueryT m b
forall (m :: * -> *) a b.
Applicative m =>
QueryT m (a -> b) -> QueryT m a -> QueryT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
<* :: QueryT m a -> QueryT m b -> QueryT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
QueryT m a -> QueryT m b -> QueryT m a
*> :: QueryT m a -> QueryT m b -> QueryT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
QueryT m a -> QueryT m b -> QueryT m b
liftA2 :: (a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
<*> :: QueryT m (a -> b) -> QueryT m a -> QueryT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
QueryT m (a -> b) -> QueryT m a -> QueryT m b
pure :: a -> QueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> QueryT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (QueryT m)
Applicative, a -> QueryT m b -> QueryT m a
(a -> b) -> QueryT m a -> QueryT m b
(forall a b. (a -> b) -> QueryT m a -> QueryT m b)
-> (forall a b. a -> QueryT m b -> QueryT m a)
-> Functor (QueryT m)
forall a b. a -> QueryT m b -> QueryT m a
forall a b. (a -> b) -> QueryT m a -> QueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> QueryT m b -> QueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT m a -> QueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QueryT m b -> QueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> QueryT m b -> QueryT m a
fmap :: (a -> b) -> QueryT m a -> QueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT m a -> QueryT m b
Functor, Applicative (QueryT m)
a -> QueryT m a
Applicative (QueryT m) =>
(forall a b. QueryT m a -> (a -> QueryT m b) -> QueryT m b)
-> (forall a b. QueryT m a -> QueryT m b -> QueryT m b)
-> (forall a. a -> QueryT m a)
-> Monad (QueryT m)
QueryT m a -> (a -> QueryT m b) -> QueryT m b
QueryT m a -> QueryT m b -> QueryT m b
forall a. a -> QueryT m a
forall a b. QueryT m a -> QueryT m b -> QueryT m b
forall a b. QueryT m a -> (a -> QueryT m b) -> QueryT m b
forall (m :: * -> *). Monad m => Applicative (QueryT m)
forall (m :: * -> *) a. Monad m => a -> QueryT m a
forall (m :: * -> *) a b.
Monad m =>
QueryT m a -> QueryT m b -> QueryT m b
forall (m :: * -> *) a b.
Monad m =>
QueryT m a -> (a -> QueryT m b) -> QueryT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> QueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> QueryT m a
>> :: QueryT m a -> QueryT m b -> QueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
QueryT m a -> QueryT m b -> QueryT m b
>>= :: QueryT m a -> (a -> QueryT m b) -> QueryT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
QueryT m a -> (a -> QueryT m b) -> QueryT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (QueryT m)
Monad, Monad (QueryT m)
Monad (QueryT m) =>
(forall a. IO a -> QueryT m a) -> MonadIO (QueryT m)
IO a -> QueryT m a
forall a. IO a -> QueryT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (QueryT m)
forall (m :: * -> *) a. MonadIO m => IO a -> QueryT m a
liftIO :: IO a -> QueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> QueryT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (QueryT m)
MonadIO, m a -> QueryT m a
(forall (m :: * -> *) a. Monad m => m a -> QueryT m a)
-> MonadTrans QueryT
forall (m :: * -> *) a. Monad m => m a -> QueryT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> QueryT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> QueryT m a
MonadTrans,
MonadError e, MonadState s, MonadWriter w)
instance Monad m => MonadQuery (QueryT m) where
queryState :: QueryT m State
queryState = ReaderT State m State -> QueryT m State
forall (m :: * -> *) a. ReaderT State m a -> QueryT m a
QueryT ReaderT State m State
forall r (m :: * -> *). MonadReader r m => m r
ask
mapQueryT :: (ReaderT State m a -> ReaderT State n b) -> QueryT m a -> QueryT n b
mapQueryT :: (ReaderT State m a -> ReaderT State n b)
-> QueryT m a -> QueryT n b
mapQueryT f :: ReaderT State m a -> ReaderT State n b
f = ReaderT State n b -> QueryT n b
forall (m :: * -> *) a. ReaderT State m a -> QueryT m a
QueryT (ReaderT State n b -> QueryT n b)
-> (QueryT m a -> ReaderT State n b) -> QueryT m a -> QueryT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT State m a -> ReaderT State n b
f (ReaderT State m a -> ReaderT State n b)
-> (QueryT m a -> ReaderT State m a)
-> QueryT m a
-> ReaderT State n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryT m a -> ReaderT State m a
forall (m :: * -> *) a. QueryT m a -> ReaderT State m a
runQueryT
{-# INLINE mapQueryT #-}
class Fresh m a where
fresh :: QueryT m a
class Queriable m a b | a -> b where
create :: QueryT m a
project :: a -> QueryT m b
embed :: b -> QueryT m a
instance MonadReader r m => MonadReader r (QueryT m) where
ask :: QueryT m r
ask = m r -> QueryT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> QueryT m a -> QueryT m a
local f :: r -> r
f = (ReaderT State m a -> ReaderT State m a)
-> QueryT m a -> QueryT m a
forall (m :: * -> *) a (n :: * -> *) b.
(ReaderT State m a -> ReaderT State n b)
-> QueryT m a -> QueryT n b
mapQueryT ((ReaderT State m a -> ReaderT State m a)
-> QueryT m a -> QueryT m a)
-> (ReaderT State m a -> ReaderT State m a)
-> QueryT m a
-> QueryT m a
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m a -> m a) -> ReaderT State m a -> ReaderT State m a)
-> (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f
type Query = QueryT IO
instance MonadSymbolic Query where
symbolicEnv :: Query State
symbolicEnv = Query State
forall (m :: * -> *). MonadQuery m => m State
queryState
instance NFData OptimizeStyle where
rnf :: OptimizeStyle -> ()
rnf x :: OptimizeStyle
x = OptimizeStyle
x OptimizeStyle -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance NFData Penalty where
rnf :: Penalty -> ()
rnf DefaultPenalty = ()
rnf (Penalty p :: Rational
p mbs :: Maybe String
mbs) = Rational -> ()
forall a. NFData a => a -> ()
rnf Rational
p () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe String -> ()
forall a. NFData a => a -> ()
rnf Maybe String
mbs
instance NFData a => NFData (Objective a) where
rnf :: Objective a -> ()
rnf (Minimize s :: String
s a :: a
a) = String -> ()
forall a. NFData a => a -> ()
rnf String
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (Maximize s :: String
s a :: a
a) = String -> ()
forall a. NFData a => a -> ()
rnf String
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (AssertWithPenalty s :: String
s a :: a
a p :: Penalty
p) = String -> ()
forall a. NFData a => a -> ()
rnf String
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` Penalty -> ()
forall a. NFData a => a -> ()
rnf Penalty
p
data Result = Result { Result -> Set Kind
reskinds :: Set.Set Kind
, Result -> [(String, CV)]
resTraces :: [(String, CV)]
, Result -> [(String, CV -> Bool, SV)]
resObservables :: [(String, CV -> Bool, SV)]
, Result -> [(String, [String])]
resUISegs :: [(String, [String])]
, Result -> ([(Quantifier, NamedSymVar)], [NamedSymVar])
resInputs :: ([(Quantifier, NamedSymVar)], [NamedSymVar])
, Result -> [(SV, CV)]
resConsts :: [(SV, CV)]
, Result -> [((Int, Kind, Kind), [SV])]
resTables :: [((Int, Kind, Kind), [SV])]
, Result -> [(Int, ArrayInfo)]
resArrays :: [(Int, ArrayInfo)]
, Result -> [(String, SBVType)]
resUIConsts :: [(String, SBVType)]
, Result -> [(String, [String])]
resAxioms :: [(String, [String])]
, Result -> SBVPgm
resAsgns :: SBVPgm
, Result -> Seq (Bool, [(String, String)], SV)
resConstraints :: S.Seq (Bool, [(String, String)], SV)
, Result -> [(String, Maybe CallStack, SV)]
resAssertions :: [(String, Maybe CallStack, SV)]
, Result -> [SV]
resOutputs :: [SV]
}
instance Show Result where
show :: Result -> String
show Result{resConsts :: Result -> [(SV, CV)]
resConsts=[(SV, CV)]
cs, resOutputs :: Result -> [SV]
resOutputs=[r :: SV
r]}
| Just c :: CV
c <- SV
r SV -> [(SV, CV)] -> Maybe CV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs
= CV -> String
forall a. Show a => a -> String
show CV
c
show (Result kinds :: Set Kind
kinds _ _ cgs :: [(String, [String])]
cgs is :: ([(Quantifier, NamedSymVar)], [NamedSymVar])
is cs :: [(SV, CV)]
cs ts :: [((Int, Kind, Kind), [SV])]
ts as :: [(Int, ArrayInfo)]
as uis :: [(String, SBVType)]
uis axs :: [(String, [String])]
axs xs :: SBVPgm
xs cstrs :: Seq (Bool, [(String, String)], SV)
cstrs asserts :: [(String, Maybe CallStack, SV)]
asserts os :: [SV]
os) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
usorts then [] else "SORTS" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (" " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
usorts)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["INPUTS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((Quantifier, NamedSymVar) -> String)
-> [(Quantifier, NamedSymVar)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Quantifier, NamedSymVar) -> String
shn (([(Quantifier, NamedSymVar)], [NamedSymVar])
-> [(Quantifier, NamedSymVar)]
forall a b. (a, b) -> a
fst ([(Quantifier, NamedSymVar)], [NamedSymVar])
is)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (if [NamedSymVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([(Quantifier, NamedSymVar)], [NamedSymVar]) -> [NamedSymVar]
forall a b. (a, b) -> b
snd ([(Quantifier, NamedSymVar)], [NamedSymVar])
is) then [] else "TRACKER VARS" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (NamedSymVar -> String) -> [NamedSymVar] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Quantifier, NamedSymVar) -> String
shn ((Quantifier, NamedSymVar) -> String)
-> (NamedSymVar -> (Quantifier, NamedSymVar))
-> NamedSymVar
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantifier
EX,)) (([(Quantifier, NamedSymVar)], [NamedSymVar]) -> [NamedSymVar]
forall a b. (a, b) -> b
snd ([(Quantifier, NamedSymVar)], [NamedSymVar])
is))
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["CONSTANTS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((SV, CV) -> [String]) -> [(SV, CV)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SV, CV) -> [String]
forall a. Show a => (SV, a) -> [String]
shc [(SV, CV)]
cs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["TABLES"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (((Int, Kind, Kind), [SV]) -> String)
-> [((Int, Kind, Kind), [SV])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Kind, Kind), [SV]) -> String
forall a a a a.
(Show a, Show a, Show a, Show a) =>
((a, a, a), a) -> String
sht [((Int, Kind, Kind), [SV])]
ts
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["ARRAYS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((Int, ArrayInfo) -> String) -> [(Int, ArrayInfo)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ArrayInfo) -> String
forall a a a a.
(Show a, Show a, Show a, Show a) =>
(a, (String, (a, a), a)) -> String
sha [(Int, ArrayInfo)]
as
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["UNINTERPRETED CONSTANTS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, SBVType) -> String) -> [(String, SBVType)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SBVType) -> String
forall a. Show a => (String, a) -> String
shui [(String, SBVType)]
uis
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["USER GIVEN CODE SEGMENTS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, [String]) -> [String])
-> [(String, [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [String]) -> [String]
shcg [(String, [String])]
cgs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["AXIOMS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, [String]) -> String) -> [(String, [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> String
shax [(String, [String])]
axs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["DEFINE"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((SV, SBVExpr) -> String) -> [(SV, SBVExpr)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: SV
s, e :: SBVExpr
e) -> " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
shs SV
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVExpr -> String
forall a. Show a => a -> String
show SBVExpr
e) (Seq (SV, SBVExpr) -> [(SV, SBVExpr)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (SBVPgm -> Seq (SV, SBVExpr)
pgmAssignments SBVPgm
xs))
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["CONSTRAINTS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((Bool, [(String, String)], SV) -> String)
-> [(Bool, [(String, String)], SV)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((" " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> ((Bool, [(String, String)], SV) -> String)
-> (Bool, [(String, String)], SV)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, [(String, String)], SV) -> String
forall a. Show a => (Bool, [(String, String)], a) -> String
shCstr) (Seq (Bool, [(String, String)], SV)
-> [(Bool, [(String, String)], SV)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Bool, [(String, String)], SV)
cstrs)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["ASSERTIONS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, Maybe CallStack, SV) -> String)
-> [(String, Maybe CallStack, SV)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> ((String, Maybe CallStack, SV) -> String)
-> (String, Maybe CallStack, SV)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Maybe CallStack, SV) -> String
forall a. Show a => (String, Maybe CallStack, a) -> String
shAssert) [(String, Maybe CallStack, SV)]
asserts
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["OUTPUTS"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [SV] -> [String]
forall a. Show a => [a] -> [String]
sh2 [SV]
os
where sh2 :: Show a => [a] -> [String]
sh2 :: [a] -> [String]
sh2 = (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
usorts :: [String]
usorts = [String -> Either String [String] -> String
forall a. String -> Either a [String] -> String
sh String
s Either String [String]
t | KUninterpreted s :: String
s t :: Either String [String]
t <- Set Kind -> [Kind]
forall a. Set a -> [a]
Set.toList Set Kind
kinds]
where sh :: String -> Either a [String] -> String
sh s :: String
s (Left _) = String
s
sh s :: String
s (Right es :: [String]
es) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
es String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
shs :: SV -> String
shs sv :: SV
sv = SV -> String
forall a. Show a => a -> String
show SV
sv String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SV -> Kind
swKind SV
sv)
sht :: ((a, a, a), a) -> String
sht ((i :: a
i, at :: a
at, rt :: a
rt), es :: a
es) = " Table " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ " : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
at String -> ShowS
forall a. [a] -> [a] -> [a]
++ "->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
rt String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
es
shc :: (SV, a) -> [String]
shc (sv :: SV
sv, cv :: a
cv)
| SV
sv SV -> SV -> Bool
forall a. Eq a => a -> a -> Bool
== SV
falseSV Bool -> Bool -> Bool
|| SV
sv SV -> SV -> Bool
forall a. Eq a => a -> a -> Bool
== SV
trueSV
= []
| Bool
True
= [" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
sv String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
cv]
shcg :: (String, [String]) -> [String]
shcg (s :: String
s, ss :: [String]
ss) = ("Variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (" " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
ss
shn :: (Quantifier, NamedSymVar) -> String
shn (q :: Quantifier
q, (sv :: SV
sv, nm :: String
nm)) = " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ni String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SV -> Kind
swKind SV
sv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
alias
where ni :: String
ni = SV -> String
forall a. Show a => a -> String
show SV
sv
ex :: String
ex | Quantifier
q Quantifier -> Quantifier -> Bool
forall a. Eq a => a -> a -> Bool
== Quantifier
ALL = ""
| Bool
True = ", existential"
alias :: String
alias | String
ni String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nm = ""
| Bool
True = ", aliasing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm
sha :: (a, (String, (a, a), a)) -> String
sha (i :: a
i, (nm :: String
nm, (ai :: a
ai, bi :: a
bi), ctx :: a
ctx)) = " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ni String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
ai String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
bi String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
alias
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n Context: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
ctx
where ni :: String
ni = "array_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
alias :: String
alias | String
ni String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nm = ""
| Bool
True = ", aliasing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm
shui :: (String, a) -> String
shui (nm :: String
nm, t :: a
t) = " [uninterpreted] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t
shax :: (String, [String]) -> String
shax (nm :: String
nm, ss :: [String]
ss) = " -- user defined axiom: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n " [String]
ss
shCstr :: (Bool, [(String, String)], a) -> String
shCstr (isSoft :: Bool
isSoft, [], c :: a
c) = Bool -> String
soft Bool
isSoft String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c
shCstr (isSoft :: Bool
isSoft, [(":named", nm :: String
nm)], c :: a
c) = Bool -> String
soft Bool
isSoft String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c
shCstr (isSoft :: Bool
isSoft, attrs :: [(String, String)]
attrs, c :: a
c) = Bool -> String
soft Bool
isSoft String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (attributes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
forall a. Show a => a -> String
show [(String, String)]
attrs String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
soft :: Bool -> String
soft True = "[SOFT] "
soft False = ""
shAssert :: (String, Maybe CallStack, a) -> String
shAssert (nm :: String
nm, stk :: Maybe CallStack
stk, p :: a
p) = " -- assertion: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (CallStack -> String) -> Maybe CallStack -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "[No location]"
#if MIN_VERSION_base(4,9,0)
CallStack -> String
prettyCallStack
#else
showCallStack
#endif
Maybe CallStack
stk String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p
data ArrayContext = ArrayFree (Maybe SV)
| ArrayMutate ArrayIndex SV SV
| ArrayMerge SV ArrayIndex ArrayIndex
instance Show ArrayContext where
show :: ArrayContext -> String
show (ArrayFree Nothing) = " initialized with random elements"
show (ArrayFree (Just sv :: SV
sv)) = " initialized with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
sv
show (ArrayMutate i :: ArrayIndex
i a :: SV
a b :: SV
b) = " cloned from array_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArrayIndex -> String
forall a. Show a => a -> String
show ArrayIndex
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ " with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SV -> Kind
swKind SV
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " |-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SV -> Kind
swKind SV
b)
show (ArrayMerge s :: SV
s i :: ArrayIndex
i j :: ArrayIndex
j) = " merged arrays " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArrayIndex -> String
forall a. Show a => a -> String
show ArrayIndex
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ " and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArrayIndex -> String
forall a. Show a => a -> String
show ArrayIndex
j String -> ShowS
forall a. [a] -> [a] -> [a]
++ " on condition " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
s
type ExprMap = Map.Map SBVExpr SV
type CnstMap = Map.Map CV SV
type KindSet = Set.Set Kind
type TableMap = Map.Map (Kind, Kind, [SV]) Int
type ArrayInfo = (String, (Kind, Kind), ArrayContext)
type ArrayMap = IMap.IntMap ArrayInfo
type FArrayMap = IMap.IntMap (SVal -> SVal, IORef (IMap.IntMap SV))
type UIMap = Map.Map String SBVType
type CgMap = Map.Map String [String]
type Cache a = IMap.IntMap [(StableName (State -> IO a), a)]
data IStage = ISetup
| ISafe
| IRun
isSafetyCheckingIStage :: IStage -> Bool
isSafetyCheckingIStage :: IStage -> Bool
isSafetyCheckingIStage s :: IStage
s = case IStage
s of
ISetup -> Bool
False
ISafe -> Bool
True
IRun -> Bool
False
isSetupIStage :: IStage -> Bool
isSetupIStage :: IStage -> Bool
isSetupIStage s :: IStage
s = case IStage
s of
ISetup -> Bool
True
ISafe -> Bool
False
IRun -> Bool
True
isRunIStage :: IStage -> Bool
isRunIStage :: IStage -> Bool
isRunIStage s :: IStage
s = case IStage
s of
ISetup -> Bool
False
ISafe -> Bool
False
IRun -> Bool
True
data SBVRunMode = SMTMode QueryContext IStage Bool SMTConfig
| CodeGen
| Concrete (Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)]))
instance Show SBVRunMode where
show :: SBVRunMode -> String
show (SMTMode qc :: QueryContext
qc ISetup True _) = "Satisfiability setup (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> String
forall a. Show a => a -> String
show QueryContext
qc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (SMTMode qc :: QueryContext
qc ISafe True _) = "Safety setup (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> String
forall a. Show a => a -> String
show QueryContext
qc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (SMTMode qc :: QueryContext
qc IRun True _) = "Satisfiability (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> String
forall a. Show a => a -> String
show QueryContext
qc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (SMTMode qc :: QueryContext
qc ISetup False _) = "Proof setup (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> String
forall a. Show a => a -> String
show QueryContext
qc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (SMTMode qc :: QueryContext
qc ISafe False _) = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "ISafe-False is not an expected/supported combination for SBVRunMode! (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> String
forall a. Show a => a -> String
show QueryContext
qc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show (SMTMode qc :: QueryContext
qc IRun False _) = "Proof (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> String
forall a. Show a => a -> String
show QueryContext
qc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
show CodeGen = "Code generation"
show (Concrete Nothing) = "Concrete evaluation with random values"
show (Concrete (Just (True, _))) = "Concrete evaluation during model validation for sat"
show (Concrete (Just (False, _))) = "Concrete evaluation during model validation for prove"
isCodeGenMode :: State -> IO Bool
isCodeGenMode :: State -> IO Bool
isCodeGenMode State{IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode} = do SBVRunMode
rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case SBVRunMode
rm of
Concrete{} -> Bool
False
SMTMode{} -> Bool
False
CodeGen -> Bool
True
data IncState = IncState { IncState -> IORef [NamedSymVar]
rNewInps :: IORef [NamedSymVar]
, IncState -> IORef (Set Kind)
rNewKinds :: IORef KindSet
, IncState -> IORef CnstMap
rNewConsts :: IORef CnstMap
, IncState -> IORef ArrayMap
rNewArrs :: IORef ArrayMap
, IncState -> IORef TableMap
rNewTbls :: IORef TableMap
, IncState -> IORef UIMap
rNewUIs :: IORef UIMap
, IncState -> IORef SBVPgm
rNewAsgns :: IORef SBVPgm
, IncState -> IORef (Seq (Bool, [(String, String)], SV))
rNewConstraints :: IORef (S.Seq (Bool, [(String, String)], SV))
}
newIncState :: IO IncState
newIncState :: IO IncState
newIncState = do
IORef [NamedSymVar]
is <- [NamedSymVar] -> IO (IORef [NamedSymVar])
forall a. a -> IO (IORef a)
newIORef []
IORef (Set Kind)
ks <- Set Kind -> IO (IORef (Set Kind))
forall a. a -> IO (IORef a)
newIORef Set Kind
forall a. Set a
Set.empty
IORef CnstMap
nc <- CnstMap -> IO (IORef CnstMap)
forall a. a -> IO (IORef a)
newIORef CnstMap
forall k a. Map k a
Map.empty
IORef ArrayMap
am <- ArrayMap -> IO (IORef ArrayMap)
forall a. a -> IO (IORef a)
newIORef ArrayMap
forall a. IntMap a
IMap.empty
IORef TableMap
tm <- TableMap -> IO (IORef TableMap)
forall a. a -> IO (IORef a)
newIORef TableMap
forall k a. Map k a
Map.empty
IORef UIMap
ui <- UIMap -> IO (IORef UIMap)
forall a. a -> IO (IORef a)
newIORef UIMap
forall k a. Map k a
Map.empty
IORef SBVPgm
pgm <- SBVPgm -> IO (IORef SBVPgm)
forall a. a -> IO (IORef a)
newIORef (Seq (SV, SBVExpr) -> SBVPgm
SBVPgm Seq (SV, SBVExpr)
forall a. Seq a
S.empty)
IORef (Seq (Bool, [(String, String)], SV))
cstrs <- Seq (Bool, [(String, String)], SV)
-> IO (IORef (Seq (Bool, [(String, String)], SV)))
forall a. a -> IO (IORef a)
newIORef Seq (Bool, [(String, String)], SV)
forall a. Seq a
S.empty
IncState -> IO IncState
forall (m :: * -> *) a. Monad m => a -> m a
return IncState :: IORef [NamedSymVar]
-> IORef (Set Kind)
-> IORef CnstMap
-> IORef ArrayMap
-> IORef TableMap
-> IORef UIMap
-> IORef SBVPgm
-> IORef (Seq (Bool, [(String, String)], SV))
-> IncState
IncState { rNewInps :: IORef [NamedSymVar]
rNewInps = IORef [NamedSymVar]
is
, rNewKinds :: IORef (Set Kind)
rNewKinds = IORef (Set Kind)
ks
, rNewConsts :: IORef CnstMap
rNewConsts = IORef CnstMap
nc
, rNewArrs :: IORef ArrayMap
rNewArrs = IORef ArrayMap
am
, rNewTbls :: IORef TableMap
rNewTbls = IORef TableMap
tm
, rNewUIs :: IORef UIMap
rNewUIs = IORef UIMap
ui
, rNewAsgns :: IORef SBVPgm
rNewAsgns = IORef SBVPgm
pgm
, rNewConstraints :: IORef (Seq (Bool, [(String, String)], SV))
rNewConstraints = IORef (Seq (Bool, [(String, String)], SV))
cstrs
}
withNewIncState :: State -> (State -> IO a) -> IO (IncState, a)
withNewIncState :: State -> (State -> IO a) -> IO (IncState, a)
withNewIncState st :: State
st cont :: State -> IO a
cont = do
IncState
is <- IO IncState
newIncState
IORef IncState -> (IncState -> IncState) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (State -> IORef IncState
rIncState State
st) (IncState -> IncState -> IncState
forall a b. a -> b -> a
const IncState
is)
a
r <- State -> IO a
cont State
st
IncState
finalIncState <- IORef IncState -> IO IncState
forall a. IORef a -> IO a
readIORef (State -> IORef IncState
rIncState State
st)
(IncState, a) -> IO (IncState, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IncState
finalIncState, a
r)
data State = State { State -> SVal
pathCond :: SVal
, State -> UTCTime
startTime :: UTCTime
, State -> IORef SBVRunMode
runMode :: IORef SBVRunMode
, State -> IORef IncState
rIncState :: IORef IncState
, State -> IORef [(String, CV)]
rCInfo :: IORef [(String, CV)]
, State -> IORef [(String, CV -> Bool, SV)]
rObservables :: IORef [(String, CV -> Bool, SV)]
, State -> IORef Int
rctr :: IORef Int
, State -> IORef (Set Kind)
rUsedKinds :: IORef KindSet
, State -> IORef (Set String)
rUsedLbls :: IORef (Set.Set String)
, State
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps :: IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set.Set String)
, State -> IORef (Seq (Bool, [(String, String)], SV))
rConstraints :: IORef (S.Seq (Bool, [(String, String)], SV))
, State -> IORef [SV]
routs :: IORef [SV]
, State -> IORef TableMap
rtblMap :: IORef TableMap
, State -> IORef SBVPgm
spgm :: IORef SBVPgm
, State -> IORef CnstMap
rconstMap :: IORef CnstMap
, State -> IORef ExprMap
rexprMap :: IORef ExprMap
, State -> IORef ArrayMap
rArrayMap :: IORef ArrayMap
, State -> IORef FArrayMap
rFArrayMap :: IORef FArrayMap
, State -> IORef UIMap
rUIMap :: IORef UIMap
, State -> IORef CgMap
rCgMap :: IORef CgMap
, State -> IORef [(String, [String])]
raxioms :: IORef [(String, [String])]
, State -> IORef [SMTOption]
rSMTOptions :: IORef [SMTOption]
, State -> IORef [Objective (SV, SV)]
rOptGoals :: IORef [Objective (SV, SV)]
, State -> IORef [(String, Maybe CallStack, SV)]
rAsserts :: IORef [(String, Maybe CallStack, SV)]
, State -> IORef (Cache SV)
rSVCache :: IORef (Cache SV)
, State -> IORef (Cache ArrayIndex)
rAICache :: IORef (Cache ArrayIndex)
, State -> IORef (Cache FArrayIndex)
rFAICache :: IORef (Cache FArrayIndex)
, State -> IORef (Maybe QueryState)
rQueryState :: IORef (Maybe QueryState)
}
instance NFData State where
rnf :: State -> ()
rnf State{} = ()
getSValPathCondition :: State -> SVal
getSValPathCondition :: State -> SVal
getSValPathCondition = State -> SVal
pathCond
extendSValPathCondition :: State -> (SVal -> SVal) -> State
extendSValPathCondition :: State -> (SVal -> SVal) -> State
extendSValPathCondition st :: State
st f :: SVal -> SVal
f = State
st{pathCond :: SVal
pathCond = SVal -> SVal
f (State -> SVal
pathCond State
st)}
inSMTMode :: State -> IO Bool
inSMTMode :: State -> IO Bool
inSMTMode State{IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode} = do SBVRunMode
rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case SBVRunMode
rm of
CodeGen -> Bool
False
Concrete{} -> Bool
False
SMTMode{} -> Bool
True
data SVal = SVal !Kind !(Either CV (Cached SV))
instance HasKind SVal where
kindOf :: SVal -> Kind
kindOf (SVal k :: Kind
k _) = Kind
k
instance Show SVal where
show :: SVal -> String
show (SVal KBool (Left c :: CV
c)) = Bool -> CV -> String
showCV Bool
False CV
c
show (SVal k :: Kind
k (Left c :: CV
c)) = Bool -> CV -> String
showCV Bool
False CV
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
show (SVal k :: Kind
k (Right _)) = "<symbolic> :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
instance Eq SVal where
a :: SVal
a == :: SVal -> SVal -> Bool
== b :: SVal
b = String -> String -> (String, String) -> Bool
forall a. String -> String -> (String, String) -> a
noEquals "==" ".==" (SVal -> String
forall a. Show a => a -> String
show SVal
a, SVal -> String
forall a. Show a => a -> String
show SVal
b)
a :: SVal
a /= :: SVal -> SVal -> Bool
/= b :: SVal
b = String -> String -> (String, String) -> Bool
forall a. String -> String -> (String, String) -> a
noEquals "/=" "./=" (SVal -> String
forall a. Show a => a -> String
show SVal
a, SVal -> String
forall a. Show a => a -> String
show SVal
b)
noEquals :: String -> String -> (String, String) -> a
noEquals :: String -> String -> (String, String) -> a
noEquals o :: String
o n :: String
n (l :: String
l, r :: String
r) = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ ""
, "*** Data.SBV: Comparing symbolic values using Haskell's Eq class!"
, "***"
, "*** Received: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r
, "*** Instead use: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r
, "***"
, "*** The Eq instance for symbolic values are necessiated only because"
, "*** of the Bits class requirement. You must use symbolic equality"
, "*** operators instead. (And complain to Haskell folks that they"
, "*** remove the 'Eq' superclass from 'Bits'!.)"
]
noInteractive :: [String] -> a
noInteractive :: [String] -> a
noInteractive ss :: [String]
ss = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ""
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "*** Data.SBV: Unsupported interactive/query mode feature."
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("*** " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
ss
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["*** Data.SBV: Please report this as a feature request!"]
modifyState :: State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState :: State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState st :: State
st@State{IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode} field :: State -> IORef a
field update :: a -> a
update interactiveUpdate :: IO ()
interactiveUpdate = do
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (State -> IORef a
field State
st) a -> a
update
SBVRunMode
rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
case SBVRunMode
rm of
SMTMode _ IRun _ _ -> IO ()
interactiveUpdate
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
modifyIncState :: State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState :: State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State{IORef IncState
rIncState :: IORef IncState
rIncState :: State -> IORef IncState
rIncState} field :: IncState -> IORef a
field update :: a -> a
update = do
IncState
incState <- IORef IncState -> IO IncState
forall a. IORef a -> IO a
readIORef IORef IncState
rIncState
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (IncState -> IORef a
field IncState
incState) a -> a
update
recordObservable :: State -> String -> (CV -> Bool) -> SV -> IO ()
recordObservable :: State -> String -> (CV -> Bool) -> SV -> IO ()
recordObservable st :: State
st nm :: String
nm chk :: CV -> Bool
chk sv :: SV
sv = State
-> (State -> IORef [(String, CV -> Bool, SV)])
-> ([(String, CV -> Bool, SV)] -> [(String, CV -> Bool, SV)])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [(String, CV -> Bool, SV)]
rObservables ((String
nm, CV -> Bool
chk, SV
sv)(String, CV -> Bool, SV)
-> [(String, CV -> Bool, SV)] -> [(String, CV -> Bool, SV)]
forall a. a -> [a] -> [a]
:) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
incrementInternalCounter :: State -> IO Int
incrementInternalCounter :: State -> IO Int
incrementInternalCounter st :: State
st = do Int
ctr <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (State -> IORef Int
rctr State
st)
State -> (State -> IORef Int) -> (Int -> Int) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef Int
rctr (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ctr
svUninterpreted :: Kind -> String -> Maybe [String] -> [SVal] -> SVal
svUninterpreted :: Kind -> String -> Maybe [String] -> [SVal] -> SVal
svUninterpreted k :: Kind
k nm :: String
nm code :: Maybe [String]
code args :: [SVal]
args = Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where result :: State -> IO SV
result st :: State
st = do let ty :: SBVType
ty = [Kind] -> SBVType
SBVType ((SVal -> Kind) -> [SVal] -> [Kind]
forall a b. (a -> b) -> [a] -> [b]
map SVal -> Kind
forall a. HasKind a => a -> Kind
kindOf [SVal]
args [Kind] -> [Kind] -> [Kind]
forall a. [a] -> [a] -> [a]
++ [Kind
k])
State -> String -> SBVType -> Maybe [String] -> IO ()
newUninterpreted State
st String
nm SBVType
ty Maybe [String]
code
[SV]
sws <- (SVal -> IO SV) -> [SVal] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (State -> SVal -> IO SV
svToSV State
st) [SVal]
args
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV]
sws
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm) [SV]
sws
newUninterpreted :: State -> String -> SBVType -> Maybe [String] -> IO ()
newUninterpreted :: State -> String -> SBVType -> Maybe [String] -> IO ()
newUninterpreted st :: State
st nm :: String
nm t :: SBVType
t mbCode :: Maybe [String]
mbCode
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
nm Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
enclosed Bool -> Bool -> Bool
&& (Bool -> Bool
not (Char -> Bool
isAlpha (String -> Char
forall a. [a] -> a
head String
nm)) Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validChar (ShowS
forall a. [a] -> [a]
tail String
nm)))
= String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Bad uninterpreted constant name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". Must be a valid identifier."
| Bool
True = do UIMap
uiMap <- IORef UIMap -> IO UIMap
forall a. IORef a -> IO a
readIORef (State -> IORef UIMap
rUIMap State
st)
case String
nm String -> UIMap -> Maybe SBVType
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` UIMap
uiMap of
Just t' :: SBVType
t' -> SBVType -> IO () -> IO ()
forall r. SBVType -> r -> r
checkType SBVType
t' (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Nothing -> do State
-> (State -> IORef UIMap) -> (UIMap -> UIMap) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef UIMap
rUIMap (String -> SBVType -> UIMap -> UIMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
nm SBVType
t)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> (IncState -> IORef UIMap) -> (UIMap -> UIMap) -> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef UIMap
rNewUIs (\newUIs :: UIMap
newUIs -> case String
nm String -> UIMap -> Maybe SBVType
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` UIMap
newUIs of
Just t' :: SBVType
t' -> SBVType -> UIMap -> UIMap
forall r. SBVType -> r -> r
checkType SBVType
t' UIMap
newUIs
Nothing -> String -> SBVType -> UIMap -> UIMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
nm SBVType
t UIMap
newUIs)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [String]
mbCode) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (State -> IORef CgMap) -> (CgMap -> CgMap) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef CgMap
rCgMap (String -> [String] -> CgMap -> CgMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
nm (Maybe [String] -> [String]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [String]
mbCode)) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where checkType :: SBVType -> r -> r
checkType :: SBVType -> r -> r
checkType t' :: SBVType
t' cont :: r
cont
| SBVType
t SBVType -> SBVType -> Bool
forall a. Eq a => a -> a -> Bool
/= SBVType
t' = String -> r
forall a. HasCallStack => String -> a
error (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$ "Uninterpreted constant " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " used at incompatible types\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " Current type : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVType -> String
forall a. Show a => a -> String
show SBVType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " Previously used at: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVType -> String
forall a. Show a => a -> String
show SBVType
t'
| Bool
True = r
cont
validChar :: Char -> Bool
validChar x :: Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "_"
enclosed :: Bool
enclosed = String -> Char
forall a. [a] -> a
head String
nm Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '|' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
nm Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '|' Bool -> Bool -> Bool
&& String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
nm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "|\\") (ShowS
forall a. [a] -> [a]
tail (ShowS
forall a. [a] -> [a]
init String
nm)))
addAssertion :: State -> Maybe CallStack -> String -> SV -> IO ()
addAssertion :: State -> Maybe CallStack -> String -> SV -> IO ()
addAssertion st :: State
st cs :: Maybe CallStack
cs msg :: String
msg cond :: SV
cond = State
-> (State -> IORef [(String, Maybe CallStack, SV)])
-> ([(String, Maybe CallStack, SV)]
-> [(String, Maybe CallStack, SV)])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [(String, Maybe CallStack, SV)]
rAsserts ((String
msg, Maybe CallStack
cs, SV
cond)(String, Maybe CallStack, SV)
-> [(String, Maybe CallStack, SV)]
-> [(String, Maybe CallStack, SV)]
forall a. a -> [a] -> [a]
:)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> IO ()
forall a. [String] -> a
noInteractive [ "Named assertions (sAssert):"
, " Tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
, " Loc: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (CallStack -> String) -> Maybe CallStack -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "Unknown" CallStack -> String
forall a. Show a => a -> String
show Maybe CallStack
cs
]
internalVariable :: State -> Kind -> IO SV
internalVariable :: State -> Kind -> IO SV
internalVariable st :: State
st k :: Kind
k = do (sv :: SV
sv, nm :: String
nm) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
SBVRunMode
rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)
let q :: Quantifier
q = case SBVRunMode
rm of
SMTMode _ _ True _ -> Quantifier
EX
SMTMode _ _ False _ -> Quantifier
ALL
CodeGen -> Quantifier
ALL
Concrete{} -> Quantifier
ALL
n :: String
n = "__internal_sbv_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm
v :: NamedSymVar
v = (SV
sv, String
n)
State
-> (State
-> IORef
(([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
-> ((([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps (([(Quantifier, NamedSymVar)] -> [(Quantifier, NamedSymVar)])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Quantifier
q, NamedSymVar
v) (Quantifier, NamedSymVar)
-> [(Quantifier, NamedSymVar)] -> [(Quantifier, NamedSymVar)]
forall a. a -> [a] -> [a]
:) (([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar]))
-> (Set String -> Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
n)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef [NamedSymVar])
-> ([NamedSymVar] -> [NamedSymVar])
-> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef [NamedSymVar]
rNewInps (\newInps :: [NamedSymVar]
newInps -> case Quantifier
q of
EX -> NamedSymVar
v NamedSymVar -> [NamedSymVar] -> [NamedSymVar]
forall a. a -> [a] -> [a]
: [NamedSymVar]
newInps
ALL -> [String] -> [NamedSymVar]
forall a. [String] -> a
noInteractive [ "Internal universally quantified variable creation:"
, " Named: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm
])
SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
{-# INLINE internalVariable #-}
newSV :: State -> Kind -> IO (SV, String)
newSV :: State -> Kind -> IO NamedSymVar
newSV st :: State
st k :: Kind
k = do Int
ctr <- State -> IO Int
incrementInternalCounter State
st
let sv :: SV
sv = Kind -> NodeId -> SV
SV Kind
k (Int -> NodeId
NodeId Int
ctr)
State -> Kind -> IO ()
registerKind State
st Kind
k
NamedSymVar -> IO NamedSymVar
forall (m :: * -> *) a. Monad m => a -> m a
return (SV
sv, 's' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
ctr)
{-# INLINE newSV #-}
registerKind :: State -> Kind -> IO ()
registerKind :: State -> Kind -> IO ()
registerKind st :: State
st k :: Kind
k
| KUninterpreted sortName :: String
sortName _ <- Kind
k, (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
sortName String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
smtLibReservedNames
= String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "SBV: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
sortName String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is a reserved sort; please use a different name."
| Bool
True
= do
Set Kind
existingKinds <- IORef (Set Kind) -> IO (Set Kind)
forall a. IORef a -> IO a
readIORef (State -> IORef (Set Kind)
rUsedKinds State
st)
State
-> (State -> IORef (Set Kind))
-> (Set Kind -> Set Kind)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Set Kind)
rUsedKinds (Kind -> Set Kind -> Set Kind
forall a. Ord a => a -> Set a -> Set a
Set.insert Kind
k) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let needsAdding :: Bool
needsAdding = case Kind
k of
KUninterpreted{} -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
KList{} -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
KTuple nks :: [Kind]
nks -> [Kind] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
nks Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Kind] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
oks | KTuple oks :: [Kind]
oks <- Set Kind -> [Kind]
forall a. Set a -> [a]
Set.toList Set Kind
existingKinds]
KMaybe{} -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
KEither{} -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
_ -> Bool
False
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsAdding (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef (Set Kind))
-> (Set Kind -> Set Kind)
-> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef (Set Kind)
rNewKinds (Kind -> Set Kind -> Set Kind
forall a. Ord a => a -> Set a -> Set a
Set.insert Kind
k)
case Kind
k of
KBool {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KBounded {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KUnbounded {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KReal {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KUninterpreted {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KFloat {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KDouble {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KChar {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KString {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
KList ek :: Kind
ek -> State -> Kind -> IO ()
registerKind State
st Kind
ek
KSet ek :: Kind
ek -> State -> Kind -> IO ()
registerKind State
st Kind
ek
KTuple eks :: [Kind]
eks -> (Kind -> IO ()) -> [Kind] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (State -> Kind -> IO ()
registerKind State
st) [Kind]
eks
KMaybe ke :: Kind
ke -> State -> Kind -> IO ()
registerKind State
st Kind
ke
KEither k1 :: Kind
k1 k2 :: Kind
k2 -> (Kind -> IO ()) -> [Kind] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (State -> Kind -> IO ()
registerKind State
st) [Kind
k1, Kind
k2]
registerLabel :: String -> State -> String -> IO ()
registerLabel :: String -> State -> String -> IO ()
registerLabel whence :: String
whence st :: State
st nm :: String
nm
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
nm String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
smtLibReservedNames
= String -> IO ()
err "is a reserved string; please use a different name."
| '|' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
nm
= String -> IO ()
err "contains the character `|', which is not allowed!"
| '\\' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
nm
= String -> IO ()
err "contains the character `\\', which is not allowed!"
| Bool
True
= do Set String
old <- IORef (Set String) -> IO (Set String)
forall a. IORef a -> IO a
readIORef (IORef (Set String) -> IO (Set String))
-> IORef (Set String) -> IO (Set String)
forall a b. (a -> b) -> a -> b
$ State -> IORef (Set String)
rUsedLbls State
st
if String
nm String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
old
then String -> IO ()
err "is used multiple times. Please do not use duplicate names!"
else State
-> (State -> IORef (Set String))
-> (Set String -> Set String)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Set String)
rUsedLbls (String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
nm) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where err :: String -> IO ()
err w :: String
w = String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "SBV (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
whence String -> ShowS
forall a. [a] -> [a] -> [a]
++ "): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
w
newConst :: State -> CV -> IO SV
newConst :: State -> CV -> IO SV
newConst st :: State
st c :: CV
c = do
CnstMap
constMap <- IORef CnstMap -> IO CnstMap
forall a. IORef a -> IO a
readIORef (State -> IORef CnstMap
rconstMap State
st)
case CV
c CV -> CnstMap -> Maybe SV
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` CnstMap
constMap of
Just sv :: SV
sv -> SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
Nothing -> do (sv :: SV
sv, _) <- State -> Kind -> IO NamedSymVar
newSV State
st (CV -> Kind
forall a. HasKind a => a -> Kind
kindOf CV
c)
let ins :: CnstMap -> CnstMap
ins = CV -> SV -> CnstMap -> CnstMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CV
c SV
sv
State
-> (State -> IORef CnstMap)
-> (CnstMap -> CnstMap)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef CnstMap
rconstMap CnstMap -> CnstMap
ins (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef CnstMap) -> (CnstMap -> CnstMap) -> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef CnstMap
rNewConsts CnstMap -> CnstMap
ins
SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
{-# INLINE newConst #-}
getTableIndex :: State -> Kind -> Kind -> [SV] -> IO Int
getTableIndex :: State -> Kind -> Kind -> [SV] -> IO Int
getTableIndex st :: State
st at :: Kind
at rt :: Kind
rt elts :: [SV]
elts = do
let key :: (Kind, Kind, [SV])
key = (Kind
at, Kind
rt, [SV]
elts)
TableMap
tblMap <- IORef TableMap -> IO TableMap
forall a. IORef a -> IO a
readIORef (State -> IORef TableMap
rtblMap State
st)
case (Kind, Kind, [SV])
key (Kind, Kind, [SV]) -> TableMap -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` TableMap
tblMap of
Just i :: Int
i -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
_ -> do let i :: Int
i = TableMap -> Int
forall k a. Map k a -> Int
Map.size TableMap
tblMap
upd :: TableMap -> TableMap
upd = (Kind, Kind, [SV]) -> Int -> TableMap -> TableMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Kind, Kind, [SV])
key Int
i
State
-> (State -> IORef TableMap)
-> (TableMap -> TableMap)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef TableMap
rtblMap TableMap -> TableMap
upd (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef TableMap) -> (TableMap -> TableMap) -> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef TableMap
rNewTbls TableMap -> TableMap
upd
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
newExpr :: State -> Kind -> SBVExpr -> IO SV
newExpr :: State -> Kind -> SBVExpr -> IO SV
newExpr st :: State
st k :: Kind
k app :: SBVExpr
app = do
let e :: SBVExpr
e = SBVExpr -> SBVExpr
reorder SBVExpr
app
ExprMap
exprMap <- IORef ExprMap -> IO ExprMap
forall a. IORef a -> IO a
readIORef (State -> IORef ExprMap
rexprMap State
st)
case SBVExpr
e SBVExpr -> ExprMap -> Maybe SV
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ExprMap
exprMap of
Just sv :: SV
sv | SV -> Kind
forall a. HasKind a => a -> Kind
kindOf SV
sv Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
k -> SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
_ -> do (sv :: SV
sv, _) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
let append :: SBVPgm -> SBVPgm
append (SBVPgm xs :: Seq (SV, SBVExpr)
xs) = Seq (SV, SBVExpr) -> SBVPgm
SBVPgm (Seq (SV, SBVExpr)
xs Seq (SV, SBVExpr) -> (SV, SBVExpr) -> Seq (SV, SBVExpr)
forall a. Seq a -> a -> Seq a
S.|> (SV
sv, SBVExpr
e))
State
-> (State -> IORef SBVPgm) -> (SBVPgm -> SBVPgm) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef SBVPgm
spgm SBVPgm -> SBVPgm
append (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> (IncState -> IORef SBVPgm) -> (SBVPgm -> SBVPgm) -> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef SBVPgm
rNewAsgns SBVPgm -> SBVPgm
append
State
-> (State -> IORef ExprMap)
-> (ExprMap -> ExprMap)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef ExprMap
rexprMap (SBVExpr -> SV -> ExprMap -> ExprMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SBVExpr
e SV
sv) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
{-# INLINE newExpr #-}
svToSV :: State -> SVal -> IO SV
svToSV :: State -> SVal -> IO SV
svToSV st :: State
st (SVal _ (Left c :: CV
c)) = State -> CV -> IO SV
newConst State
st CV
c
svToSV st :: State
st (SVal _ (Right f :: Cached SV
f)) = Cached SV -> State -> IO SV
uncache Cached SV
f State
st
svToSymSV :: MonadSymbolic m => SVal -> m SV
svToSymSV :: SVal -> m SV
svToSymSV sbv :: SVal
sbv = do State
st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
IO SV -> m SV
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> m SV) -> IO SV -> m SV
forall a b. (a -> b) -> a -> b
$ State -> SVal -> IO SV
svToSV State
st SVal
sbv
class MonadIO m => MonadSymbolic m where
symbolicEnv :: m State
default symbolicEnv :: (MonadTrans t, MonadSymbolic m', m ~ t m') => m State
symbolicEnv = m' State -> t m' State
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
instance MonadSymbolic m => MonadSymbolic (ExceptT e m)
instance MonadSymbolic m => MonadSymbolic (MaybeT m)
instance MonadSymbolic m => MonadSymbolic (ReaderT r m)
instance MonadSymbolic m => MonadSymbolic (SS.StateT s m)
instance MonadSymbolic m => MonadSymbolic (LS.StateT s m)
instance (MonadSymbolic m, Monoid w) => MonadSymbolic (SW.WriterT w m)
instance (MonadSymbolic m, Monoid w) => MonadSymbolic (LW.WriterT w m)
newtype SymbolicT m a = SymbolicT { SymbolicT m a -> ReaderT State m a
runSymbolicT :: ReaderT State m a }
deriving ( Functor (SymbolicT m)
a -> SymbolicT m a
Functor (SymbolicT m) =>
(forall a. a -> SymbolicT m a)
-> (forall a b.
SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b)
-> (forall a b c.
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c)
-> (forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b)
-> (forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m a)
-> Applicative (SymbolicT m)
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
SymbolicT m a -> SymbolicT m b -> SymbolicT m a
SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
forall a. a -> SymbolicT m a
forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m a
forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b
forall a b. SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
forall a b c.
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (SymbolicT m)
forall (m :: * -> *) a. Applicative m => a -> SymbolicT m a
forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m a
forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
<* :: SymbolicT m a -> SymbolicT m b -> SymbolicT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m a
*> :: SymbolicT m a -> SymbolicT m b -> SymbolicT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
liftA2 :: (a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
<*> :: SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
pure :: a -> SymbolicT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SymbolicT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (SymbolicT m)
Applicative, a -> SymbolicT m b -> SymbolicT m a
(a -> b) -> SymbolicT m a -> SymbolicT m b
(forall a b. (a -> b) -> SymbolicT m a -> SymbolicT m b)
-> (forall a b. a -> SymbolicT m b -> SymbolicT m a)
-> Functor (SymbolicT m)
forall a b. a -> SymbolicT m b -> SymbolicT m a
forall a b. (a -> b) -> SymbolicT m a -> SymbolicT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SymbolicT m b -> SymbolicT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SymbolicT m a -> SymbolicT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SymbolicT m b -> SymbolicT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SymbolicT m b -> SymbolicT m a
fmap :: (a -> b) -> SymbolicT m a -> SymbolicT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SymbolicT m a -> SymbolicT m b
Functor, Applicative (SymbolicT m)
a -> SymbolicT m a
Applicative (SymbolicT m) =>
(forall a b.
SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b)
-> (forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b)
-> (forall a. a -> SymbolicT m a)
-> Monad (SymbolicT m)
SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
forall a. a -> SymbolicT m a
forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b
forall a b. SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b
forall (m :: * -> *). Monad m => Applicative (SymbolicT m)
forall (m :: * -> *) a. Monad m => a -> SymbolicT m a
forall (m :: * -> *) a b.
Monad m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
forall (m :: * -> *) a b.
Monad m =>
SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SymbolicT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> SymbolicT m a
>> :: SymbolicT m a -> SymbolicT m b -> SymbolicT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
>>= :: SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (SymbolicT m)
Monad, Monad (SymbolicT m)
Monad (SymbolicT m) =>
(forall a. IO a -> SymbolicT m a) -> MonadIO (SymbolicT m)
IO a -> SymbolicT m a
forall a. IO a -> SymbolicT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (SymbolicT m)
forall (m :: * -> *) a. MonadIO m => IO a -> SymbolicT m a
liftIO :: IO a -> SymbolicT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SymbolicT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (SymbolicT m)
MonadIO, m a -> SymbolicT m a
(forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a)
-> MonadTrans SymbolicT
forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SymbolicT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
MonadTrans
, MonadError e, MonadState s, MonadWriter w
#if MIN_VERSION_base(4,11,0)
, Monad (SymbolicT m)
Monad (SymbolicT m) =>
(forall a. String -> SymbolicT m a) -> MonadFail (SymbolicT m)
String -> SymbolicT m a
forall a. String -> SymbolicT m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (SymbolicT m)
forall (m :: * -> *) a. MonadFail m => String -> SymbolicT m a
fail :: String -> SymbolicT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> SymbolicT m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (SymbolicT m)
Fail.MonadFail
#endif
)
instance MonadIO m => MonadSymbolic (SymbolicT m) where
symbolicEnv :: SymbolicT m State
symbolicEnv = ReaderT State m State -> SymbolicT m State
forall (m :: * -> *) a. ReaderT State m a -> SymbolicT m a
SymbolicT ReaderT State m State
forall r (m :: * -> *). MonadReader r m => m r
ask
mapSymbolicT :: (ReaderT State m a -> ReaderT State n b) -> SymbolicT m a -> SymbolicT n b
mapSymbolicT :: (ReaderT State m a -> ReaderT State n b)
-> SymbolicT m a -> SymbolicT n b
mapSymbolicT f :: ReaderT State m a -> ReaderT State n b
f = ReaderT State n b -> SymbolicT n b
forall (m :: * -> *) a. ReaderT State m a -> SymbolicT m a
SymbolicT (ReaderT State n b -> SymbolicT n b)
-> (SymbolicT m a -> ReaderT State n b)
-> SymbolicT m a
-> SymbolicT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT State m a -> ReaderT State n b
f (ReaderT State m a -> ReaderT State n b)
-> (SymbolicT m a -> ReaderT State m a)
-> SymbolicT m a
-> ReaderT State n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicT m a -> ReaderT State m a
forall (m :: * -> *) a. SymbolicT m a -> ReaderT State m a
runSymbolicT
{-# INLINE mapSymbolicT #-}
instance MonadReader r m => MonadReader r (SymbolicT m) where
ask :: SymbolicT m r
ask = m r -> SymbolicT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> SymbolicT m a -> SymbolicT m a
local f :: r -> r
f = (ReaderT State m a -> ReaderT State m a)
-> SymbolicT m a -> SymbolicT m a
forall (m :: * -> *) a (n :: * -> *) b.
(ReaderT State m a -> ReaderT State n b)
-> SymbolicT m a -> SymbolicT n b
mapSymbolicT ((ReaderT State m a -> ReaderT State m a)
-> SymbolicT m a -> SymbolicT m a)
-> (ReaderT State m a -> ReaderT State m a)
-> SymbolicT m a
-> SymbolicT m a
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m a -> m a) -> ReaderT State m a -> ReaderT State m a)
-> (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f
type Symbolic = SymbolicT IO
svMkSymVar :: Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar :: Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar = Bool
-> Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVarGen Bool
False
svMkTrackerVar :: Kind -> String -> State -> IO SVal
svMkTrackerVar :: Kind -> String -> State -> IO SVal
svMkTrackerVar k :: Kind
k nm :: String
nm = Bool
-> Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVarGen Bool
True (Quantifier -> Maybe Quantifier
forall a. a -> Maybe a
Just Quantifier
EX) Kind
k (String -> Maybe String
forall a. a -> Maybe a
Just String
nm)
sWordN :: MonadSymbolic m => Int -> String -> m SVal
sWordN :: Int -> String -> m SVal
sWordN w :: Int
w nm :: String
nm = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar Maybe Quantifier
forall a. Maybe a
Nothing (Bool -> Int -> Kind
KBounded Bool
False Int
w) (String -> Maybe String
forall a. a -> Maybe a
Just String
nm)
sWordN_ :: MonadSymbolic m => Int -> m SVal
sWordN_ :: Int -> m SVal
sWordN_ w :: Int
w = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar Maybe Quantifier
forall a. Maybe a
Nothing (Bool -> Int -> Kind
KBounded Bool
False Int
w) Maybe String
forall a. Maybe a
Nothing
sIntN :: MonadSymbolic m => Int -> String -> m SVal
sIntN :: Int -> String -> m SVal
sIntN w :: Int
w nm :: String
nm = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar Maybe Quantifier
forall a. Maybe a
Nothing (Bool -> Int -> Kind
KBounded Bool
True Int
w) (String -> Maybe String
forall a. a -> Maybe a
Just String
nm)
sIntN_ :: MonadSymbolic m => Int -> m SVal
sIntN_ :: Int -> m SVal
sIntN_ w :: Int
w = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar Maybe Quantifier
forall a. Maybe a
Nothing (Bool -> Int -> Kind
KBounded Bool
True Int
w) Maybe String
forall a. Maybe a
Nothing
svMkSymVarGen :: Bool -> Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVarGen :: Bool
-> Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal
svMkSymVarGen isTracker :: Bool
isTracker mbQ :: Maybe Quantifier
mbQ k :: Kind
k mbNm :: Maybe String
mbNm st :: State
st = do
SBVRunMode
rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)
let varInfo :: String
varInfo = case Maybe String
mbNm of
Nothing -> ", of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
Just nm :: String
nm -> ", while defining " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
disallow :: String -> IO SVal
disallow what :: String
what = String -> IO SVal
forall a. HasCallStack => String -> a
error (String -> IO SVal) -> String -> IO SVal
forall a b. (a -> b) -> a -> b
$ "Data.SBV: Unsupported: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
varInfo String -> ShowS
forall a. [a] -> [a] -> [a]
++ " in mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVRunMode -> String
forall a. Show a => a -> String
show SBVRunMode
rm
noUI :: IO SVal -> IO SVal
noUI cont :: IO SVal
cont
| Kind -> Bool
forall a. HasKind a => a -> Bool
isUninterpreted Kind
k = String -> IO SVal
disallow "Uninterpreted sorts"
| Bool
True = IO SVal
cont
mkS :: Quantifier -> IO SVal
mkS q :: Quantifier
q = do (sv :: SV
sv, internalName :: String
internalName) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
let nm :: String
nm = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
internalName Maybe String
mbNm
State -> Bool -> String -> Kind -> Quantifier -> SV -> IO SVal
introduceUserName State
st Bool
isTracker String
nm Kind
k Quantifier
q SV
sv
mkC :: CV -> IO SVal
mkC cv :: CV
cv = do State -> Kind -> IO ()
registerKind State
st Kind
k
State
-> (State -> IORef [(String, CV)])
-> ([(String, CV)] -> [(String, CV)])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [(String, CV)]
rCInfo ((String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "_" Maybe String
mbNm, CV
cv)(String, CV) -> [(String, CV)] -> [(String, CV)]
forall a. a -> [a] -> [a]
:) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
SVal -> IO SVal
forall (m :: * -> *) a. Monad m => a -> m a
return (SVal -> IO SVal) -> SVal -> IO SVal
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left CV
cv)
case (Maybe Quantifier
mbQ, SBVRunMode
rm) of
(Just q :: Quantifier
q, SMTMode{} ) -> Quantifier -> IO SVal
mkS Quantifier
q
(Nothing, SMTMode _ _ isSAT :: Bool
isSAT _) -> Quantifier -> IO SVal
mkS (if Bool
isSAT then Quantifier
EX else Quantifier
ALL)
(Just EX, CodeGen{}) -> String -> IO SVal
disallow "Existentially quantified variables"
(_ , CodeGen) -> IO SVal -> IO SVal
noUI (IO SVal -> IO SVal) -> IO SVal -> IO SVal
forall a b. (a -> b) -> a -> b
$ Quantifier -> IO SVal
mkS Quantifier
ALL
(Just EX, Concrete Nothing) -> String -> IO SVal
disallow "Existentially quantified variables"
(_ , Concrete Nothing) -> IO SVal -> IO SVal
noUI (Kind -> IO CV
randomCV Kind
k IO CV -> (CV -> IO SVal) -> IO SVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CV -> IO SVal
mkC)
(_ , Concrete (Just (_isSat :: Bool
_isSat, env :: [((Quantifier, NamedSymVar), Maybe CV)]
env))) ->
let bad :: String -> String -> a
bad why :: String
why conc :: String
conc = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ ""
, "*** Data.SBV: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
why
, "***"
, "*** To turn validation off, use `cfg{validateModel = False}`"
, "***"
, "*** " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
conc
]
cant :: String
cant = "Validation engine is not capable of handling this case. Failed to validate."
report :: String
report = "Please report this as a bug in SBV!"
in if Kind -> Bool
forall a. HasKind a => a -> Bool
isUninterpreted Kind
k
then String -> String -> IO SVal
forall a. String -> String -> a
bad ("Cannot validate models in the presence of uninterpeted kinds, saw: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k) String
cant
else do (sv :: SV
sv, internalName :: String
internalName) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
let nm :: String
nm = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
internalName Maybe String
mbNm
nsv :: NamedSymVar
nsv = (SV
sv, String
nm)
cv :: CV
cv = case [(Quantifier
q, Maybe CV
v) | ((q :: Quantifier
q, nsv' :: NamedSymVar
nsv'), v :: Maybe CV
v) <- [((Quantifier, NamedSymVar), Maybe CV)]
env, NamedSymVar
nsv NamedSymVar -> NamedSymVar -> Bool
forall a. Eq a => a -> a -> Bool
== NamedSymVar
nsv'] of
[] -> if Bool
isTracker
then
Kind -> Integer -> CV
forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k (0::Integer)
else String -> String -> CV
forall a. String -> String -> a
bad ("Cannot locate variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (NamedSymVar, Kind) -> String
forall a. Show a => a -> String
show (NamedSymVar
nsv, Kind
k)) String
report
[(ALL, _)] ->
Kind -> Integer -> CV
forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k (0::Integer)
[(EX, Nothing)] -> String -> String -> CV
forall a. String -> String -> a
bad ("Cannot locate model value of variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (NamedSymVar -> String
forall a b. (a, b) -> b
snd NamedSymVar
nsv)) String
report
[(EX, Just c :: CV
c)] -> CV
c
r :: [(Quantifier, Maybe CV)]
r -> String -> String -> CV
forall a. String -> String -> a
bad ( "Found multiple matching values for variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NamedSymVar -> String
forall a. Show a => a -> String
show NamedSymVar
nsv
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n*** " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Quantifier, Maybe CV)] -> String
forall a. Show a => a -> String
show [(Quantifier, Maybe CV)]
r) String
report
CV -> IO SVal
mkC CV
cv
introduceUserName :: State -> Bool -> String -> Kind -> Quantifier -> SV -> IO SVal
introduceUserName :: State -> Bool -> String -> Kind -> Quantifier -> SV -> IO SVal
introduceUserName st :: State
st isTracker :: Bool
isTracker nmOrig :: String
nmOrig k :: Kind
k q :: Quantifier
q sv :: SV
sv = do
(_, old :: Set String
old) <- IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> IO (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
forall a. IORef a -> IO a
readIORef (State
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps State
st)
let nm :: String
nm = String -> Set String -> String
mkUnique String
nmOrig Set String
old
if Bool
isTracker Bool -> Bool -> Bool
&& Quantifier
q Quantifier -> Quantifier -> Bool
forall a. Eq a => a -> a -> Bool
== Quantifier
ALL
then String -> IO SVal
forall a. HasCallStack => String -> a
error (String -> IO SVal) -> String -> IO SVal
forall a b. (a -> b) -> a -> b
$ "SBV: Impossible happened! A universally quantified tracker variable is being introduced: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm
else do let newInp :: [NamedSymVar] -> [NamedSymVar]
newInp olds :: [NamedSymVar]
olds = case Quantifier
q of
EX -> (SV
sv, String
nm) NamedSymVar -> [NamedSymVar] -> [NamedSymVar]
forall a. a -> [a] -> [a]
: [NamedSymVar]
olds
ALL -> [String] -> [NamedSymVar]
forall a. [String] -> a
noInteractive [ "Adding a new universally quantified variable: "
, " Name : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm
, " Kind : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
, " Quantifier: Universal"
, " Node : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> String
forall a. Show a => a -> String
show SV
sv
, "Only existential variables are supported in query mode."
]
if Bool
isTracker
then State
-> (State
-> IORef
(([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
-> ((([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps (([NamedSymVar] -> [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((SV
sv, String
nm) NamedSymVar -> [NamedSymVar] -> [NamedSymVar]
forall a. a -> [a] -> [a]
:) (([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar]))
-> (Set String -> Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
nm)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> IO ()
forall a. [String] -> a
noInteractive ["Adding a new tracker variable in interactive mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm]
else State
-> (State
-> IORef
(([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
-> ((([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps (([(Quantifier, NamedSymVar)] -> [(Quantifier, NamedSymVar)])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Quantifier
q, (SV
sv, String
nm)) (Quantifier, NamedSymVar)
-> [(Quantifier, NamedSymVar)] -> [(Quantifier, NamedSymVar)]
forall a. a -> [a] -> [a]
:) (([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar]))
-> (Set String -> Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
nm)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef [NamedSymVar])
-> ([NamedSymVar] -> [NamedSymVar])
-> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef [NamedSymVar]
rNewInps [NamedSymVar] -> [NamedSymVar]
newInp
SVal -> IO SVal
forall (m :: * -> *) a. Monad m => a -> m a
return (SVal -> IO SVal) -> SVal -> IO SVal
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (IO SV -> State -> IO SV
forall a b. a -> b -> a
const (SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv))
where
mkUnique :: String -> Set String -> String
mkUnique prefix :: String
prefix names :: Set String
names = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
names) (String
prefix String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [(0::Int)..]])
runSymbolic :: MonadIO m => SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic :: SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic currentRunMode :: SBVRunMode
currentRunMode (SymbolicT c :: ReaderT State m a
c) = do
State
st <- IO State -> m State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ do
UTCTime
currTime <- IO UTCTime
getCurrentTime
IORef SBVRunMode
rm <- SBVRunMode -> IO (IORef SBVRunMode)
forall a. a -> IO (IORef a)
newIORef SBVRunMode
currentRunMode
IORef Int
ctr <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (-2)
IORef [(String, CV)]
cInfo <- [(String, CV)] -> IO (IORef [(String, CV)])
forall a. a -> IO (IORef a)
newIORef []
IORef [(String, CV -> Bool, SV)]
observes <- [(String, CV -> Bool, SV)] -> IO (IORef [(String, CV -> Bool, SV)])
forall a. a -> IO (IORef a)
newIORef []
IORef SBVPgm
pgm <- SBVPgm -> IO (IORef SBVPgm)
forall a. a -> IO (IORef a)
newIORef (Seq (SV, SBVExpr) -> SBVPgm
SBVPgm Seq (SV, SBVExpr)
forall a. Seq a
S.empty)
IORef ExprMap
emap <- ExprMap -> IO (IORef ExprMap)
forall a. a -> IO (IORef a)
newIORef ExprMap
forall k a. Map k a
Map.empty
IORef CnstMap
cmap <- CnstMap -> IO (IORef CnstMap)
forall a. a -> IO (IORef a)
newIORef CnstMap
forall k a. Map k a
Map.empty
IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
inps <- (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> IO
(IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String))
forall a. a -> IO (IORef a)
newIORef (([], []), Set String
forall a. Set a
Set.empty)
IORef [SV]
outs <- [SV] -> IO (IORef [SV])
forall a. a -> IO (IORef a)
newIORef []
IORef TableMap
tables <- TableMap -> IO (IORef TableMap)
forall a. a -> IO (IORef a)
newIORef TableMap
forall k a. Map k a
Map.empty
IORef ArrayMap
arrays <- ArrayMap -> IO (IORef ArrayMap)
forall a. a -> IO (IORef a)
newIORef ArrayMap
forall a. IntMap a
IMap.empty
IORef FArrayMap
fArrays <- FArrayMap -> IO (IORef FArrayMap)
forall a. a -> IO (IORef a)
newIORef FArrayMap
forall a. IntMap a
IMap.empty
IORef UIMap
uis <- UIMap -> IO (IORef UIMap)
forall a. a -> IO (IORef a)
newIORef UIMap
forall k a. Map k a
Map.empty
IORef CgMap
cgs <- CgMap -> IO (IORef CgMap)
forall a. a -> IO (IORef a)
newIORef CgMap
forall k a. Map k a
Map.empty
IORef [(String, [String])]
axioms <- [(String, [String])] -> IO (IORef [(String, [String])])
forall a. a -> IO (IORef a)
newIORef []
IORef (Cache SV)
swCache <- Cache SV -> IO (IORef (Cache SV))
forall a. a -> IO (IORef a)
newIORef Cache SV
forall a. IntMap a
IMap.empty
IORef (Cache ArrayIndex)
aiCache <- Cache ArrayIndex -> IO (IORef (Cache ArrayIndex))
forall a. a -> IO (IORef a)
newIORef Cache ArrayIndex
forall a. IntMap a
IMap.empty
IORef (Cache FArrayIndex)
faiCache <- Cache FArrayIndex -> IO (IORef (Cache FArrayIndex))
forall a. a -> IO (IORef a)
newIORef Cache FArrayIndex
forall a. IntMap a
IMap.empty
IORef (Set Kind)
usedKinds <- Set Kind -> IO (IORef (Set Kind))
forall a. a -> IO (IORef a)
newIORef Set Kind
forall a. Set a
Set.empty
IORef (Set String)
usedLbls <- Set String -> IO (IORef (Set String))
forall a. a -> IO (IORef a)
newIORef Set String
forall a. Set a
Set.empty
IORef (Seq (Bool, [(String, String)], SV))
cstrs <- Seq (Bool, [(String, String)], SV)
-> IO (IORef (Seq (Bool, [(String, String)], SV)))
forall a. a -> IO (IORef a)
newIORef Seq (Bool, [(String, String)], SV)
forall a. Seq a
S.empty
IORef [SMTOption]
smtOpts <- [SMTOption] -> IO (IORef [SMTOption])
forall a. a -> IO (IORef a)
newIORef []
IORef [Objective (SV, SV)]
optGoals <- [Objective (SV, SV)] -> IO (IORef [Objective (SV, SV)])
forall a. a -> IO (IORef a)
newIORef []
IORef [(String, Maybe CallStack, SV)]
asserts <- [(String, Maybe CallStack, SV)]
-> IO (IORef [(String, Maybe CallStack, SV)])
forall a. a -> IO (IORef a)
newIORef []
IORef IncState
istate <- IncState -> IO (IORef IncState)
forall a. a -> IO (IORef a)
newIORef (IncState -> IO (IORef IncState))
-> IO IncState -> IO (IORef IncState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO IncState
newIncState
IORef (Maybe QueryState)
qstate <- Maybe QueryState -> IO (IORef (Maybe QueryState))
forall a. a -> IO (IORef a)
newIORef Maybe QueryState
forall a. Maybe a
Nothing
State -> IO State
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ State :: SVal
-> UTCTime
-> IORef SBVRunMode
-> IORef IncState
-> IORef [(String, CV)]
-> IORef [(String, CV -> Bool, SV)]
-> IORef Int
-> IORef (Set Kind)
-> IORef (Set String)
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> IORef (Seq (Bool, [(String, String)], SV))
-> IORef [SV]
-> IORef TableMap
-> IORef SBVPgm
-> IORef CnstMap
-> IORef ExprMap
-> IORef ArrayMap
-> IORef FArrayMap
-> IORef UIMap
-> IORef CgMap
-> IORef [(String, [String])]
-> IORef [SMTOption]
-> IORef [Objective (SV, SV)]
-> IORef [(String, Maybe CallStack, SV)]
-> IORef (Cache SV)
-> IORef (Cache ArrayIndex)
-> IORef (Cache FArrayIndex)
-> IORef (Maybe QueryState)
-> State
State { runMode :: IORef SBVRunMode
runMode = IORef SBVRunMode
rm
, startTime :: UTCTime
startTime = UTCTime
currTime
, pathCond :: SVal
pathCond = Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left CV
trueCV)
, rIncState :: IORef IncState
rIncState = IORef IncState
istate
, rCInfo :: IORef [(String, CV)]
rCInfo = IORef [(String, CV)]
cInfo
, rObservables :: IORef [(String, CV -> Bool, SV)]
rObservables = IORef [(String, CV -> Bool, SV)]
observes
, rctr :: IORef Int
rctr = IORef Int
ctr
, rUsedKinds :: IORef (Set Kind)
rUsedKinds = IORef (Set Kind)
usedKinds
, rUsedLbls :: IORef (Set String)
rUsedLbls = IORef (Set String)
usedLbls
, rinps :: IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps = IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
inps
, routs :: IORef [SV]
routs = IORef [SV]
outs
, rtblMap :: IORef TableMap
rtblMap = IORef TableMap
tables
, spgm :: IORef SBVPgm
spgm = IORef SBVPgm
pgm
, rconstMap :: IORef CnstMap
rconstMap = IORef CnstMap
cmap
, rArrayMap :: IORef ArrayMap
rArrayMap = IORef ArrayMap
arrays
, rFArrayMap :: IORef FArrayMap
rFArrayMap = IORef FArrayMap
fArrays
, rexprMap :: IORef ExprMap
rexprMap = IORef ExprMap
emap
, rUIMap :: IORef UIMap
rUIMap = IORef UIMap
uis
, rCgMap :: IORef CgMap
rCgMap = IORef CgMap
cgs
, raxioms :: IORef [(String, [String])]
raxioms = IORef [(String, [String])]
axioms
, rSVCache :: IORef (Cache SV)
rSVCache = IORef (Cache SV)
swCache
, rAICache :: IORef (Cache ArrayIndex)
rAICache = IORef (Cache ArrayIndex)
aiCache
, rFAICache :: IORef (Cache FArrayIndex)
rFAICache = IORef (Cache FArrayIndex)
faiCache
, rConstraints :: IORef (Seq (Bool, [(String, String)], SV))
rConstraints = IORef (Seq (Bool, [(String, String)], SV))
cstrs
, rSMTOptions :: IORef [SMTOption]
rSMTOptions = IORef [SMTOption]
smtOpts
, rOptGoals :: IORef [Objective (SV, SV)]
rOptGoals = IORef [Objective (SV, SV)]
optGoals
, rAsserts :: IORef [(String, Maybe CallStack, SV)]
rAsserts = IORef [(String, Maybe CallStack, SV)]
asserts
, rQueryState :: IORef (Maybe QueryState)
rQueryState = IORef (Maybe QueryState)
qstate
}
SV
_ <- IO SV -> m SV
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> m SV) -> IO SV -> m SV
forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
falseCV
SV
_ <- IO SV -> m SV
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> m SV) -> IO SV -> m SV
forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
trueCV
a
r <- ReaderT State m a -> State -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT State m a
c State
st
Result
res <- IO Result -> m Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> m Result) -> IO Result -> m Result
forall a b. (a -> b) -> a -> b
$ State -> IO Result
extractSymbolicSimulationState State
st
Maybe QueryState
qs <- IO (Maybe QueryState) -> m (Maybe QueryState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe QueryState) -> m (Maybe QueryState))
-> IO (Maybe QueryState) -> m (Maybe QueryState)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe QueryState) -> IO (Maybe QueryState)
forall a. IORef a -> IO a
readIORef (IORef (Maybe QueryState) -> IO (Maybe QueryState))
-> IORef (Maybe QueryState) -> IO (Maybe QueryState)
forall a b. (a -> b) -> a -> b
$ State -> IORef (Maybe QueryState)
rQueryState State
st
case Maybe QueryState
qs of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just QueryState{IO ()
queryTerminate :: IO ()
queryTerminate :: QueryState -> IO ()
queryTerminate} -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
queryTerminate
(a, Result) -> m (a, Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, Result
res)
extractSymbolicSimulationState :: State -> IO Result
st :: State
st@State{ spgm :: State -> IORef SBVPgm
spgm=IORef SBVPgm
pgm, rinps :: State
-> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
rinps=IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
inps, routs :: State -> IORef [SV]
routs=IORef [SV]
outs, rtblMap :: State -> IORef TableMap
rtblMap=IORef TableMap
tables, rArrayMap :: State -> IORef ArrayMap
rArrayMap=IORef ArrayMap
arrays, rUIMap :: State -> IORef UIMap
rUIMap=IORef UIMap
uis, raxioms :: State -> IORef [(String, [String])]
raxioms=IORef [(String, [String])]
axioms
, rAsserts :: State -> IORef [(String, Maybe CallStack, SV)]
rAsserts=IORef [(String, Maybe CallStack, SV)]
asserts, rUsedKinds :: State -> IORef (Set Kind)
rUsedKinds=IORef (Set Kind)
usedKinds, rCgMap :: State -> IORef CgMap
rCgMap=IORef CgMap
cgs, rCInfo :: State -> IORef [(String, CV)]
rCInfo=IORef [(String, CV)]
cInfo, rConstraints :: State -> IORef (Seq (Bool, [(String, String)], SV))
rConstraints=IORef (Seq (Bool, [(String, String)], SV))
cstrs
, rObservables :: State -> IORef [(String, CV -> Bool, SV)]
rObservables=IORef [(String, CV -> Bool, SV)]
observes
} = do
SBVPgm rpgm :: Seq (SV, SBVExpr)
rpgm <- IORef SBVPgm -> IO SBVPgm
forall a. IORef a -> IO a
readIORef IORef SBVPgm
pgm
([(Quantifier, NamedSymVar)], [NamedSymVar])
inpsO <- ([(Quantifier, NamedSymVar)] -> [(Quantifier, NamedSymVar)]
forall a. [a] -> [a]
reverse ([(Quantifier, NamedSymVar)] -> [(Quantifier, NamedSymVar)])
-> ([NamedSymVar] -> [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [NamedSymVar] -> [NamedSymVar]
forall a. [a] -> [a]
reverse) (([(Quantifier, NamedSymVar)], [NamedSymVar])
-> ([(Quantifier, NamedSymVar)], [NamedSymVar]))
-> ((([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> ([(Quantifier, NamedSymVar)], [NamedSymVar]))
-> (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall a b. (a, b) -> a
fst ((([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> ([(Quantifier, NamedSymVar)], [NamedSymVar]))
-> IO (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> IO ([(Quantifier, NamedSymVar)], [NamedSymVar])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
-> IO (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
forall a. IORef a -> IO a
readIORef IORef (([(Quantifier, NamedSymVar)], [NamedSymVar]), Set String)
inps
[SV]
outsO <- [SV] -> [SV]
forall a. [a] -> [a]
reverse ([SV] -> [SV]) -> IO [SV] -> IO [SV]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [SV] -> IO [SV]
forall a. IORef a -> IO a
readIORef IORef [SV]
outs
let swap :: (b, a) -> (a, b)
swap (a :: b
a, b :: a
b) = (a
b, b
a)
cmp :: (a, b) -> (a, b) -> Ordering
cmp (a :: a
a, _) (b :: a
b, _) = a
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
b
arrange :: (a, (b, c, b)) -> ((a, b, c), b)
arrange (i :: a
i, (at :: b
at, rt :: c
rt, es :: b
es)) = ((a
i, b
at, c
rt), b
es)
[(SV, CV)]
cnsts <- ((SV, CV) -> (SV, CV) -> Ordering) -> [(SV, CV)] -> [(SV, CV)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SV, CV) -> (SV, CV) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
cmp ([(SV, CV)] -> [(SV, CV)])
-> (CnstMap -> [(SV, CV)]) -> CnstMap -> [(SV, CV)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CV, SV) -> (SV, CV)) -> [(CV, SV)] -> [(SV, CV)]
forall a b. (a -> b) -> [a] -> [b]
map (CV, SV) -> (SV, CV)
forall b a. (b, a) -> (a, b)
swap ([(CV, SV)] -> [(SV, CV)])
-> (CnstMap -> [(CV, SV)]) -> CnstMap -> [(SV, CV)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CnstMap -> [(CV, SV)]
forall k a. Map k a -> [(k, a)]
Map.toList (CnstMap -> [(SV, CV)]) -> IO CnstMap -> IO [(SV, CV)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CnstMap -> IO CnstMap
forall a. IORef a -> IO a
readIORef (State -> IORef CnstMap
rconstMap State
st)
[((Int, Kind, Kind), [SV])]
tbls <- ((Int, (Kind, Kind, [SV])) -> ((Int, Kind, Kind), [SV]))
-> [(Int, (Kind, Kind, [SV]))] -> [((Int, Kind, Kind), [SV])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (Kind, Kind, [SV])) -> ((Int, Kind, Kind), [SV])
forall a b c b. (a, (b, c, b)) -> ((a, b, c), b)
arrange ([(Int, (Kind, Kind, [SV]))] -> [((Int, Kind, Kind), [SV])])
-> (TableMap -> [(Int, (Kind, Kind, [SV]))])
-> TableMap
-> [((Int, Kind, Kind), [SV])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (Kind, Kind, [SV]))
-> (Int, (Kind, Kind, [SV])) -> Ordering)
-> [(Int, (Kind, Kind, [SV]))] -> [(Int, (Kind, Kind, [SV]))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, (Kind, Kind, [SV])) -> (Int, (Kind, Kind, [SV])) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
cmp ([(Int, (Kind, Kind, [SV]))] -> [(Int, (Kind, Kind, [SV]))])
-> (TableMap -> [(Int, (Kind, Kind, [SV]))])
-> TableMap
-> [(Int, (Kind, Kind, [SV]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Kind, Kind, [SV]), Int) -> (Int, (Kind, Kind, [SV])))
-> [((Kind, Kind, [SV]), Int)] -> [(Int, (Kind, Kind, [SV]))]
forall a b. (a -> b) -> [a] -> [b]
map ((Kind, Kind, [SV]), Int) -> (Int, (Kind, Kind, [SV]))
forall b a. (b, a) -> (a, b)
swap ([((Kind, Kind, [SV]), Int)] -> [(Int, (Kind, Kind, [SV]))])
-> (TableMap -> [((Kind, Kind, [SV]), Int)])
-> TableMap
-> [(Int, (Kind, Kind, [SV]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMap -> [((Kind, Kind, [SV]), Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (TableMap -> [((Int, Kind, Kind), [SV])])
-> IO TableMap -> IO [((Int, Kind, Kind), [SV])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef TableMap -> IO TableMap
forall a. IORef a -> IO a
readIORef IORef TableMap
tables
[(Int, ArrayInfo)]
arrs <- ArrayMap -> [(Int, ArrayInfo)]
forall a. IntMap a -> [(Int, a)]
IMap.toAscList (ArrayMap -> [(Int, ArrayInfo)])
-> IO ArrayMap -> IO [(Int, ArrayInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ArrayMap -> IO ArrayMap
forall a. IORef a -> IO a
readIORef IORef ArrayMap
arrays
[(String, SBVType)]
unint <- UIMap -> [(String, SBVType)]
forall k a. Map k a -> [(k, a)]
Map.toList (UIMap -> [(String, SBVType)])
-> IO UIMap -> IO [(String, SBVType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef UIMap -> IO UIMap
forall a. IORef a -> IO a
readIORef IORef UIMap
uis
[(String, [String])]
axs <- [(String, [String])] -> [(String, [String])]
forall a. [a] -> [a]
reverse ([(String, [String])] -> [(String, [String])])
-> IO [(String, [String])] -> IO [(String, [String])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [(String, [String])] -> IO [(String, [String])]
forall a. IORef a -> IO a
readIORef IORef [(String, [String])]
axioms
Set Kind
knds <- IORef (Set Kind) -> IO (Set Kind)
forall a. IORef a -> IO a
readIORef IORef (Set Kind)
usedKinds
[(String, [String])]
cgMap <- CgMap -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
Map.toList (CgMap -> [(String, [String])])
-> IO CgMap -> IO [(String, [String])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CgMap -> IO CgMap
forall a. IORef a -> IO a
readIORef IORef CgMap
cgs
[(String, CV)]
traceVals <- [(String, CV)] -> [(String, CV)]
forall a. [a] -> [a]
reverse ([(String, CV)] -> [(String, CV)])
-> IO [(String, CV)] -> IO [(String, CV)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [(String, CV)] -> IO [(String, CV)]
forall a. IORef a -> IO a
readIORef IORef [(String, CV)]
cInfo
[(String, CV -> Bool, SV)]
observables <- [(String, CV -> Bool, SV)] -> [(String, CV -> Bool, SV)]
forall a. [a] -> [a]
reverse ([(String, CV -> Bool, SV)] -> [(String, CV -> Bool, SV)])
-> IO [(String, CV -> Bool, SV)] -> IO [(String, CV -> Bool, SV)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [(String, CV -> Bool, SV)] -> IO [(String, CV -> Bool, SV)]
forall a. IORef a -> IO a
readIORef IORef [(String, CV -> Bool, SV)]
observes
Seq (Bool, [(String, String)], SV)
extraCstrs <- IORef (Seq (Bool, [(String, String)], SV))
-> IO (Seq (Bool, [(String, String)], SV))
forall a. IORef a -> IO a
readIORef IORef (Seq (Bool, [(String, String)], SV))
cstrs
[(String, Maybe CallStack, SV)]
assertions <- [(String, Maybe CallStack, SV)] -> [(String, Maybe CallStack, SV)]
forall a. [a] -> [a]
reverse ([(String, Maybe CallStack, SV)]
-> [(String, Maybe CallStack, SV)])
-> IO [(String, Maybe CallStack, SV)]
-> IO [(String, Maybe CallStack, SV)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [(String, Maybe CallStack, SV)]
-> IO [(String, Maybe CallStack, SV)]
forall a. IORef a -> IO a
readIORef IORef [(String, Maybe CallStack, SV)]
asserts
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ Set Kind
-> [(String, CV)]
-> [(String, CV -> Bool, SV)]
-> [(String, [String])]
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
-> [(SV, CV)]
-> [((Int, Kind, Kind), [SV])]
-> [(Int, ArrayInfo)]
-> [(String, SBVType)]
-> [(String, [String])]
-> SBVPgm
-> Seq (Bool, [(String, String)], SV)
-> [(String, Maybe CallStack, SV)]
-> [SV]
-> Result
Result Set Kind
knds [(String, CV)]
traceVals [(String, CV -> Bool, SV)]
observables [(String, [String])]
cgMap ([(Quantifier, NamedSymVar)], [NamedSymVar])
inpsO [(SV, CV)]
cnsts [((Int, Kind, Kind), [SV])]
tbls [(Int, ArrayInfo)]
arrs [(String, SBVType)]
unint [(String, [String])]
axs (Seq (SV, SBVExpr) -> SBVPgm
SBVPgm Seq (SV, SBVExpr)
rpgm) Seq (Bool, [(String, String)], SV)
extraCstrs [(String, Maybe CallStack, SV)]
assertions [SV]
outsO
addNewSMTOption :: MonadSymbolic m => SMTOption -> m ()
addNewSMTOption :: SMTOption -> m ()
addNewSMTOption o :: SMTOption
o = do State
st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State
-> (State -> IORef [SMTOption])
-> ([SMTOption] -> [SMTOption])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [SMTOption]
rSMTOptions (SMTOption
oSMTOption -> [SMTOption] -> [SMTOption]
forall a. a -> [a] -> [a]
:) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
imposeConstraint :: MonadSymbolic m => Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint :: Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint isSoft :: Bool
isSoft attrs :: [(String, String)]
attrs c :: SVal
c = do State
st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
SBVRunMode
rm <- IO SBVRunMode -> m SBVRunMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SBVRunMode -> m SBVRunMode) -> IO SBVRunMode -> m SBVRunMode
forall a b. (a -> b) -> a -> b
$ IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)
case SBVRunMode
rm of
CodeGen -> String -> m ()
forall a. HasCallStack => String -> a
error "SBV: constraints are not allowed in code-generation"
_ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> State -> String -> IO ()
registerLabel "Constraint" State
st) [String
nm | (":named", nm :: String
nm) <- [(String, String)]
attrs]
State -> Bool -> [(String, String)] -> SVal -> IO ()
internalConstraint State
st Bool
isSoft [(String, String)]
attrs SVal
c
internalConstraint :: State -> Bool -> [(String, String)] -> SVal -> IO ()
internalConstraint :: State -> Bool -> [(String, String)] -> SVal -> IO ()
internalConstraint st :: State
st isSoft :: Bool
isSoft attrs :: [(String, String)]
attrs b :: SVal
b = do SV
v <- State -> SVal -> IO SV
svToSV State
st SVal
b
SBVRunMode
rm <- IO SBVRunMode -> IO SBVRunMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SBVRunMode -> IO SBVRunMode) -> IO SBVRunMode -> IO SBVRunMode
forall a b. (a -> b) -> a -> b
$ IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)
let isValidating :: Bool
isValidating = case SBVRunMode
rm of
SMTMode _ _ _ cfg :: SMTConfig
cfg -> SMTConfig -> Bool
validationRequested SMTConfig
cfg
CodeGen -> Bool
False
Concrete Nothing -> Bool
False
Concrete (Just _) -> Bool
True
let c :: (Bool, [(String, String)], SV)
c = (Bool
isSoft, [(String, String)]
attrs, SV
v)
interesting :: Bool
interesting = SV
v SV -> SV -> Bool
forall a. Eq a => a -> a -> Bool
/= SV
trueSV Bool -> Bool -> Bool
|| Bool -> Bool
not ([(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
attrs)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isValidating Bool -> Bool -> Bool
|| Bool
interesting) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
State
-> (State -> IORef (Seq (Bool, [(String, String)], SV)))
-> (Seq (Bool, [(String, String)], SV)
-> Seq (Bool, [(String, String)], SV))
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Seq (Bool, [(String, String)], SV))
rConstraints (Seq (Bool, [(String, String)], SV)
-> (Bool, [(String, String)], SV)
-> Seq (Bool, [(String, String)], SV)
forall a. Seq a -> a -> Seq a
S.|> (Bool, [(String, String)], SV)
c)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef (Seq (Bool, [(String, String)], SV)))
-> (Seq (Bool, [(String, String)], SV)
-> Seq (Bool, [(String, String)], SV))
-> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef (Seq (Bool, [(String, String)], SV))
rNewConstraints (Seq (Bool, [(String, String)], SV)
-> (Bool, [(String, String)], SV)
-> Seq (Bool, [(String, String)], SV)
forall a. Seq a -> a -> Seq a
S.|> (Bool, [(String, String)], SV)
c)
addSValOptGoal :: MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal :: Objective SVal -> m ()
addSValOptGoal obj :: Objective SVal
obj = do State
st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
let mkGoal :: String -> SVal -> m (SV, SV)
mkGoal nm :: String
nm orig :: SVal
orig = IO (SV, SV) -> m (SV, SV)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SV, SV) -> m (SV, SV)) -> IO (SV, SV) -> m (SV, SV)
forall a b. (a -> b) -> a -> b
$ do SV
origSV <- State -> SVal -> IO SV
svToSV State
st SVal
orig
SVal
track <- Kind -> String -> State -> IO SVal
svMkTrackerVar (SVal -> Kind
forall a. HasKind a => a -> Kind
kindOf SVal
orig) String
nm State
st
SV
trackSV <- State -> SVal -> IO SV
svToSV State
st SVal
track
(SV, SV) -> IO (SV, SV)
forall (m :: * -> *) a. Monad m => a -> m a
return (SV
origSV, SV
trackSV)
let walk :: Objective SVal -> m (Objective (SV, SV))
walk (Minimize nm :: String
nm v :: SVal
v) = String -> (SV, SV) -> Objective (SV, SV)
forall a. String -> a -> Objective a
Minimize String
nm ((SV, SV) -> Objective (SV, SV))
-> m (SV, SV) -> m (Objective (SV, SV))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SVal -> m (SV, SV)
mkGoal String
nm SVal
v
walk (Maximize nm :: String
nm v :: SVal
v) = String -> (SV, SV) -> Objective (SV, SV)
forall a. String -> a -> Objective a
Maximize String
nm ((SV, SV) -> Objective (SV, SV))
-> m (SV, SV) -> m (Objective (SV, SV))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SVal -> m (SV, SV)
mkGoal String
nm SVal
v
walk (AssertWithPenalty nm :: String
nm v :: SVal
v mbP :: Penalty
mbP) = ((SV, SV) -> Penalty -> Objective (SV, SV))
-> Penalty -> (SV, SV) -> Objective (SV, SV)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (SV, SV) -> Penalty -> Objective (SV, SV)
forall a. String -> a -> Penalty -> Objective a
AssertWithPenalty String
nm) Penalty
mbP ((SV, SV) -> Objective (SV, SV))
-> m (SV, SV) -> m (Objective (SV, SV))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SVal -> m (SV, SV)
mkGoal String
nm SVal
v
Objective (SV, SV)
obj' <- Objective SVal -> m (Objective (SV, SV))
walk Objective SVal
obj
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State
-> (State -> IORef [Objective (SV, SV)])
-> ([Objective (SV, SV)] -> [Objective (SV, SV)])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [Objective (SV, SV)]
rOptGoals (Objective (SV, SV)
obj' Objective (SV, SV) -> [Objective (SV, SV)] -> [Objective (SV, SV)]
forall a. a -> [a] -> [a]
:)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> IO ()
forall a. [String] -> a
noInteractive [ "Adding an optimization objective:"
, " Objective: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Objective SVal -> String
forall a. Show a => a -> String
show Objective SVal
obj
]
outputSVal :: MonadSymbolic m => SVal -> m ()
outputSVal :: SVal -> m ()
outputSVal (SVal _ (Left c :: CV
c)) = do
State
st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
SV
sv <- IO SV -> m SV
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> m SV) -> IO SV -> m SV
forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
c
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State -> (State -> IORef [SV]) -> ([SV] -> [SV]) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [SV]
routs (SV
svSV -> [SV] -> [SV]
forall a. a -> [a] -> [a]
:) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
outputSVal (SVal _ (Right f :: Cached SV
f)) = do
State
st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
SV
sv <- IO SV -> m SV
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> m SV) -> IO SV -> m SV
forall a b. (a -> b) -> a -> b
$ Cached SV -> State -> IO SV
uncache Cached SV
f State
st
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State -> (State -> IORef [SV]) -> ([SV] -> [SV]) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [SV]
routs (SV
svSV -> [SV] -> [SV]
forall a. a -> [a] -> [a]
:) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
newtype Cached a = Cached (State -> IO a)
cache :: (State -> IO a) -> Cached a
cache :: (State -> IO a) -> Cached a
cache = (State -> IO a) -> Cached a
forall a. (State -> IO a) -> Cached a
Cached
uncache :: Cached SV -> State -> IO SV
uncache :: Cached SV -> State -> IO SV
uncache = (State -> IORef (Cache SV)) -> Cached SV -> State -> IO SV
forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache SV)
rSVCache
newtype ArrayIndex = ArrayIndex { ArrayIndex -> Int
unArrayIndex :: Int } deriving (ArrayIndex -> ArrayIndex -> Bool
(ArrayIndex -> ArrayIndex -> Bool)
-> (ArrayIndex -> ArrayIndex -> Bool) -> Eq ArrayIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayIndex -> ArrayIndex -> Bool
$c/= :: ArrayIndex -> ArrayIndex -> Bool
== :: ArrayIndex -> ArrayIndex -> Bool
$c== :: ArrayIndex -> ArrayIndex -> Bool
Eq, Eq ArrayIndex
Eq ArrayIndex =>
(ArrayIndex -> ArrayIndex -> Ordering)
-> (ArrayIndex -> ArrayIndex -> Bool)
-> (ArrayIndex -> ArrayIndex -> Bool)
-> (ArrayIndex -> ArrayIndex -> Bool)
-> (ArrayIndex -> ArrayIndex -> Bool)
-> (ArrayIndex -> ArrayIndex -> ArrayIndex)
-> (ArrayIndex -> ArrayIndex -> ArrayIndex)
-> Ord ArrayIndex
ArrayIndex -> ArrayIndex -> Bool
ArrayIndex -> ArrayIndex -> Ordering
ArrayIndex -> ArrayIndex -> ArrayIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrayIndex -> ArrayIndex -> ArrayIndex
$cmin :: ArrayIndex -> ArrayIndex -> ArrayIndex
max :: ArrayIndex -> ArrayIndex -> ArrayIndex
$cmax :: ArrayIndex -> ArrayIndex -> ArrayIndex
>= :: ArrayIndex -> ArrayIndex -> Bool
$c>= :: ArrayIndex -> ArrayIndex -> Bool
> :: ArrayIndex -> ArrayIndex -> Bool
$c> :: ArrayIndex -> ArrayIndex -> Bool
<= :: ArrayIndex -> ArrayIndex -> Bool
$c<= :: ArrayIndex -> ArrayIndex -> Bool
< :: ArrayIndex -> ArrayIndex -> Bool
$c< :: ArrayIndex -> ArrayIndex -> Bool
compare :: ArrayIndex -> ArrayIndex -> Ordering
$ccompare :: ArrayIndex -> ArrayIndex -> Ordering
$cp1Ord :: Eq ArrayIndex
Ord)
instance Show ArrayIndex where
show :: ArrayIndex -> String
show (ArrayIndex i :: Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
newtype FArrayIndex = FArrayIndex { FArrayIndex -> Int
unFArrayIndex :: Int } deriving (FArrayIndex -> FArrayIndex -> Bool
(FArrayIndex -> FArrayIndex -> Bool)
-> (FArrayIndex -> FArrayIndex -> Bool) -> Eq FArrayIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FArrayIndex -> FArrayIndex -> Bool
$c/= :: FArrayIndex -> FArrayIndex -> Bool
== :: FArrayIndex -> FArrayIndex -> Bool
$c== :: FArrayIndex -> FArrayIndex -> Bool
Eq, Eq FArrayIndex
Eq FArrayIndex =>
(FArrayIndex -> FArrayIndex -> Ordering)
-> (FArrayIndex -> FArrayIndex -> Bool)
-> (FArrayIndex -> FArrayIndex -> Bool)
-> (FArrayIndex -> FArrayIndex -> Bool)
-> (FArrayIndex -> FArrayIndex -> Bool)
-> (FArrayIndex -> FArrayIndex -> FArrayIndex)
-> (FArrayIndex -> FArrayIndex -> FArrayIndex)
-> Ord FArrayIndex
FArrayIndex -> FArrayIndex -> Bool
FArrayIndex -> FArrayIndex -> Ordering
FArrayIndex -> FArrayIndex -> FArrayIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FArrayIndex -> FArrayIndex -> FArrayIndex
$cmin :: FArrayIndex -> FArrayIndex -> FArrayIndex
max :: FArrayIndex -> FArrayIndex -> FArrayIndex
$cmax :: FArrayIndex -> FArrayIndex -> FArrayIndex
>= :: FArrayIndex -> FArrayIndex -> Bool
$c>= :: FArrayIndex -> FArrayIndex -> Bool
> :: FArrayIndex -> FArrayIndex -> Bool
$c> :: FArrayIndex -> FArrayIndex -> Bool
<= :: FArrayIndex -> FArrayIndex -> Bool
$c<= :: FArrayIndex -> FArrayIndex -> Bool
< :: FArrayIndex -> FArrayIndex -> Bool
$c< :: FArrayIndex -> FArrayIndex -> Bool
compare :: FArrayIndex -> FArrayIndex -> Ordering
$ccompare :: FArrayIndex -> FArrayIndex -> Ordering
$cp1Ord :: Eq FArrayIndex
Ord)
instance Show FArrayIndex where
show :: FArrayIndex -> String
show (FArrayIndex i :: Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
uncacheAI :: Cached ArrayIndex -> State -> IO ArrayIndex
uncacheAI :: Cached ArrayIndex -> State -> IO ArrayIndex
uncacheAI = (State -> IORef (Cache ArrayIndex))
-> Cached ArrayIndex -> State -> IO ArrayIndex
forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache ArrayIndex)
rAICache
uncacheFAI :: Cached FArrayIndex -> State -> IO FArrayIndex
uncacheFAI :: Cached FArrayIndex -> State -> IO FArrayIndex
uncacheFAI = (State -> IORef (Cache FArrayIndex))
-> Cached FArrayIndex -> State -> IO FArrayIndex
forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache FArrayIndex)
rFAICache
uncacheGen :: (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen :: (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen getCache :: State -> IORef (Cache a)
getCache (Cached f :: State -> IO a
f) st :: State
st = do
let rCache :: IORef (Cache a)
rCache = State -> IORef (Cache a)
getCache State
st
Cache a
stored <- IORef (Cache a) -> IO (Cache a)
forall a. IORef a -> IO a
readIORef IORef (Cache a)
rCache
StableName (State -> IO a)
sn <- State -> IO a
f (State -> IO a)
-> IO (StableName (State -> IO a))
-> IO (StableName (State -> IO a))
forall a b. a -> b -> b
`seq` (State -> IO a) -> IO (StableName (State -> IO a))
forall a. a -> IO (StableName a)
makeStableName State -> IO a
f
let h :: Int
h = StableName (State -> IO a) -> Int
forall a. StableName a -> Int
hashStableName StableName (State -> IO a)
sn
case (Int
h Int -> Cache a -> Maybe [(StableName (State -> IO a), a)]
forall a. Int -> IntMap a -> Maybe a
`IMap.lookup` Cache a
stored) Maybe [(StableName (State -> IO a), a)]
-> ([(StableName (State -> IO a), a)] -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StableName (State -> IO a)
sn StableName (State -> IO a)
-> [(StableName (State -> IO a), a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup`) of
Just r :: a
r -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
Nothing -> do a
r <- State -> IO a
f State
st
a
r a -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef (Cache a) -> (Cache a -> Cache a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' IORef (Cache a)
rCache (([(StableName (State -> IO a), a)]
-> [(StableName (State -> IO a), a)]
-> [(StableName (State -> IO a), a)])
-> Int -> [(StableName (State -> IO a), a)] -> Cache a -> Cache a
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IMap.insertWith [(StableName (State -> IO a), a)]
-> [(StableName (State -> IO a), a)]
-> [(StableName (State -> IO a), a)]
forall a. [a] -> [a] -> [a]
(++) Int
h [(StableName (State -> IO a)
sn, a
r)])
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
data SMTLibVersion = SMTLib2
deriving (SMTLibVersion
SMTLibVersion -> SMTLibVersion -> Bounded SMTLibVersion
forall a. a -> a -> Bounded a
maxBound :: SMTLibVersion
$cmaxBound :: SMTLibVersion
minBound :: SMTLibVersion
$cminBound :: SMTLibVersion
Bounded, Int -> SMTLibVersion
SMTLibVersion -> Int
SMTLibVersion -> [SMTLibVersion]
SMTLibVersion -> SMTLibVersion
SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
SMTLibVersion -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
(SMTLibVersion -> SMTLibVersion)
-> (SMTLibVersion -> SMTLibVersion)
-> (Int -> SMTLibVersion)
-> (SMTLibVersion -> Int)
-> (SMTLibVersion -> [SMTLibVersion])
-> (SMTLibVersion -> SMTLibVersion -> [SMTLibVersion])
-> (SMTLibVersion -> SMTLibVersion -> [SMTLibVersion])
-> (SMTLibVersion
-> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion])
-> Enum SMTLibVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SMTLibVersion -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
$cenumFromThenTo :: SMTLibVersion -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
enumFromTo :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
$cenumFromTo :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
enumFromThen :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
$cenumFromThen :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
enumFrom :: SMTLibVersion -> [SMTLibVersion]
$cenumFrom :: SMTLibVersion -> [SMTLibVersion]
fromEnum :: SMTLibVersion -> Int
$cfromEnum :: SMTLibVersion -> Int
toEnum :: Int -> SMTLibVersion
$ctoEnum :: Int -> SMTLibVersion
pred :: SMTLibVersion -> SMTLibVersion
$cpred :: SMTLibVersion -> SMTLibVersion
succ :: SMTLibVersion -> SMTLibVersion
$csucc :: SMTLibVersion -> SMTLibVersion
Enum, SMTLibVersion -> SMTLibVersion -> Bool
(SMTLibVersion -> SMTLibVersion -> Bool)
-> (SMTLibVersion -> SMTLibVersion -> Bool) -> Eq SMTLibVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMTLibVersion -> SMTLibVersion -> Bool
$c/= :: SMTLibVersion -> SMTLibVersion -> Bool
== :: SMTLibVersion -> SMTLibVersion -> Bool
$c== :: SMTLibVersion -> SMTLibVersion -> Bool
Eq, Int -> SMTLibVersion -> ShowS
[SMTLibVersion] -> ShowS
SMTLibVersion -> String
(Int -> SMTLibVersion -> ShowS)
-> (SMTLibVersion -> String)
-> ([SMTLibVersion] -> ShowS)
-> Show SMTLibVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMTLibVersion] -> ShowS
$cshowList :: [SMTLibVersion] -> ShowS
show :: SMTLibVersion -> String
$cshow :: SMTLibVersion -> String
showsPrec :: Int -> SMTLibVersion -> ShowS
$cshowsPrec :: Int -> SMTLibVersion -> ShowS
Show)
smtLibVersionExtension :: SMTLibVersion -> String
smtLibVersionExtension :: SMTLibVersion -> String
smtLibVersionExtension SMTLib2 = "smt2"
data SMTLibPgm = SMTLibPgm SMTLibVersion [String]
instance NFData SMTLibVersion where rnf :: SMTLibVersion -> ()
rnf a :: SMTLibVersion
a = SMTLibVersion
a SMTLibVersion -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance NFData SMTLibPgm where rnf :: SMTLibPgm -> ()
rnf (SMTLibPgm v :: SMTLibVersion
v p :: [String]
p) = SMTLibVersion -> ()
forall a. NFData a => a -> ()
rnf SMTLibVersion
v () -> () -> ()
forall a b. a -> b -> b
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
p
instance Show SMTLibPgm where
show :: SMTLibPgm -> String
show (SMTLibPgm _ pre :: [String]
pre) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [String]
pre
instance NFData CV where
rnf :: CV -> ()
rnf (CV x :: Kind
x y :: CVal
y) = Kind
x Kind -> () -> ()
forall a b. a -> b -> b
`seq` CVal
y CVal -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance NFData GeneralizedCV where
rnf :: GeneralizedCV -> ()
rnf (ExtendedCV e :: ExtCV
e) = ExtCV
e ExtCV -> () -> ()
forall a b. a -> b -> b
`seq` ()
rnf (RegularCV c :: CV
c) = CV
c CV -> () -> ()
forall a b. a -> b -> b
`seq` ()
#if MIN_VERSION_base(4,9,0)
#else
instance NFData CallStack where
rnf _ = ()
#endif
instance NFData Result where
rnf :: Result -> ()
rnf (Result kindInfo :: Set Kind
kindInfo qcInfo :: [(String, CV)]
qcInfo obs :: [(String, CV -> Bool, SV)]
obs cgs :: [(String, [String])]
cgs inps :: ([(Quantifier, NamedSymVar)], [NamedSymVar])
inps consts :: [(SV, CV)]
consts tbls :: [((Int, Kind, Kind), [SV])]
tbls arrs :: [(Int, ArrayInfo)]
arrs uis :: [(String, SBVType)]
uis axs :: [(String, [String])]
axs pgm :: SBVPgm
pgm cstr :: Seq (Bool, [(String, String)], SV)
cstr asserts :: [(String, Maybe CallStack, SV)]
asserts outs :: [SV]
outs)
= Set Kind -> ()
forall a. NFData a => a -> ()
rnf Set Kind
kindInfo () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, CV)] -> ()
forall a. NFData a => a -> ()
rnf [(String, CV)]
qcInfo () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, CV -> Bool, SV)] -> ()
forall a. NFData a => a -> ()
rnf [(String, CV -> Bool, SV)]
obs () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, [String])] -> ()
forall a. NFData a => a -> ()
rnf [(String, [String])]
cgs
() -> () -> ()
forall a b. a -> b -> b
`seq` ([(Quantifier, NamedSymVar)], [NamedSymVar]) -> ()
forall a. NFData a => a -> ()
rnf ([(Quantifier, NamedSymVar)], [NamedSymVar])
inps () -> () -> ()
forall a b. a -> b -> b
`seq` [(SV, CV)] -> ()
forall a. NFData a => a -> ()
rnf [(SV, CV)]
consts () -> () -> ()
forall a b. a -> b -> b
`seq` [((Int, Kind, Kind), [SV])] -> ()
forall a. NFData a => a -> ()
rnf [((Int, Kind, Kind), [SV])]
tbls
() -> () -> ()
forall a b. a -> b -> b
`seq` [(Int, ArrayInfo)] -> ()
forall a. NFData a => a -> ()
rnf [(Int, ArrayInfo)]
arrs () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, SBVType)] -> ()
forall a. NFData a => a -> ()
rnf [(String, SBVType)]
uis () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, [String])] -> ()
forall a. NFData a => a -> ()
rnf [(String, [String])]
axs
() -> () -> ()
forall a b. a -> b -> b
`seq` SBVPgm -> ()
forall a. NFData a => a -> ()
rnf SBVPgm
pgm () -> () -> ()
forall a b. a -> b -> b
`seq` Seq (Bool, [(String, String)], SV) -> ()
forall a. NFData a => a -> ()
rnf Seq (Bool, [(String, String)], SV)
cstr () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, Maybe CallStack, SV)] -> ()
forall a. NFData a => a -> ()
rnf [(String, Maybe CallStack, SV)]
asserts
() -> () -> ()
forall a b. a -> b -> b
`seq` [SV] -> ()
forall a. NFData a => a -> ()
rnf [SV]
outs
instance NFData Kind where rnf :: Kind -> ()
rnf a :: Kind
a = Kind -> () -> ()
forall a b. a -> b -> b
seq Kind
a ()
instance NFData ArrayContext where rnf :: ArrayContext -> ()
rnf a :: ArrayContext
a = ArrayContext -> () -> ()
forall a b. a -> b -> b
seq ArrayContext
a ()
instance NFData SV where rnf :: SV -> ()
rnf a :: SV
a = SV -> () -> ()
forall a b. a -> b -> b
seq SV
a ()
instance NFData SBVExpr where rnf :: SBVExpr -> ()
rnf a :: SBVExpr
a = SBVExpr -> () -> ()
forall a b. a -> b -> b
seq SBVExpr
a ()
instance NFData Quantifier where rnf :: Quantifier -> ()
rnf a :: Quantifier
a = Quantifier -> () -> ()
forall a b. a -> b -> b
seq Quantifier
a ()
instance NFData SBVType where rnf :: SBVType -> ()
rnf a :: SBVType
a = SBVType -> () -> ()
forall a b. a -> b -> b
seq SBVType
a ()
instance NFData SBVPgm where rnf :: SBVPgm -> ()
rnf a :: SBVPgm
a = SBVPgm -> () -> ()
forall a b. a -> b -> b
seq SBVPgm
a ()
instance NFData (Cached a) where rnf :: Cached a -> ()
rnf (Cached f :: State -> IO a
f) = State -> IO a
f (State -> IO a) -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance NFData SVal where rnf :: SVal -> ()
rnf (SVal x :: Kind
x y :: Either CV (Cached SV)
y) = Kind -> ()
forall a. NFData a => a -> ()
rnf Kind
x () -> () -> ()
forall a b. a -> b -> b
`seq` Either CV (Cached SV) -> ()
forall a. NFData a => a -> ()
rnf Either CV (Cached SV)
y
instance NFData SMTResult where
rnf :: SMTResult -> ()
rnf (Unsatisfiable _ xs :: Maybe [String]
xs ) = Maybe [String] -> ()
forall a. NFData a => a -> ()
rnf Maybe [String]
xs
rnf (Satisfiable _ xs :: SMTModel
xs ) = SMTModel -> ()
forall a. NFData a => a -> ()
rnf SMTModel
xs
rnf (SatExtField _ xs :: SMTModel
xs ) = SMTModel -> ()
forall a. NFData a => a -> ()
rnf SMTModel
xs
rnf (Unknown _ xs :: SMTReasonUnknown
xs ) = SMTReasonUnknown -> ()
forall a. NFData a => a -> ()
rnf SMTReasonUnknown
xs
rnf (ProofError _ xs :: [String]
xs mr :: Maybe SMTResult
mr) = [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
xs () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe SMTResult -> ()
forall a. NFData a => a -> ()
rnf Maybe SMTResult
mr
instance NFData SMTModel where
rnf :: SMTModel -> ()
rnf (SMTModel objs :: [(String, GeneralizedCV)]
objs bndgs :: Maybe [((Quantifier, NamedSymVar), Maybe CV)]
bndgs assocs :: [(String, CV)]
assocs uifuns :: [(String, (SBVType, ([([CV], CV)], CV)))]
uifuns) = [(String, GeneralizedCV)] -> ()
forall a. NFData a => a -> ()
rnf [(String, GeneralizedCV)]
objs () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe [((Quantifier, NamedSymVar), Maybe CV)] -> ()
forall a. NFData a => a -> ()
rnf Maybe [((Quantifier, NamedSymVar), Maybe CV)]
bndgs () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, CV)] -> ()
forall a. NFData a => a -> ()
rnf [(String, CV)]
assocs () -> () -> ()
forall a b. a -> b -> b
`seq` [(String, (SBVType, ([([CV], CV)], CV)))] -> ()
forall a. NFData a => a -> ()
rnf [(String, (SBVType, ([([CV], CV)], CV)))]
uifuns
instance NFData SMTScript where
rnf :: SMTScript -> ()
rnf (SMTScript b :: String
b m :: [String]
m) = String -> ()
forall a. NFData a => a -> ()
rnf String
b () -> () -> ()
forall a b. a -> b -> b
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
m
data SolverCapabilities = SolverCapabilities {
SolverCapabilities -> Bool
supportsQuantifiers :: Bool
, SolverCapabilities -> Bool
supportsUninterpretedSorts :: Bool
, SolverCapabilities -> Bool
supportsUnboundedInts :: Bool
, SolverCapabilities -> Bool
supportsReals :: Bool
, SolverCapabilities -> Bool
supportsApproxReals :: Bool
, SolverCapabilities -> Bool
supportsIEEE754 :: Bool
, SolverCapabilities -> Bool
supportsSets :: Bool
, SolverCapabilities -> Bool
supportsOptimization :: Bool
, SolverCapabilities -> Bool
supportsPseudoBooleans :: Bool
, SolverCapabilities -> Bool
supportsCustomQueries :: Bool
, SolverCapabilities -> Bool
supportsGlobalDecls :: Bool
, SolverCapabilities -> Bool
supportsDataTypes :: Bool
, SolverCapabilities -> Maybe [String]
supportsFlattenedModels :: Maybe [String]
}
data RoundingMode = RoundNearestTiesToEven
| RoundNearestTiesToAway
| RoundTowardPositive
| RoundTowardNegative
| RoundTowardZero
deriving (RoundingMode -> RoundingMode -> Bool
(RoundingMode -> RoundingMode -> Bool)
-> (RoundingMode -> RoundingMode -> Bool) -> Eq RoundingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoundingMode -> RoundingMode -> Bool
$c/= :: RoundingMode -> RoundingMode -> Bool
== :: RoundingMode -> RoundingMode -> Bool
$c== :: RoundingMode -> RoundingMode -> Bool
Eq, Eq RoundingMode
Eq RoundingMode =>
(RoundingMode -> RoundingMode -> Ordering)
-> (RoundingMode -> RoundingMode -> Bool)
-> (RoundingMode -> RoundingMode -> Bool)
-> (RoundingMode -> RoundingMode -> Bool)
-> (RoundingMode -> RoundingMode -> Bool)
-> (RoundingMode -> RoundingMode -> RoundingMode)
-> (RoundingMode -> RoundingMode -> RoundingMode)
-> Ord RoundingMode
RoundingMode -> RoundingMode -> Bool
RoundingMode -> RoundingMode -> Ordering
RoundingMode -> RoundingMode -> RoundingMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RoundingMode -> RoundingMode -> RoundingMode
$cmin :: RoundingMode -> RoundingMode -> RoundingMode
max :: RoundingMode -> RoundingMode -> RoundingMode
$cmax :: RoundingMode -> RoundingMode -> RoundingMode
>= :: RoundingMode -> RoundingMode -> Bool
$c>= :: RoundingMode -> RoundingMode -> Bool
> :: RoundingMode -> RoundingMode -> Bool
$c> :: RoundingMode -> RoundingMode -> Bool
<= :: RoundingMode -> RoundingMode -> Bool
$c<= :: RoundingMode -> RoundingMode -> Bool
< :: RoundingMode -> RoundingMode -> Bool
$c< :: RoundingMode -> RoundingMode -> Bool
compare :: RoundingMode -> RoundingMode -> Ordering
$ccompare :: RoundingMode -> RoundingMode -> Ordering
$cp1Ord :: Eq RoundingMode
Ord, Int -> RoundingMode -> ShowS
[RoundingMode] -> ShowS
RoundingMode -> String
(Int -> RoundingMode -> ShowS)
-> (RoundingMode -> String)
-> ([RoundingMode] -> ShowS)
-> Show RoundingMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoundingMode] -> ShowS
$cshowList :: [RoundingMode] -> ShowS
show :: RoundingMode -> String
$cshow :: RoundingMode -> String
showsPrec :: Int -> RoundingMode -> ShowS
$cshowsPrec :: Int -> RoundingMode -> ShowS
Show, ReadPrec [RoundingMode]
ReadPrec RoundingMode
Int -> ReadS RoundingMode
ReadS [RoundingMode]
(Int -> ReadS RoundingMode)
-> ReadS [RoundingMode]
-> ReadPrec RoundingMode
-> ReadPrec [RoundingMode]
-> Read RoundingMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RoundingMode]
$creadListPrec :: ReadPrec [RoundingMode]
readPrec :: ReadPrec RoundingMode
$creadPrec :: ReadPrec RoundingMode
readList :: ReadS [RoundingMode]
$creadList :: ReadS [RoundingMode]
readsPrec :: Int -> ReadS RoundingMode
$creadsPrec :: Int -> ReadS RoundingMode
Read, Typeable RoundingMode
DataType
Constr
Typeable RoundingMode =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoundingMode -> c RoundingMode)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoundingMode)
-> (RoundingMode -> Constr)
-> (RoundingMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoundingMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoundingMode))
-> ((forall b. Data b => b -> b) -> RoundingMode -> RoundingMode)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> RoundingMode -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RoundingMode -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode)
-> Data RoundingMode
RoundingMode -> DataType
RoundingMode -> Constr
(forall b. Data b => b -> b) -> RoundingMode -> RoundingMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoundingMode -> c RoundingMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoundingMode
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RoundingMode -> u
forall u. (forall d. Data d => d -> u) -> RoundingMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoundingMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoundingMode -> c RoundingMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoundingMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoundingMode)
$cRoundTowardZero :: Constr
$cRoundTowardNegative :: Constr
$cRoundTowardPositive :: Constr
$cRoundNearestTiesToAway :: Constr
$cRoundNearestTiesToEven :: Constr
$tRoundingMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
gmapMp :: (forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
gmapM :: (forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RoundingMode -> m RoundingMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> RoundingMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RoundingMode -> u
gmapQ :: (forall d. Data d => d -> u) -> RoundingMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RoundingMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RoundingMode -> r
gmapT :: (forall b. Data b => b -> b) -> RoundingMode -> RoundingMode
$cgmapT :: (forall b. Data b => b -> b) -> RoundingMode -> RoundingMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoundingMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RoundingMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RoundingMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RoundingMode)
dataTypeOf :: RoundingMode -> DataType
$cdataTypeOf :: RoundingMode -> DataType
toConstr :: RoundingMode -> Constr
$ctoConstr :: RoundingMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoundingMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RoundingMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoundingMode -> c RoundingMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RoundingMode -> c RoundingMode
$cp1Data :: Typeable RoundingMode
G.Data, RoundingMode
RoundingMode -> RoundingMode -> Bounded RoundingMode
forall a. a -> a -> Bounded a
maxBound :: RoundingMode
$cmaxBound :: RoundingMode
minBound :: RoundingMode
$cminBound :: RoundingMode
Bounded, Int -> RoundingMode
RoundingMode -> Int
RoundingMode -> [RoundingMode]
RoundingMode -> RoundingMode
RoundingMode -> RoundingMode -> [RoundingMode]
RoundingMode -> RoundingMode -> RoundingMode -> [RoundingMode]
(RoundingMode -> RoundingMode)
-> (RoundingMode -> RoundingMode)
-> (Int -> RoundingMode)
-> (RoundingMode -> Int)
-> (RoundingMode -> [RoundingMode])
-> (RoundingMode -> RoundingMode -> [RoundingMode])
-> (RoundingMode -> RoundingMode -> [RoundingMode])
-> (RoundingMode -> RoundingMode -> RoundingMode -> [RoundingMode])
-> Enum RoundingMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RoundingMode -> RoundingMode -> RoundingMode -> [RoundingMode]
$cenumFromThenTo :: RoundingMode -> RoundingMode -> RoundingMode -> [RoundingMode]
enumFromTo :: RoundingMode -> RoundingMode -> [RoundingMode]
$cenumFromTo :: RoundingMode -> RoundingMode -> [RoundingMode]
enumFromThen :: RoundingMode -> RoundingMode -> [RoundingMode]
$cenumFromThen :: RoundingMode -> RoundingMode -> [RoundingMode]
enumFrom :: RoundingMode -> [RoundingMode]
$cenumFrom :: RoundingMode -> [RoundingMode]
fromEnum :: RoundingMode -> Int
$cfromEnum :: RoundingMode -> Int
toEnum :: Int -> RoundingMode
$ctoEnum :: Int -> RoundingMode
pred :: RoundingMode -> RoundingMode
$cpred :: RoundingMode -> RoundingMode
succ :: RoundingMode -> RoundingMode
$csucc :: RoundingMode -> RoundingMode
Enum)
instance HasKind RoundingMode
data SMTConfig = SMTConfig {
SMTConfig -> Bool
verbose :: Bool
, SMTConfig -> Timing
timing :: Timing
, SMTConfig -> Int
printBase :: Int
, SMTConfig -> Int
printRealPrec :: Int
, SMTConfig -> String
satCmd :: String
, SMTConfig -> Maybe Int
allSatMaxModelCount :: Maybe Int
, SMTConfig -> Bool
allSatPrintAlong :: Bool
, SMTConfig -> Bool
satTrackUFs :: Bool
, SMTConfig -> String -> Bool
isNonModelVar :: String -> Bool
, SMTConfig -> Bool
validateModel :: Bool
, SMTConfig -> Bool
optimizeValidateConstraints :: Bool
, SMTConfig -> Maybe String
transcript :: Maybe FilePath
, SMTConfig -> SMTLibVersion
smtLibVersion :: SMTLibVersion
, SMTConfig -> SMTSolver
solver :: SMTSolver
, SMTConfig -> Bool
allowQuantifiedQueries :: Bool
, SMTConfig -> RoundingMode
roundingMode :: RoundingMode
, SMTConfig -> [SMTOption]
solverSetOptions :: [SMTOption]
, SMTConfig -> Bool
ignoreExitCode :: Bool
, SMTConfig -> Maybe String
redirectVerbose :: Maybe FilePath
}
validationRequested :: SMTConfig -> Bool
validationRequested :: SMTConfig -> Bool
validationRequested SMTConfig{Bool
validateModel :: Bool
validateModel :: SMTConfig -> Bool
validateModel, Bool
optimizeValidateConstraints :: Bool
optimizeValidateConstraints :: SMTConfig -> Bool
optimizeValidateConstraints} = Bool
validateModel Bool -> Bool -> Bool
|| Bool
optimizeValidateConstraints
instance NFData SMTConfig where
rnf :: SMTConfig -> ()
rnf SMTConfig{} = ()
data SMTModel = SMTModel {
SMTModel -> [(String, GeneralizedCV)]
modelObjectives :: [(String, GeneralizedCV)]
, SMTModel -> Maybe [((Quantifier, NamedSymVar), Maybe CV)]
modelBindings :: Maybe [((Quantifier, NamedSymVar), Maybe CV)]
, SMTModel -> [(String, CV)]
modelAssocs :: [(String, CV)]
, SMTModel -> [(String, (SBVType, ([([CV], CV)], CV)))]
modelUIFuns :: [(String, (SBVType, ([([CV], CV)], CV)))]
}
deriving Int -> SMTModel -> ShowS
[SMTModel] -> ShowS
SMTModel -> String
(Int -> SMTModel -> ShowS)
-> (SMTModel -> String) -> ([SMTModel] -> ShowS) -> Show SMTModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMTModel] -> ShowS
$cshowList :: [SMTModel] -> ShowS
show :: SMTModel -> String
$cshow :: SMTModel -> String
showsPrec :: Int -> SMTModel -> ShowS
$cshowsPrec :: Int -> SMTModel -> ShowS
Show
data SMTResult = Unsatisfiable SMTConfig (Maybe [String])
| Satisfiable SMTConfig SMTModel
| SatExtField SMTConfig SMTModel
| Unknown SMTConfig SMTReasonUnknown
| ProofError SMTConfig [String] (Maybe SMTResult)
data SMTScript = SMTScript {
SMTScript -> String
scriptBody :: String
, SMTScript -> [String]
scriptModel :: [String]
}
type SMTEngine = forall res.
SMTConfig
-> State
-> String
-> (State -> IO res)
-> IO res
data Solver = Z3
| Yices
| Boolector
| CVC4
| MathSAT
| ABC
deriving (Int -> Solver -> ShowS
[Solver] -> ShowS
Solver -> String
(Int -> Solver -> ShowS)
-> (Solver -> String) -> ([Solver] -> ShowS) -> Show Solver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Solver] -> ShowS
$cshowList :: [Solver] -> ShowS
show :: Solver -> String
$cshow :: Solver -> String
showsPrec :: Int -> Solver -> ShowS
$cshowsPrec :: Int -> Solver -> ShowS
Show, Int -> Solver
Solver -> Int
Solver -> [Solver]
Solver -> Solver
Solver -> Solver -> [Solver]
Solver -> Solver -> Solver -> [Solver]
(Solver -> Solver)
-> (Solver -> Solver)
-> (Int -> Solver)
-> (Solver -> Int)
-> (Solver -> [Solver])
-> (Solver -> Solver -> [Solver])
-> (Solver -> Solver -> [Solver])
-> (Solver -> Solver -> Solver -> [Solver])
-> Enum Solver
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Solver -> Solver -> Solver -> [Solver]
$cenumFromThenTo :: Solver -> Solver -> Solver -> [Solver]
enumFromTo :: Solver -> Solver -> [Solver]
$cenumFromTo :: Solver -> Solver -> [Solver]
enumFromThen :: Solver -> Solver -> [Solver]
$cenumFromThen :: Solver -> Solver -> [Solver]
enumFrom :: Solver -> [Solver]
$cenumFrom :: Solver -> [Solver]
fromEnum :: Solver -> Int
$cfromEnum :: Solver -> Int
toEnum :: Int -> Solver
$ctoEnum :: Int -> Solver
pred :: Solver -> Solver
$cpred :: Solver -> Solver
succ :: Solver -> Solver
$csucc :: Solver -> Solver
Enum, Solver
Solver -> Solver -> Bounded Solver
forall a. a -> a -> Bounded a
maxBound :: Solver
$cmaxBound :: Solver
minBound :: Solver
$cminBound :: Solver
Bounded)
data SMTSolver = SMTSolver {
SMTSolver -> Solver
name :: Solver
, SMTSolver -> String
executable :: String
, SMTSolver -> ShowS
preprocess :: String -> String
, SMTSolver -> SMTConfig -> [String]
options :: SMTConfig -> [String]
, SMTSolver
-> forall res.
SMTConfig -> State -> String -> (State -> IO res) -> IO res
engine :: SMTEngine
, SMTSolver -> SolverCapabilities
capabilities :: SolverCapabilities
}
data QueryContext = QueryInternal
| QueryExternal
instance Show QueryContext where
show :: QueryContext -> String
show QueryInternal = "Internal Query"
show QueryExternal = "User Query"
{-# ANN type FPOp ("HLint: ignore Use camelCase" :: String) #-}
{-# ANN type PBOp ("HLint: ignore Use camelCase" :: String) #-}
{-# ANN type OvOp ("HLint: ignore Use camelCase" :: String) #-}