-----------------------------------------------------------------------------
-- |
-- Module    : Data.SBV.Core.Symbolic
-- Copyright : (c) Levent Erkok
-- License   : BSD3
-- Maintainer: erkokl@gmail.com
-- Stability : experimental
--
-- Symbolic values
-----------------------------------------------------------------------------

{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-} -- for undetermined s in MonadState
{-# LANGUAGE ViewPatterns               #-}

{-# OPTIONS_GHC -Wall -Werror -fno-warn-orphans #-}

module Data.SBV.Core.Symbolic
  ( NodeId(..)
  , SV(..), swKind, trueSV, falseSV
  , Op(..), PBOp(..), OvOp(..), FPOp(..), NROp(..), StrOp(..), RegExOp(..), SeqOp(..), SetOp(..)
  , RegExp(..), regExpToSMTString
  , Quantifier(..), needsExistentials, VarContext(..)
  , 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(..), uncacheAI
  , NamedSymVar(..), Name, UserInputs, Inputs(..), getSV, swNodeId, namedNodeId, getUniversals
  , prefixExistentials, prefixUniversals, onUserInputs, onInternInputs, onAllInputs
  , addInternInput, addUserInput, getInputs, inputsFromListWith, userInputsToList
  , getUserName', internInputsToList, inputsToList, quantifier, namedSymVar, getUserName
  , lookupInput , 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, CnstMap
  , 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               ((***))
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 GHC.Generics (Generic)

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, (|>), (<|), filter, takeWhileL, fromList, lookup, elemIndexL)
import qualified Data.Text                   as T

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

-- | A symbolic node id
newtype NodeId = NodeId { NodeId -> Int
getId :: Int }
  deriving (NodeId -> NodeId -> Bool
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
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
Ord, Typeable NodeId
NodeId -> DataType
NodeId -> Constr
(forall b. Data b => b -> b) -> NodeId -> NodeId
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) -> NodeId -> u
forall u. (forall d. Data d => d -> u) -> NodeId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeId -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> NodeId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NodeId -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
gmapT :: (forall b. Data b => b -> b) -> NodeId -> NodeId
$cgmapT :: (forall b. Data b => b -> b) -> NodeId -> NodeId
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId)
dataTypeOf :: NodeId -> DataType
$cdataTypeOf :: NodeId -> DataType
toConstr :: NodeId -> Constr
$ctoConstr :: NodeId -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId
G.Data)

-- | A symbolic word, tracking it's signedness and size.
data SV = SV !Kind !NodeId
        deriving Typeable SV
SV -> DataType
SV -> Constr
(forall b. Data b => b -> b) -> SV -> SV
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) -> SV -> u
forall u. (forall d. Data d => d -> u) -> SV -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SV -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SV -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SV -> m SV
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SV -> m SV
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SV
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SV -> c SV
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SV)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SV)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SV -> m SV
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SV -> m SV
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SV -> m SV
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SV -> m SV
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SV -> m SV
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SV -> m SV
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SV -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SV -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SV -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SV -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SV -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SV -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SV -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SV -> r
gmapT :: (forall b. Data b => b -> b) -> SV -> SV
$cgmapT :: (forall b. Data b => b -> b) -> SV -> SV
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SV)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SV)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SV)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SV)
dataTypeOf :: SV -> DataType
$cdataTypeOf :: SV -> DataType
toConstr :: SV -> Constr
$ctoConstr :: SV -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SV
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SV
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SV -> c SV
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SV -> c SV
G.Data

-- | For equality, we merely use the node-id
instance Eq SV where
  SV Kind
_ NodeId
n1 == :: SV -> SV -> Bool
== SV Kind
_ NodeId
n2 = NodeId
n1 forall a. Eq a => a -> a -> Bool
== NodeId
n2

-- | Again, simply use the node-id for ordering
instance Ord SV where
  SV Kind
_ NodeId
n1 compare :: SV -> SV -> Ordering
`compare` SV Kind
_ NodeId
n2 = NodeId
n1 forall a. Ord a => a -> a -> Ordering
`compare` NodeId
n2

instance HasKind SV where
  kindOf :: SV -> Kind
kindOf (SV Kind
k NodeId
_) = Kind
k

instance Show SV where
  show :: SV -> [Char]
show (SV Kind
_ (NodeId Int
n)) = case Int
n of
                             -2 -> [Char]
"false"
                             -1 -> [Char]
"true"
                             Int
_  -> Char
's' forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char]
show Int
n

-- | Kind of a symbolic word.
swKind :: SV -> Kind
swKind :: SV -> Kind
swKind (SV Kind
k NodeId
_) = Kind
k

-- | retrieve the node id of a symbolic word
swNodeId :: SV -> NodeId
swNodeId :: SV -> NodeId
swNodeId (SV Kind
_ NodeId
nid) = NodeId
nid

-- | Forcing an argument; this is a necessary evil to make sure all the arguments
-- to an uninterpreted function are evaluated before called; the semantics of uinterpreted
-- functions is necessarily strict; deviating from Haskell's
forceSVArg :: SV -> IO ()
forceSVArg :: SV -> IO ()
forceSVArg (SV Kind
k NodeId
n) = Kind
k seq :: forall a b. a -> b -> b
`seq` NodeId
n seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Constant False as an 'SV'. Note that this value always occupies slot -2.
falseSV :: SV
falseSV :: SV
falseSV = Kind -> NodeId -> SV
SV Kind
KBool forall a b. (a -> b) -> a -> b
$ Int -> NodeId
NodeId (-Int
2)

-- | Constant True as an 'SV'. Note that this value always occupies slot -1.
trueSV :: SV
trueSV :: SV
trueSV  = Kind -> NodeId -> SV
SV Kind
KBool forall a b. (a -> b) -> a -> b
$ Int -> NodeId
NodeId (-Int
1)

-- | Symbolic operations
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
        | Extract Int Int                       -- Extract i j: extract bits i to j. Least significant bit is 0 (big-endian)
        | Join                                  -- Concat two words to form a bigger one, in the order given
        | ZeroExtend Int
        | SignExtend Int
        | LkUp (Int, Kind, Kind, Int) !SV !SV   -- (table-index, arg-type, res-type, length of the table) index out-of-bounds-value
        | ArrEq   ArrayIndex ArrayIndex         -- Array equality
        | ArrRead ArrayIndex
        | KindCast Kind Kind
        | Uninterpreted String
        | Label String                          -- Essentially no-op; useful for code generation to emit comments.
        | IEEEFP FPOp                           -- Floating-point ops, categorized separately
        | NonLinear NROp                        -- Non-linear ops (mostly trigonometric), categorized separately
        | OverflowOp    OvOp                    -- Overflow-ops, categorized separately
        | PseudoBoolean PBOp                    -- Pseudo-boolean ops, categorized separately
        | StrOp StrOp                           -- String ops, categorized separately
        | RegExOp RegExOp                       -- RegEx operations, categorized separately
        | SeqOp SeqOp                           -- Sequence ops, categorized separately
        | SetOp SetOp                           -- Set operations, categorized separately
        | TupleConstructor Int                  -- Construct an n-tuple
        | TupleAccess Int Int                   -- Access element i of an n-tuple; second argument is n
        | EitherConstructor Kind Kind Bool      -- Construct a sum; False: left, True: right
        | EitherIs Kind Kind Bool               -- Either branch tester; False: left, True: right
        | EitherAccess Bool                     -- Either branch access; False: left, True: right
        | RationalConstructor                   -- Construct a rational. Note that there's no access to numerator or denumerator, since we cannot store rationals in canonical form
        | MaybeConstructor Kind Bool            -- Construct a maybe value; False: Nothing, True: Just
        | MaybeIs Kind Bool                     -- Maybe tester; False: nothing, True: just
        | MaybeAccess                           -- Maybe branch access; grab the contents of the just
        deriving (Op -> Op -> Bool
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
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
Ord, Typeable Op
Op -> DataType
Op -> Constr
(forall b. Data b => b -> b) -> Op -> Op
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) -> Op -> u
forall u. (forall d. Data d => d -> u) -> Op -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapT :: (forall b. Data b => b -> b) -> Op -> Op
$cgmapT :: (forall b. Data b => b -> b) -> Op -> Op
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
dataTypeOf :: Op -> DataType
$cdataTypeOf :: Op -> DataType
toConstr :: Op -> Constr
$ctoConstr :: Op -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
G.Data)

-- | Floating point operations
data FPOp = FP_Cast        Kind Kind SV   -- From-Kind, To-Kind, RoundingMode. This is "value" conversion
          | FP_Reinterpret Kind Kind      -- From-Kind, To-Kind. This is bit-reinterpretation using IEEE-754 interchange format
          | 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
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
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
Ord, Typeable FPOp
FPOp -> DataType
FPOp -> Constr
(forall b. Data b => b -> b) -> FPOp -> FPOp
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) -> FPOp -> u
forall u. (forall d. Data d => d -> u) -> FPOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FPOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FPOp -> c FPOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FPOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FPOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FPOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FPOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FPOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FPOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
gmapT :: (forall b. Data b => b -> b) -> FPOp -> FPOp
$cgmapT :: (forall b. Data b => b -> b) -> FPOp -> FPOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FPOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FPOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FPOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FPOp)
dataTypeOf :: FPOp -> DataType
$cdataTypeOf :: FPOp -> DataType
toConstr :: FPOp -> Constr
$ctoConstr :: FPOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FPOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FPOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FPOp -> c FPOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FPOp -> c FPOp
G.Data)

-- Note that the show instance maps to the SMTLib names. We need to make sure
-- this mapping stays correct through SMTLib changes. The only exception
-- is FP_Cast; where we handle different source/origins explicitly later on.
instance Show FPOp where
   show :: FPOp -> [Char]
show (FP_Cast Kind
f Kind
t SV
r)      = [Char]
"(FP_Cast: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
f forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
t forall a. [a] -> [a] -> [a]
++ [Char]
", using RM [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
r forall a. [a] -> [a] -> [a]
++ [Char]
"])"
   show (FP_Reinterpret Kind
f Kind
t) = case Kind
t of
                                  Kind
KFloat    -> [Char]
"(_ to_fp 8 24)"
                                  Kind
KDouble   -> [Char]
"(_ to_fp 11 53)"
                                  KFP Int
eb Int
sb -> [Char]
"(_ to_fp " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
eb forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
sb forall a. [a] -> [a] -> [a]
++ [Char]
")"
                                  Kind
_         -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.FP_Reinterpret: Unexpected conversion: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
f forall a. [a] -> [a] -> [a]
++ [Char]
" to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
t
   show FPOp
FP_Abs               = [Char]
"fp.abs"
   show FPOp
FP_Neg               = [Char]
"fp.neg"
   show FPOp
FP_Add               = [Char]
"fp.add"
   show FPOp
FP_Sub               = [Char]
"fp.sub"
   show FPOp
FP_Mul               = [Char]
"fp.mul"
   show FPOp
FP_Div               = [Char]
"fp.div"
   show FPOp
FP_FMA               = [Char]
"fp.fma"
   show FPOp
FP_Sqrt              = [Char]
"fp.sqrt"
   show FPOp
FP_Rem               = [Char]
"fp.rem"
   show FPOp
FP_RoundToIntegral   = [Char]
"fp.roundToIntegral"
   show FPOp
FP_Min               = [Char]
"fp.min"
   show FPOp
FP_Max               = [Char]
"fp.max"
   show FPOp
FP_ObjEqual          = [Char]
"="
   show FPOp
FP_IsNormal          = [Char]
"fp.isNormal"
   show FPOp
FP_IsSubnormal       = [Char]
"fp.isSubnormal"
   show FPOp
FP_IsZero            = [Char]
"fp.isZero"
   show FPOp
FP_IsInfinite        = [Char]
"fp.isInfinite"
   show FPOp
FP_IsNaN             = [Char]
"fp.isNaN"
   show FPOp
FP_IsNegative        = [Char]
"fp.isNegative"
   show FPOp
FP_IsPositive        = [Char]
"fp.isPositive"

-- | Non-linear operations
data NROp = NR_Sin
          | NR_Cos
          | NR_Tan
          | NR_ASin
          | NR_ACos
          | NR_ATan
          | NR_Sqrt
          | NR_Sinh
          | NR_Cosh
          | NR_Tanh
          | NR_Exp
          | NR_Log
          | NR_Pow
          deriving (NROp -> NROp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NROp -> NROp -> Bool
$c/= :: NROp -> NROp -> Bool
== :: NROp -> NROp -> Bool
$c== :: NROp -> NROp -> Bool
Eq, Eq NROp
NROp -> NROp -> Bool
NROp -> NROp -> Ordering
NROp -> NROp -> NROp
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 :: NROp -> NROp -> NROp
$cmin :: NROp -> NROp -> NROp
max :: NROp -> NROp -> NROp
$cmax :: NROp -> NROp -> NROp
>= :: NROp -> NROp -> Bool
$c>= :: NROp -> NROp -> Bool
> :: NROp -> NROp -> Bool
$c> :: NROp -> NROp -> Bool
<= :: NROp -> NROp -> Bool
$c<= :: NROp -> NROp -> Bool
< :: NROp -> NROp -> Bool
$c< :: NROp -> NROp -> Bool
compare :: NROp -> NROp -> Ordering
$ccompare :: NROp -> NROp -> Ordering
Ord, Typeable NROp
NROp -> DataType
NROp -> Constr
(forall b. Data b => b -> b) -> NROp -> NROp
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) -> NROp -> u
forall u. (forall d. Data d => d -> u) -> NROp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NROp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NROp -> c NROp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NROp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NROp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NROp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NROp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> NROp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NROp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
gmapT :: (forall b. Data b => b -> b) -> NROp -> NROp
$cgmapT :: (forall b. Data b => b -> b) -> NROp -> NROp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NROp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NROp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NROp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NROp)
dataTypeOf :: NROp -> DataType
$cdataTypeOf :: NROp -> DataType
toConstr :: NROp -> Constr
$ctoConstr :: NROp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NROp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NROp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NROp -> c NROp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NROp -> c NROp
G.Data)

-- | The show instance carefully arranges for these to be printed as it can be understood by dreal
instance Show NROp where
  show :: NROp -> [Char]
show NROp
NR_Sin  = [Char]
"sin"
  show NROp
NR_Cos  = [Char]
"cos"
  show NROp
NR_Tan  = [Char]
"tan"
  show NROp
NR_ASin = [Char]
"asin"
  show NROp
NR_ACos = [Char]
"acos"
  show NROp
NR_ATan = [Char]
"atan"
  show NROp
NR_Sinh = [Char]
"sinh"
  show NROp
NR_Cosh = [Char]
"cosh"
  show NROp
NR_Tanh = [Char]
"tanh"
  show NROp
NR_Sqrt = [Char]
"sqrt"
  show NROp
NR_Exp  = [Char]
"exp"
  show NROp
NR_Log  = [Char]
"log"
  show NROp
NR_Pow  = [Char]
"pow"

-- | Pseudo-boolean operations
data PBOp = PB_AtMost  Int        -- ^ At most k
          | PB_AtLeast Int        -- ^ At least k
          | PB_Exactly Int        -- ^ Exactly k
          | PB_Le      [Int] Int  -- ^ At most k,  with coefficients given. Generalizes PB_AtMost
          | PB_Ge      [Int] Int  -- ^ At least k, with coefficients given. Generalizes PB_AtLeast
          | PB_Eq      [Int] Int  -- ^ Exactly k,  with coefficients given. Generalized PB_Exactly
          deriving (PBOp -> PBOp -> Bool
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
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
Ord, Int -> PBOp -> ShowS
[PBOp] -> ShowS
PBOp -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PBOp] -> ShowS
$cshowList :: [PBOp] -> ShowS
show :: PBOp -> [Char]
$cshow :: PBOp -> [Char]
showsPrec :: Int -> PBOp -> ShowS
$cshowsPrec :: Int -> PBOp -> ShowS
Show, Typeable PBOp
PBOp -> DataType
PBOp -> Constr
(forall b. Data b => b -> b) -> PBOp -> PBOp
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) -> PBOp -> u
forall u. (forall d. Data d => d -> u) -> PBOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PBOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PBOp -> c PBOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PBOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PBOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PBOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PBOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PBOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PBOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
gmapT :: (forall b. Data b => b -> b) -> PBOp -> PBOp
$cgmapT :: (forall b. Data b => b -> b) -> PBOp -> PBOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PBOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PBOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PBOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PBOp)
dataTypeOf :: PBOp -> DataType
$cdataTypeOf :: PBOp -> DataType
toConstr :: PBOp -> Constr
$ctoConstr :: PBOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PBOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PBOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PBOp -> c PBOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PBOp -> c PBOp
G.Data)

-- | Overflow operations
data OvOp = Overflow_SMul_OVFL   -- ^ Signed multiplication overflow
          | Overflow_SMul_UDFL   -- ^ Signed multiplication underflow
          | Overflow_UMul_OVFL   -- ^ Unsigned multiplication overflow
          deriving (OvOp -> OvOp -> Bool
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
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
Ord, Typeable OvOp
OvOp -> DataType
OvOp -> Constr
(forall b. Data b => b -> b) -> OvOp -> OvOp
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) -> OvOp -> u
forall u. (forall d. Data d => d -> u) -> OvOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OvOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OvOp -> c OvOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OvOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OvOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OvOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OvOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OvOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OvOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
gmapT :: (forall b. Data b => b -> b) -> OvOp -> OvOp
$cgmapT :: (forall b. Data b => b -> b) -> OvOp -> OvOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OvOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OvOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OvOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OvOp)
dataTypeOf :: OvOp -> DataType
$cdataTypeOf :: OvOp -> DataType
toConstr :: OvOp -> Constr
$ctoConstr :: OvOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OvOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OvOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OvOp -> c OvOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OvOp -> c OvOp
G.Data)

-- | Show instance. It's important that these follow the internal z3 names
instance Show OvOp where
  show :: OvOp -> [Char]
show OvOp
Overflow_SMul_OVFL = [Char]
"bvsmul_noovfl"
  show OvOp
Overflow_SMul_UDFL = [Char]
"bvsmul_noudfl"
  show OvOp
Overflow_UMul_OVFL = [Char]
"bvumul_noovfl"

-- | String operations. Note that we do not define @StrAt@ as it translates to 'StrSubstr' trivially.
data StrOp = StrConcat       -- ^ Concatenation of one or more strings
           | StrLen          -- ^ String length
           | StrUnit         -- ^ Unit string
           | StrNth          -- ^ Nth element
           | StrSubstr       -- ^ Retrieves substring of @s@ at @offset@
           | StrIndexOf      -- ^ Retrieves first position of @sub@ in @s@, @-1@ if there are no occurrences
           | StrContains     -- ^ Does @s@ contain the substring @sub@?
           | StrPrefixOf     -- ^ Is @pre@ a prefix of @s@?
           | StrSuffixOf     -- ^ Is @suf@ a suffix of @s@?
           | StrReplace      -- ^ Replace the first occurrence of @src@ by @dst@ in @s@
           | StrStrToNat     -- ^ Retrieve integer encoded by string @s@ (ground rewriting only)
           | StrNatToStr     -- ^ Retrieve string encoded by integer @i@ (ground rewriting only)
           | StrToCode       -- ^ Equivalent to Haskell's ord
           | StrFromCode     -- ^ Equivalent to Haskell's chr
           | StrInRe RegExp  -- ^ Check if string is in the regular expression
           deriving (StrOp -> StrOp -> Bool
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
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
Ord, Typeable StrOp
StrOp -> DataType
StrOp -> Constr
(forall b. Data b => b -> b) -> StrOp -> StrOp
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) -> StrOp -> u
forall u. (forall d. Data d => d -> u) -> StrOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StrOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StrOp -> c StrOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StrOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StrOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StrOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StrOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> StrOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StrOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
gmapT :: (forall b. Data b => b -> b) -> StrOp -> StrOp
$cgmapT :: (forall b. Data b => b -> b) -> StrOp -> StrOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StrOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StrOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StrOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StrOp)
dataTypeOf :: StrOp -> DataType
$cdataTypeOf :: StrOp -> DataType
toConstr :: StrOp -> Constr
$ctoConstr :: StrOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StrOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StrOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StrOp -> c StrOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StrOp -> c StrOp
G.Data)

-- | Regular-expression operators. The only thing we can do is to compare for equality/disequality.
data RegExOp = RegExEq  RegExp RegExp
             | RegExNEq RegExp RegExp
             deriving (RegExOp -> RegExOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegExOp -> RegExOp -> Bool
$c/= :: RegExOp -> RegExOp -> Bool
== :: RegExOp -> RegExOp -> Bool
$c== :: RegExOp -> RegExOp -> Bool
Eq, Eq RegExOp
RegExOp -> RegExOp -> Bool
RegExOp -> RegExOp -> Ordering
RegExOp -> RegExOp -> RegExOp
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 :: RegExOp -> RegExOp -> RegExOp
$cmin :: RegExOp -> RegExOp -> RegExOp
max :: RegExOp -> RegExOp -> RegExOp
$cmax :: RegExOp -> RegExOp -> RegExOp
>= :: RegExOp -> RegExOp -> Bool
$c>= :: RegExOp -> RegExOp -> Bool
> :: RegExOp -> RegExOp -> Bool
$c> :: RegExOp -> RegExOp -> Bool
<= :: RegExOp -> RegExOp -> Bool
$c<= :: RegExOp -> RegExOp -> Bool
< :: RegExOp -> RegExOp -> Bool
$c< :: RegExOp -> RegExOp -> Bool
compare :: RegExOp -> RegExOp -> Ordering
$ccompare :: RegExOp -> RegExOp -> Ordering
Ord, Typeable RegExOp
RegExOp -> DataType
RegExOp -> Constr
(forall b. Data b => b -> b) -> RegExOp -> RegExOp
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) -> RegExOp -> u
forall u. (forall d. Data d => d -> u) -> RegExOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExOp -> c RegExOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RegExOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RegExOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
gmapT :: (forall b. Data b => b -> b) -> RegExOp -> RegExOp
$cgmapT :: (forall b. Data b => b -> b) -> RegExOp -> RegExOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExOp)
dataTypeOf :: RegExOp -> DataType
$cdataTypeOf :: RegExOp -> DataType
toConstr :: RegExOp -> Constr
$ctoConstr :: RegExOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExOp -> c RegExOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExOp -> c RegExOp
G.Data)

-- | Regular expressions. Note that regular expressions themselves are
-- concrete, but the 'Data.SBV.RegExp.match' function from the 'Data.SBV.RegExp.RegExpMatchable' class
-- can check membership against a symbolic string/character. Also, we
-- are preferring a datatype approach here, as opposed to coming up with
-- some string-representation; there are way too many alternatives
-- already so inventing one isn't a priority. Please get in touch if you
-- would like a parser for this type as it might be easier to use.
data RegExp = Literal String       -- ^ Precisely match the given string
            | All                  -- ^ Accept every string
            | AllChar              -- ^ Accept every single character
            | None                 -- ^ Accept no strings
            | Range Char Char      -- ^ Accept range of characters
            | Conc  [RegExp]       -- ^ Concatenation
            | KStar RegExp         -- ^ Kleene Star: Zero or more
            | KPlus RegExp         -- ^ Kleene Plus: One or more
            | Opt   RegExp         -- ^ Zero or one
            | Comp  RegExp         -- ^ Complement of regular expression
            | Diff  RegExp RegExp  -- ^ Difference of regular expressions
            | Loop  Int Int RegExp -- ^ From @n@ repetitions to @m@ repetitions
            | Power Int     RegExp -- ^ Exactly @n@ repetitions, i.e., nth power
            | Union [RegExp]       -- ^ Union of regular expressions
            | Inter RegExp RegExp  -- ^ Intersection of regular expressions
            deriving (RegExp -> RegExp -> Bool
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
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
Ord, Typeable RegExp
RegExp -> DataType
RegExp -> Constr
(forall b. Data b => b -> b) -> RegExp -> RegExp
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) -> RegExp -> u
forall u. (forall d. Data d => d -> u) -> RegExp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExp -> c RegExp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RegExp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RegExp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
gmapT :: (forall b. Data b => b -> b) -> RegExp -> RegExp
$cgmapT :: (forall b. Data b => b -> b) -> RegExp -> RegExp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExp)
dataTypeOf :: RegExp -> DataType
$cdataTypeOf :: RegExp -> DataType
toConstr :: RegExp -> Constr
$ctoConstr :: RegExp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExp -> c RegExp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExp -> c RegExp
G.Data)

-- | With overloaded strings, we can have direct literal regular expressions.
instance IsString RegExp where
  fromString :: [Char] -> RegExp
fromString = [Char] -> RegExp
Literal

-- | Regular expressions as a 'Num' instance. Note that only some operations make sense and
-- not in the most obvious way. For instance, we would typically expect @a - b@ to be the
-- same as @a + negate b@, but that equality does not hold in general. So, use the @Num@
-- instance only as constructing syntax, not doing algebraic manipulations.
instance Num RegExp where
  -- flatten the concats to make them simpler
  Conc [RegExp]
xs * :: RegExp -> RegExp -> RegExp
* RegExp
y = [RegExp] -> RegExp
Conc ([RegExp]
xs forall a. [a] -> [a] -> [a]
++ [RegExp
y])
  RegExp
x * Conc [RegExp]
ys = [RegExp] -> RegExp
Conc (RegExp
x  forall a. a -> [a] -> [a]
:  [RegExp]
ys)
  RegExp
x * RegExp
y       = [RegExp] -> RegExp
Conc [RegExp
x, RegExp
y]

  -- flatten the unions to make them simpler
  Union [RegExp]
xs + :: RegExp -> RegExp -> RegExp
+ RegExp
y = [RegExp] -> RegExp
Union ([RegExp]
xs forall a. [a] -> [a] -> [a]
++ [RegExp
y])
  RegExp
x + Union [RegExp]
ys = [RegExp] -> RegExp
Union (RegExp
x  forall a. a -> [a] -> [a]
: [RegExp]
ys)
  RegExp
x + RegExp
y        = [RegExp] -> RegExp
Union [RegExp
x, RegExp
y]

  RegExp
x - :: RegExp -> RegExp -> RegExp
- RegExp
y = RegExp -> RegExp -> RegExp
Diff RegExp
x RegExp
y

  abs :: RegExp -> RegExp
abs         = forall a. HasCallStack => [Char] -> a
error [Char]
"Num.RegExp: no abs method"
  signum :: RegExp -> RegExp
signum      = forall a. HasCallStack => [Char] -> a
error [Char]
"Num.RegExp: no signum method"

  fromInteger :: Integer -> RegExp
fromInteger Integer
x
    | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
0    = RegExp
None
    | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
1    = [Char] -> RegExp
Literal [Char]
""   -- Unit for concatenation is the empty string
    | Bool
True      = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Num.RegExp: Only 0 and 1 makes sense as a reg-exp, no meaning for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
x

  negate :: RegExp -> RegExp
negate = RegExp -> RegExp
Comp

-- | Convert a reg-exp to a Haskell-like string
instance Show RegExp where
  show :: RegExp -> [Char]
show = ShowS -> RegExp -> [Char]
regExpToString forall a. Show a => a -> [Char]
show

-- | Convert a reg-exp to a SMT-lib acceptable representation
regExpToSMTString :: RegExp -> String
regExpToSMTString :: RegExp -> [Char]
regExpToSMTString = ShowS -> RegExp -> [Char]
regExpToString (\[Char]
s -> Char
'"' forall a. a -> [a] -> [a]
: ShowS
stringToQFS [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"\"")

-- | Convert a RegExp to a string, parameterized by how strings are converted
regExpToString :: (String -> String) -> RegExp -> String
regExpToString :: ShowS -> RegExp -> [Char]
regExpToString ShowS
fs (Literal [Char]
s)       = [Char]
"(str.to.re " forall a. [a] -> [a] -> [a]
++ ShowS
fs [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
_  RegExp
All               = [Char]
"re.all"
regExpToString ShowS
_  RegExp
AllChar           = [Char]
"re.allchar"
regExpToString ShowS
_  RegExp
None              = [Char]
"re.nostr"
regExpToString ShowS
fs (Range Char
ch1 Char
ch2)   = [Char]
"(re.range " forall a. [a] -> [a] -> [a]
++ ShowS
fs [Char
ch1] forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ ShowS
fs [Char
ch2] forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
_  (Conc [])         = forall a. Show a => a -> [Char]
show (Integer
1 :: Integer)
regExpToString ShowS
fs (Conc [RegExp
x])        = ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
x
regExpToString ShowS
fs (Conc [RegExp]
xs)         = [Char]
"(re.++ " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> RegExp -> [Char]
regExpToString ShowS
fs) [RegExp]
xs) forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (KStar RegExp
r)         = [Char]
"(re.* " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (KPlus RegExp
r)         = [Char]
"(re.+ " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Opt   RegExp
r)         = [Char]
"(re.opt " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Comp  RegExp
r)         = [Char]
"(re.comp " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Diff  RegExp
r1 RegExp
r2)     = [Char]
"(re.diff " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r2 forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Loop  Int
lo Int
hi RegExp
r)
   | Int
lo forall a. Ord a => a -> a -> Bool
>= Int
0, Int
hi forall a. Ord a => a -> a -> Bool
>= Int
lo = [Char]
"((_ re.loop " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
lo forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
hi forall a. [a] -> [a] -> [a]
++ [Char]
") " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r forall a. [a] -> [a] -> [a]
++ [Char]
")"
   | Bool
True              = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid regular-expression Loop with arguments: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
lo, Int
hi)
regExpToString ShowS
fs (Power Int
n RegExp
r)
   | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0            = ShowS -> RegExp -> [Char]
regExpToString ShowS
fs (Int -> Int -> RegExp -> RegExp
Loop Int
n Int
n RegExp
r)
   | Bool
True              = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid regular-expression Power with arguments: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
regExpToString ShowS
fs (Inter RegExp
r1 RegExp
r2)     = [Char]
"(re.inter " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r2 forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
_  (Union [])        = [Char]
"re.nostr"
regExpToString ShowS
fs (Union [RegExp
x])       = ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
x
regExpToString ShowS
fs (Union [RegExp]
xs)        = [Char]
"(re.union " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> RegExp -> [Char]
regExpToString ShowS
fs) [RegExp]
xs) forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | Show instance for @StrOp@. Note that the mapping here is important to match the SMTLib equivalents.
instance Show StrOp where
  show :: StrOp -> [Char]
show StrOp
StrConcat   = [Char]
"str.++"
  show StrOp
StrLen      = [Char]
"str.len"
  show StrOp
StrUnit     = [Char]
"str.unit"      -- NB. This is actually a no-op, since in SMTLib characters are the same as strings.
  show StrOp
StrNth      = [Char]
"str.at"
  show StrOp
StrSubstr   = [Char]
"str.substr"
  show StrOp
StrIndexOf  = [Char]
"str.indexof"
  show StrOp
StrContains = [Char]
"str.contains"
  show StrOp
StrPrefixOf = [Char]
"str.prefixof"
  show StrOp
StrSuffixOf = [Char]
"str.suffixof"
  show StrOp
StrReplace  = [Char]
"str.replace"
  show StrOp
StrStrToNat = [Char]
"str.to.int"    -- NB. SMTLib uses "int" here though only nats are supported
  show StrOp
StrNatToStr = [Char]
"int.to.str"    -- NB. SMTLib uses "int" here though only nats are supported
  show StrOp
StrToCode   = [Char]
"str.to_code"
  show StrOp
StrFromCode = [Char]
"str.from_code"
  -- Note the breakage here with respect to argument order. We fix this explicitly later.
  show (StrInRe RegExp
s) = [Char]
"str.in.re " forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
s

-- | Show instance for @RegExOp@.
instance Show RegExOp where
  show :: RegExOp -> [Char]
show (RegExEq  RegExp
r1 RegExp
r2) = [Char]
"(= "        forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r2 forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (RegExNEq RegExp
r1 RegExp
r2) = [Char]
"(distinct " forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r2 forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | Sequence operations.
data SeqOp = SeqConcat        -- ^ See StrConcat
           | SeqLen           -- ^ See StrLen
           | SeqUnit          -- ^ See StrUnit
           | SeqNth           -- ^ See StrNth
           | SeqSubseq        -- ^ See StrSubseq
           | SeqIndexOf       -- ^ See StrIndexOf
           | SeqContains      -- ^ See StrContains
           | SeqPrefixOf      -- ^ See StrPrefixOf
           | SeqSuffixOf      -- ^ See StrSuffixOf
           | SeqReplace       -- ^ See StrReplace
           | SBVReverse Kind  -- ^ Reversal of sequences. NB. Also works for strings; hence the name.
  deriving (SeqOp -> SeqOp -> Bool
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
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
Ord, Typeable SeqOp
SeqOp -> DataType
SeqOp -> Constr
(forall b. Data b => b -> b) -> SeqOp -> SeqOp
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) -> SeqOp -> u
forall u. (forall d. Data d => d -> u) -> SeqOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SeqOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SeqOp -> c SeqOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SeqOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SeqOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SeqOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SeqOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SeqOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SeqOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
gmapT :: (forall b. Data b => b -> b) -> SeqOp -> SeqOp
$cgmapT :: (forall b. Data b => b -> b) -> SeqOp -> SeqOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SeqOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SeqOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SeqOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SeqOp)
dataTypeOf :: SeqOp -> DataType
$cdataTypeOf :: SeqOp -> DataType
toConstr :: SeqOp -> Constr
$ctoConstr :: SeqOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SeqOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SeqOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SeqOp -> c SeqOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SeqOp -> c SeqOp
G.Data)

-- | Show instance for SeqOp. Again, mapping is important.
instance Show SeqOp where
  show :: SeqOp -> [Char]
show SeqOp
SeqConcat   = [Char]
"seq.++"
  show SeqOp
SeqLen      = [Char]
"seq.len"
  show SeqOp
SeqUnit     = [Char]
"seq.unit"
  show SeqOp
SeqNth      = [Char]
"seq.nth"
  show SeqOp
SeqSubseq   = [Char]
"seq.extract"
  show SeqOp
SeqIndexOf  = [Char]
"seq.indexof"
  show SeqOp
SeqContains = [Char]
"seq.contains"
  show SeqOp
SeqPrefixOf = [Char]
"seq.prefixof"
  show SeqOp
SeqSuffixOf = [Char]
"seq.suffixof"
  show SeqOp
SeqReplace  = [Char]
"seq.replace"
  -- Note: This isn't part of SMTLib, we explicitly handle it
  show (SBVReverse Kind
k) = [Char]
"sbv.reverse[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k forall a. [a] -> [a] -> [a]
++ [Char]
"]"

-- | Set operations.
data SetOp = SetEqual
           | SetMember
           | SetInsert
           | SetDelete
           | SetIntersect
           | SetUnion
           | SetSubset
           | SetDifference
           | SetComplement
           | SetHasSize
        deriving (SetOp -> SetOp -> Bool
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
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
Ord, Typeable SetOp
SetOp -> DataType
SetOp -> Constr
(forall b. Data b => b -> b) -> SetOp -> SetOp
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) -> SetOp -> u
forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
gmapT :: (forall b. Data b => b -> b) -> SetOp -> SetOp
$cgmapT :: (forall b. Data b => b -> b) -> SetOp -> SetOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
dataTypeOf :: SetOp -> DataType
$cdataTypeOf :: SetOp -> DataType
toConstr :: SetOp -> Constr
$ctoConstr :: SetOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
G.Data)

-- The show instance for 'SetOp' is merely for debugging, we map them separately so
-- the mapped strings are less important here.
instance Show SetOp where
  show :: SetOp -> [Char]
show SetOp
SetEqual      = [Char]
"=="
  show SetOp
SetMember     = [Char]
"Set.member"
  show SetOp
SetInsert     = [Char]
"Set.insert"
  show SetOp
SetDelete     = [Char]
"Set.delete"
  show SetOp
SetIntersect  = [Char]
"Set.intersect"
  show SetOp
SetUnion      = [Char]
"Set.union"
  show SetOp
SetSubset     = [Char]
"Set.subset"
  show SetOp
SetDifference = [Char]
"Set.difference"
  show SetOp
SetComplement = [Char]
"Set.complement"
  show SetOp
SetHasSize    = [Char]
"Set.setHasSize"

-- Show instance for 'Op'. Note that this is largely for debugging purposes, not used
-- for being read by any tool.
instance Show Op where
  show :: Op -> [Char]
show Op
Shl    = [Char]
"<<"
  show Op
Shr    = [Char]
">>"

  show (Rol Int
i) = [Char]
"<<<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i
  show (Ror Int
i) = [Char]
">>>" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i

  show (Extract Int
i Int
j) = [Char]
"choose [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
j forall a. [a] -> [a] -> [a]
++ [Char]
"]"

  show (LkUp (Int
ti, Kind
at, Kind
rt, Int
l) SV
i SV
e)
        = [Char]
"lookup(" forall a. [a] -> [a] -> [a]
++ [Char]
tinfo forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
i forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
e forall a. [a] -> [a] -> [a]
++ [Char]
")"
        where tinfo :: [Char]
tinfo = [Char]
"table" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
ti forall a. [a] -> [a] -> [a]
++ [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
at forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
rt forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
l forall a. [a] -> [a] -> [a]
++ [Char]
")"

  show (ArrEq ArrayIndex
i ArrayIndex
j)          = [Char]
"array_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ArrayIndex
i forall a. [a] -> [a] -> [a]
++ [Char]
" == array_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ArrayIndex
j
  show (ArrRead ArrayIndex
i)          = [Char]
"select array_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ArrayIndex
i

  show (KindCast Kind
fr Kind
to)     = [Char]
"cast_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
fr forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
to
  show (Uninterpreted [Char]
i)    = [Char]
"[uninterpreted] " forall a. [a] -> [a] -> [a]
++ [Char]
i

  show (Label [Char]
s)            = [Char]
"[label] " forall a. [a] -> [a] -> [a]
++ [Char]
s

  show (IEEEFP FPOp
w)           = forall a. Show a => a -> [Char]
show FPOp
w

  show (NonLinear NROp
w)        = forall a. Show a => a -> [Char]
show NROp
w

  show (PseudoBoolean PBOp
p)    = forall a. Show a => a -> [Char]
show PBOp
p

  show (OverflowOp OvOp
o)       = forall a. Show a => a -> [Char]
show OvOp
o

  show (StrOp StrOp
s)            = forall a. Show a => a -> [Char]
show StrOp
s
  show (RegExOp RegExOp
s)          = forall a. Show a => a -> [Char]
show RegExOp
s
  show (SeqOp SeqOp
s)            = forall a. Show a => a -> [Char]
show SeqOp
s
  show (SetOp SetOp
s)            = forall a. Show a => a -> [Char]
show SetOp
s

  show (TupleConstructor   Int
0) = [Char]
"mkSBVTuple0"
  show (TupleConstructor   Int
n) = [Char]
"mkSBVTuple" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
  show (TupleAccess      Int
i Int
n) = [Char]
"proj_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
"_SBVTuple" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n

  -- Remember, while we try to maintain SMTLib compabitibility here, these output
  -- is merely for debugging purposes. For how we actually render these in SMTLib,
  -- look at the file SBV/SMT/SMTLib2.hs for these constructors.
  show (EitherConstructor Kind
k1 Kind
k2  Bool
False) = [Char]
"(_ left_SBVEither "  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (EitherConstructor Kind
k1 Kind
k2  Bool
True ) = [Char]
"(_ right_SBVEither " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (EitherIs          Kind
k1 Kind
k2  Bool
False) = [Char]
"(_ is (left_SBVEither ("  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k1 forall a. [a] -> [a] -> [a]
++ [Char]
") " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show (EitherIs          Kind
k1 Kind
k2  Bool
True ) = [Char]
"(_ is (right_SBVEither (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k2 forall a. [a] -> [a] -> [a]
++ [Char]
") " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show (EitherAccess             Bool
False) = [Char]
"get_left_SBVEither"
  show (EitherAccess             Bool
True ) = [Char]
"get_right_SBVEither"
  show Op
RationalConstructor              = [Char]
"SBV.Rational"
  show (MaybeConstructor Kind
k Bool
False)       = [Char]
"(_ nothing_SBVMaybe " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (MaybeConstructor Kind
k Bool
True)        = [Char]
"(_ just_SBVMaybe "    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (MaybeIs          Kind
k Bool
False)       = [Char]
"(_ is (nothing_SBVMaybe () "              forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show (MaybeIs          Kind
k Bool
True )       = [Char]
"(_ is (just_SBVMaybe (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k forall a. [a] -> [a] -> [a]
++ [Char]
") " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show Op
MaybeAccess                      = [Char]
"get_just_SBVMaybe"

  show Op
op
    | Just [Char]
s <- Op
op forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Op, [Char])]
syms = [Char]
s
    | Bool
True                       = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible happened; can't find op!"
    where syms :: [(Op, [Char])]
syms = [ (Op
Plus, [Char]
"+"), (Op
Times, [Char]
"*"), (Op
Minus, [Char]
"-"), (Op
UNeg, [Char]
"-"), (Op
Abs, [Char]
"abs")
                 , (Op
Quot, [Char]
"quot")
                 , (Op
Rem,  [Char]
"rem")
                 , (Op
Equal, [Char]
"=="), (Op
NotEqual, [Char]
"/=")
                 , (Op
LessThan, [Char]
"<"), (Op
GreaterThan, [Char]
">"), (Op
LessEq, [Char]
"<="), (Op
GreaterEq, [Char]
">=")
                 , (Op
Ite, [Char]
"if_then_else")
                 , (Op
And, [Char]
"&"), (Op
Or, [Char]
"|"), (Op
XOr, [Char]
"^"), (Op
Not, [Char]
"~")
                 , (Op
Join, [Char]
"#")
                 ]

-- | Quantifiers: forall or exists. Note that we allow arbitrary nestings.
data Quantifier = ALL | EX deriving Quantifier -> Quantifier -> Bool
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

-- | Show instance for 'Quantifier'
instance Show Quantifier where
  show :: Quantifier -> [Char]
show Quantifier
ALL = [Char]
"Forall"
  show Quantifier
EX  = [Char]
"Exists"

-- | Which context is this variable being created?
data VarContext = NonQueryVar (Maybe Quantifier)  -- in this case, it can be quantified
                | QueryVar                        -- in this case, it is always existential

-- | Are there any existential quantifiers?
needsExistentials :: [Quantifier] -> Bool
needsExistentials :: [Quantifier] -> Bool
needsExistentials = (Quantifier
EX forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)

-- | A simple type for SBV computations, used mainly for uninterpreted constants.
-- We keep track of the signedness/size of the arguments. A non-function will
-- have just one entry in the list.
newtype SBVType = SBVType [Kind]
             deriving (SBVType -> SBVType -> Bool
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
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
Ord)

instance Show SBVType where
  show :: SBVType -> [Char]
show (SBVType []) = forall a. HasCallStack => [Char] -> a
error [Char]
"SBV: internal error, empty SBVType"
  show (SBVType [Kind]
xs) = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" -> " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Kind]
xs

-- | A symbolic expression
data SBVExpr = SBVApp !Op ![SV]
             deriving (SBVExpr -> SBVExpr -> Bool
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
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
Ord, Typeable SBVExpr
SBVExpr -> DataType
SBVExpr -> Constr
(forall b. Data b => b -> b) -> SBVExpr -> SBVExpr
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) -> SBVExpr -> u
forall u. (forall d. Data d => d -> u) -> SBVExpr -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVExpr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVExpr -> c SBVExpr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVExpr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVExpr)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVExpr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVExpr -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SBVExpr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SBVExpr -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
gmapT :: (forall b. Data b => b -> b) -> SBVExpr -> SBVExpr
$cgmapT :: (forall b. Data b => b -> b) -> SBVExpr -> SBVExpr
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVExpr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVExpr)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVExpr)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVExpr)
dataTypeOf :: SBVExpr -> DataType
$cdataTypeOf :: SBVExpr -> DataType
toConstr :: SBVExpr -> Constr
$ctoConstr :: SBVExpr -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVExpr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVExpr
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVExpr -> c SBVExpr
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVExpr -> c SBVExpr
G.Data)

-- | To improve hash-consing, take advantage of commutative operators by
-- reordering their arguments.
reorder :: SBVExpr -> SBVExpr
reorder :: SBVExpr -> SBVExpr
reorder SBVExpr
s = case SBVExpr
s of
              SBVApp Op
op [SV
a, SV
b] | Op -> Bool
isCommutative Op
op Bool -> Bool -> Bool
&& SV
a forall a. Ord a => a -> a -> Bool
> SV
b -> Op -> [SV] -> SBVExpr
SBVApp Op
op [SV
b, SV
a]
              SBVExpr
_ -> SBVExpr
s
  where isCommutative :: Op -> Bool
        isCommutative :: Op -> Bool
isCommutative Op
o = Op
o 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]

-- Show instance for 'SBVExpr'. Again, only for debugging purposes.
instance Show SBVExpr where
  show :: SBVExpr -> [Char]
show (SBVApp Op
Ite [SV
t, SV
a, SV
b])             = [[Char]] -> [Char]
unwords [[Char]
"if", forall a. Show a => a -> [Char]
show SV
t, [Char]
"then", forall a. Show a => a -> [Char]
show SV
a, [Char]
"else", forall a. Show a => a -> [Char]
show SV
b]
  show (SBVApp Op
Shl     [SV
a, SV
i])            = [[Char]] -> [Char]
unwords [forall a. Show a => a -> [Char]
show SV
a, [Char]
"<<", forall a. Show a => a -> [Char]
show SV
i]
  show (SBVApp Op
Shr     [SV
a, SV
i])            = [[Char]] -> [Char]
unwords [forall a. Show a => a -> [Char]
show SV
a, [Char]
">>", forall a. Show a => a -> [Char]
show SV
i]
  show (SBVApp (Rol Int
i) [SV
a])               = [[Char]] -> [Char]
unwords [forall a. Show a => a -> [Char]
show SV
a, [Char]
"<<<", forall a. Show a => a -> [Char]
show Int
i]
  show (SBVApp (Ror Int
i) [SV
a])               = [[Char]] -> [Char]
unwords [forall a. Show a => a -> [Char]
show SV
a, [Char]
">>>", forall a. Show a => a -> [Char]
show Int
i]
  show (SBVApp (PseudoBoolean PBOp
pb) [SV]
args)   = [[Char]] -> [Char]
unwords (forall a. Show a => a -> [Char]
show PBOp
pb forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [SV]
args)
  show (SBVApp (OverflowOp OvOp
op)    [SV]
args)   = [[Char]] -> [Char]
unwords (forall a. Show a => a -> [Char]
show OvOp
op forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [SV]
args)
  show (SBVApp Op
op                 [SV
a, SV
b]) = [[Char]] -> [Char]
unwords [forall a. Show a => a -> [Char]
show SV
a, forall a. Show a => a -> [Char]
show Op
op, forall a. Show a => a -> [Char]
show SV
b]
  show (SBVApp Op
op                 [SV]
args)   = [[Char]] -> [Char]
unwords (forall a. Show a => a -> [Char]
show Op
op forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [SV]
args)

-- | A program is a sequence of assignments
newtype SBVPgm = SBVPgm {SBVPgm -> Seq (SV, SBVExpr)
pgmAssignments :: S.Seq (SV, SBVExpr)}

-- | Helper synonym for text, in case we switch to something else later.
type Name = T.Text

-- | 'NamedSymVar' pairs symbolic values and user given/automatically generated names
data NamedSymVar = NamedSymVar !SV !Name
                 deriving (Int -> NamedSymVar -> ShowS
[NamedSymVar] -> ShowS
NamedSymVar -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NamedSymVar] -> ShowS
$cshowList :: [NamedSymVar] -> ShowS
show :: NamedSymVar -> [Char]
$cshow :: NamedSymVar -> [Char]
showsPrec :: Int -> NamedSymVar -> ShowS
$cshowsPrec :: Int -> NamedSymVar -> ShowS
Show, forall x. Rep NamedSymVar x -> NamedSymVar
forall x. NamedSymVar -> Rep NamedSymVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NamedSymVar x -> NamedSymVar
$cfrom :: forall x. NamedSymVar -> Rep NamedSymVar x
Generic)

-- | For comparison purposes, we simply use the SV and ignore the name
instance Eq NamedSymVar where
  == :: NamedSymVar -> NamedSymVar -> Bool
(==) (NamedSymVar SV
l Name
_) (NamedSymVar SV
r Name
_) = SV
l forall a. Eq a => a -> a -> Bool
== SV
r

instance Ord NamedSymVar where
  compare :: NamedSymVar -> NamedSymVar -> Ordering
compare (NamedSymVar SV
l Name
_) (NamedSymVar SV
r Name
_) = forall a. Ord a => a -> a -> Ordering
compare SV
l SV
r

-- | Convert to a named symvar, from string
toNamedSV' :: SV -> String -> NamedSymVar
toNamedSV' :: SV -> [Char] -> NamedSymVar
toNamedSV' SV
s = SV -> Name -> NamedSymVar
NamedSymVar SV
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
T.pack

-- | Convert to a named symvar, from text
toNamedSV :: SV -> Name -> NamedSymVar
toNamedSV :: SV -> Name -> NamedSymVar
toNamedSV = SV -> Name -> NamedSymVar
NamedSymVar

-- | Get the node id from a named sym var
namedNodeId :: NamedSymVar -> NodeId
namedNodeId :: NamedSymVar -> NodeId
namedNodeId = SV -> NodeId
swNodeId forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedSymVar -> SV
getSV

-- | Get the SV from a named sym var
getSV :: NamedSymVar -> SV
getSV :: NamedSymVar -> SV
getSV (NamedSymVar SV
s Name
_) = SV
s

-- | Get the user-name typed value from named sym var
getUserName :: NamedSymVar -> Name
getUserName :: NamedSymVar -> Name
getUserName (NamedSymVar SV
_ Name
nm) = Name
nm

-- | Get the string typed value from named sym var
getUserName' :: NamedSymVar -> String
getUserName' :: NamedSymVar -> [Char]
getUserName' = Name -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedSymVar -> Name
getUserName

-- | Style of optimization. Note that in the pareto case the user is allowed
-- to specify a max number of fronts to query the solver for, since there might
-- potentially be an infinite number of them and there is no way to know exactly
-- how many ahead of time. If 'Nothing' is given, SBV will possibly loop forever
-- if the number is really infinite.
data OptimizeStyle = Lexicographic      -- ^ Objectives are optimized in the order given, earlier objectives have higher priority.
                   | Independent        -- ^ Each objective is optimized independently.
                   | Pareto (Maybe Int) -- ^ Objectives are optimized according to pareto front: That is, no objective can be made better without making some other worse.
                   deriving (OptimizeStyle -> OptimizeStyle -> Bool
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OptimizeStyle] -> ShowS
$cshowList :: [OptimizeStyle] -> ShowS
show :: OptimizeStyle -> [Char]
$cshow :: OptimizeStyle -> [Char]
showsPrec :: Int -> OptimizeStyle -> ShowS
$cshowsPrec :: Int -> OptimizeStyle -> ShowS
Show)

-- | Penalty for a soft-assertion. The default penalty is @1@, with all soft-assertions belonging
-- to the same objective goal. A positive weight and an optional group can be provided by using
-- the 'Penalty' constructor.
data Penalty = DefaultPenalty                  -- ^ Default: Penalty of @1@ and no group attached
             | Penalty Rational (Maybe String) -- ^ Penalty with a weight and an optional group
             deriving Int -> Penalty -> ShowS
[Penalty] -> ShowS
Penalty -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Penalty] -> ShowS
$cshowList :: [Penalty] -> ShowS
show :: Penalty -> [Char]
$cshow :: Penalty -> [Char]
showsPrec :: Int -> Penalty -> ShowS
$cshowsPrec :: Int -> Penalty -> ShowS
Show

-- | Objective of optimization. We can minimize, maximize, or give a soft assertion with a penalty
-- for not satisfying it.
data Objective a = Minimize          String a         -- ^ Minimize this metric
                 | Maximize          String a         -- ^ Maximize this metric
                 | AssertWithPenalty String a Penalty -- ^ A soft assertion, with an associated penalty
                 deriving (Int -> Objective a -> ShowS
forall a. Show a => Int -> Objective a -> ShowS
forall a. Show a => [Objective a] -> ShowS
forall a. Show a => Objective a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Objective a] -> ShowS
$cshowList :: forall a. Show a => [Objective a] -> ShowS
show :: Objective a -> [Char]
$cshow :: forall a. Show a => Objective a -> [Char]
showsPrec :: Int -> Objective a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Objective a -> ShowS
Show, 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
<$ :: forall a b. a -> Objective b -> Objective a
$c<$ :: forall a b. a -> Objective b -> Objective a
fmap :: forall a b. (a -> b) -> Objective a -> Objective b
$cfmap :: forall a b. (a -> b) -> Objective a -> Objective b
Functor)

-- | The name of the objective
objectiveName :: Objective a -> String
objectiveName :: forall a. Objective a -> [Char]
objectiveName (Minimize          [Char]
s a
_)   = [Char]
s
objectiveName (Maximize          [Char]
s a
_)   = [Char]
s
objectiveName (AssertWithPenalty [Char]
s a
_ Penalty
_) = [Char]
s

-- | The state we keep track of as we interact with the solver
data QueryState = QueryState { QueryState -> Maybe Int -> [Char] -> IO [Char]
queryAsk                 :: Maybe Int -> String -> IO String
                             , QueryState -> Maybe Int -> [Char] -> IO ()
querySend                :: Maybe Int -> String -> IO ()
                             , QueryState -> Maybe Int -> IO [Char]
queryRetrieveResponse    :: Maybe Int -> IO String
                             , QueryState -> SMTConfig
queryConfig              :: SMTConfig
                             , QueryState -> IO ()
queryTerminate           :: IO ()
                             , QueryState -> Maybe Int
queryTimeOutValue        :: Maybe Int
                             , QueryState -> Int
queryAssertionStackDepth :: Int
                             }

-- | Computations which support query operations.
class Monad m => MonadQuery m where
  queryState :: m State

  default queryState :: (MonadTrans t, MonadQuery m', m ~ t m') => m State
  queryState = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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)

-- | A query is a user-guided mechanism to directly communicate and extract
-- results from the solver. A generalization of 'Data.SBV.Query'.
newtype QueryT m a = QueryT { forall (m :: * -> *) a. QueryT m a -> ReaderT State m a
runQueryT :: ReaderT State m a }
    deriving (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
<* :: forall a b. 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
*> :: forall a b. 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 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> QueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> QueryT m a
Applicative, 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
<$ :: forall a b. a -> QueryT m b -> QueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> QueryT m b -> QueryT m a
fmap :: forall a b. (a -> b) -> QueryT m a -> QueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT m a -> QueryT m b
Functor, 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 :: forall a. a -> QueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> QueryT m a
>> :: forall a b. 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
>>= :: forall a 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
Monad, 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 :: forall a. IO a -> QueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> QueryT m a
MonadIO, 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 :: forall (m :: * -> *) a. Monad m => 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 = forall (m :: * -> *) a. ReaderT State m a -> QueryT m a
QueryT 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 :: 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 n b
f = forall (m :: * -> *) a. ReaderT State m a -> QueryT m a
QueryT forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT State m a -> ReaderT State n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. QueryT m a -> ReaderT State m a
runQueryT
{-# INLINE mapQueryT #-}

-- | Create a fresh variable of some type in the underlying query monad transformer.
-- For further control on how these variables are projected and embedded, see the
-- 'Queriable' class.
class Fresh m a where
  fresh :: QueryT m a

-- | An queriable value. This is a generalization of the 'Fresh' class, in case one needs
-- to be more specific about how projections/embeddings are done.
class Queriable m a b | a -> b where
  -- | ^ Create a new symbolic value of type @a@
  create  :: QueryT m a
  -- | ^ Extract the current value in a SAT context
  project :: a -> QueryT m b
  -- | ^ Create a literal value. Morally, 'embed' and 'project' are inverses of each other
  -- via the 'QueryT' monad transformer.
  embed   :: b -> QueryT m a

-- Have to define this one by hand, because we use ReaderT in the implementation
instance MonadReader r m => MonadReader r (QueryT m) where
  ask :: QueryT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> QueryT m a -> QueryT m a
local r -> r
f = forall (m :: * -> *) a (n :: * -> *) b.
(ReaderT State m a -> ReaderT State n b)
-> QueryT m a -> QueryT n b
mapQueryT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f

-- | A query is a user-guided mechanism to directly communicate and extract
-- results from the solver.
type Query = QueryT IO

instance MonadSymbolic Query where
   symbolicEnv :: Query State
symbolicEnv = forall (m :: * -> *). MonadQuery m => m State
queryState

instance NFData OptimizeStyle where
   rnf :: OptimizeStyle -> ()
rnf OptimizeStyle
x = OptimizeStyle
x seq :: forall a b. a -> b -> b
`seq` ()

instance NFData Penalty where
   rnf :: Penalty -> ()
rnf Penalty
DefaultPenalty  = ()
   rnf (Penalty Rational
p Maybe [Char]
mbs) = forall a. NFData a => a -> ()
rnf Rational
p seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe [Char]
mbs

instance NFData a => NFData (Objective a) where
   rnf :: Objective a -> ()
rnf (Minimize          [Char]
s a
a)   = forall a. NFData a => a -> ()
rnf [Char]
s seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
a
   rnf (Maximize          [Char]
s a
a)   = forall a. NFData a => a -> ()
rnf [Char]
s seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
a
   rnf (AssertWithPenalty [Char]
s a
a Penalty
p) = forall a. NFData a => a -> ()
rnf [Char]
s seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Penalty
p

-- | Result of running a symbolic computation
data Result = Result { Result -> Set Kind
reskinds       :: Set.Set Kind                                 -- ^ kinds used in the program
                     , Result -> [([Char], CV)]
resTraces      :: [(String, CV)]                               -- ^ quick-check counter-example information (if any)
                     , Result -> [([Char], CV -> Bool, SV)]
resObservables :: [(String, CV -> Bool, SV)]                   -- ^ observable expressions (part of the model)
                     , Result -> [([Char], [[Char]])]
resUISegs      :: [(String, [String])]                         -- ^ uninterpeted code segments
                     , Result -> ([(Quantifier, NamedSymVar)], [NamedSymVar])
resInputs      :: ([(Quantifier, NamedSymVar)], [NamedSymVar]) -- ^ inputs (possibly existential) + tracker vars
                     , Result -> (CnstMap, [(SV, CV)])
resConsts      :: (CnstMap, [(SV, CV)])                        -- ^ constants
                     , Result -> [((Int, Kind, Kind), [SV])]
resTables      :: [((Int, Kind, Kind), [SV])]                  -- ^ tables (automatically constructed) (tableno, index-type, result-type) elts
                     , Result -> [(Int, ArrayInfo)]
resArrays      :: [(Int, ArrayInfo)]                           -- ^ arrays (user specified)
                     , Result -> [([Char], SBVType)]
resUIConsts    :: [(String, SBVType)]                          -- ^ uninterpreted constants
                     , Result -> [(Bool, [Char], [[Char]])]
resAxioms      :: [(Bool, String, [String])]                   -- ^ axioms/definitions
                     , Result -> SBVPgm
resAsgns       :: SBVPgm                                       -- ^ assignments
                     , Result -> Seq (Bool, [([Char], [Char])], SV)
resConstraints :: S.Seq (Bool, [(String, String)], SV)         -- ^ additional constraints (boolean)
                     , Result -> [([Char], Maybe CallStack, SV)]
resAssertions  :: [(String, Maybe CallStack, SV)]              -- ^ assertions
                     , Result -> [SV]
resOutputs     :: [SV]                                         -- ^ outputs
                     }

-- Show instance for 'Result'. Only for debugging purposes.
instance Show Result where
  -- If there's nothing interesting going on, just print the constant. Note that the
  -- definition of interesting here is rather subjective; but essentially if we reduced
  -- the result to a single constant already, without any reference to anything.
  show :: Result -> [Char]
show Result{resConsts :: Result -> (CnstMap, [(SV, CV)])
resConsts=(CnstMap
_, [(SV, CV)]
cs), resOutputs :: Result -> [SV]
resOutputs=[SV
r]}
    | Just CV
c <- SV
r forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs
    = forall a. Show a => a -> [Char]
show CV
c
  show (Result Set Kind
kinds [([Char], CV)]
_ [([Char], CV -> Bool, SV)]
_ [([Char], [[Char]])]
cgs ([(Quantifier, NamedSymVar)], [NamedSymVar])
is (CnstMap
_, [(SV, CV)]
cs) [((Int, Kind, Kind), [SV])]
ts [(Int, ArrayInfo)]
as [([Char], SBVType)]
uis [(Bool, [Char], [[Char]])]
axs SBVPgm
xs Seq (Bool, [([Char], [Char])], SV)
cstrs [([Char], Maybe CallStack, SV)]
asserts [SV]
os) = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" forall a b. (a -> b) -> a -> b
$
                   (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
usorts then [] else [Char]
"SORTS" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " forall a. [a] -> [a] -> [a]
++) [[Char]]
usorts)
                forall a. [a] -> [a] -> [a]
++ [[Char]
"INPUTS"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Quantifier, NamedSymVar) -> [Char]
shn (forall a b. (a, b) -> a
fst ([(Quantifier, NamedSymVar)], [NamedSymVar])
is)
                forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a b. (a, b) -> b
snd ([(Quantifier, NamedSymVar)], [NamedSymVar])
is) then [] else [Char]
"TRACKER VARS" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((Quantifier, NamedSymVar) -> [Char]
shn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantifier
EX,)) (forall a b. (a, b) -> b
snd ([(Quantifier, NamedSymVar)], [NamedSymVar])
is))
                forall a. [a] -> [a] -> [a]
++ [[Char]
"CONSTANTS"]
                forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Show a => (SV, a) -> [[Char]]
shc [(SV, CV)]
cs
                forall a. [a] -> [a] -> [a]
++ [[Char]
"TABLES"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a}.
(Show a, Show a, Show a, Show a) =>
((a, a, a), a) -> [Char]
sht [((Int, Kind, Kind), [SV])]
ts
                forall a. [a] -> [a] -> [a]
++ [[Char]
"ARRAYS"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a}.
(Show a, Show a, Show a, Show a) =>
(a, ([Char], (a, a), a)) -> [Char]
sha [(Int, ArrayInfo)]
as
                forall a. [a] -> [a] -> [a]
++ [[Char]
"UNINTERPRETED CONSTANTS"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => ([Char], a) -> [Char]
shui [([Char], SBVType)]
uis
                forall a. [a] -> [a] -> [a]
++ [[Char]
"USER GIVEN CODE SEGMENTS"]
                forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [[Char]]) -> [[Char]]
shcg [([Char], [[Char]])]
cgs
                forall a. [a] -> [a] -> [a]
++ [[Char]
"AXIOMS"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Bool, [Char], [[Char]]) -> [Char]
shax [(Bool, [Char], [[Char]])]
axs
                forall a. [a] -> [a] -> [a]
++ [[Char]
"DEFINE"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(SV
s, SBVExpr
e) -> [Char]
"  " forall a. [a] -> [a] -> [a]
++ SV -> [Char]
shs SV
s forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBVExpr
e) (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (SBVPgm -> Seq (SV, SBVExpr)
pgmAssignments SBVPgm
xs))
                forall a. [a] -> [a] -> [a]
++ [[Char]
"CONSTRAINTS"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"  " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}.
(Eq a, IsString a, Show a, Show a) =>
(Bool, [(a, [Char])], a) -> [Char]
shCstr) (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Bool, [([Char], [Char])], SV)
cstrs)
                forall a. [a] -> [a] -> [a]
++ [[Char]
"ASSERTIONS"]
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"  "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => ([Char], Maybe CallStack, a) -> [Char]
shAssert) [([Char], Maybe CallStack, SV)]
asserts
                forall a. [a] -> [a] -> [a]
++ [[Char]
"OUTPUTS"]
                forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> [[Char]]
sh2 [SV]
os
    where sh2 :: Show a => [a] -> [String]
          sh2 :: forall a. Show a => [a] -> [[Char]]
sh2 = forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"  "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show)

          usorts :: [[Char]]
usorts = [[Char] -> Maybe [[Char]] -> [Char]
sh [Char]
s Maybe [[Char]]
t | KUserSort [Char]
s Maybe [[Char]]
t <- forall a. Set a -> [a]
Set.toList Set Kind
kinds]
                   where sh :: [Char] -> Maybe [[Char]] -> [Char]
sh [Char]
s Maybe [[Char]]
Nothing   = [Char]
s
                         sh [Char]
s (Just [[Char]]
es) = [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
" (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
es forall a. [a] -> [a] -> [a]
++ [Char]
")"

          shs :: SV -> [Char]
shs SV
sv = forall a. Show a => a -> [Char]
show SV
sv forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SV -> Kind
swKind SV
sv)

          sht :: ((a, a, a), a) -> [Char]
sht ((a
i, a
at, a
rt), a
es)  = [Char]
"  Table " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
i forall a. [a] -> [a] -> [a]
++ [Char]
" : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
at forall a. [a] -> [a] -> [a]
++ [Char]
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
rt forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
es

          shc :: (SV, a) -> [[Char]]
shc (SV
sv, a
cv)
            | SV
sv forall a. Eq a => a -> a -> Bool
== SV
falseSV Bool -> Bool -> Bool
|| SV
sv forall a. Eq a => a -> a -> Bool
== SV
trueSV
            = []
            | Bool
True
            = [[Char]
"  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
sv forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
cv]

          shcg :: ([Char], [[Char]]) -> [[Char]]
shcg ([Char]
s, [[Char]]
ss) = ([Char]
"Variable: " forall a. [a] -> [a] -> [a]
++ [Char]
s) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " forall a. [a] -> [a] -> [a]
++) [[Char]]
ss

          shn :: (Quantifier, NamedSymVar) -> [Char]
shn (Quantifier
q, NamedSymVar SV
sv Name
nm) = [Char]
"  " forall a. Semigroup a => a -> a -> a
<> [Char]
ni forall a. Semigroup a => a -> a -> a
<> [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SV -> Kind
swKind SV
sv) forall a. [a] -> [a] -> [a]
++ [Char]
ex forall a. [a] -> [a] -> [a]
++ [Char]
alias
            where ni :: [Char]
ni = forall a. Show a => a -> [Char]
show SV
sv
                  ex :: [Char]
ex    | Quantifier
q forall a. Eq a => a -> a -> Bool
== Quantifier
ALL          = [Char]
""
                        | Bool
True              = [Char]
", existential"

                  alias :: [Char]
alias | [Char]
ni forall a. Eq a => a -> a -> Bool
== Name -> [Char]
T.unpack Name
nm = [Char]
""
                        | Bool
True              = [Char]
", aliasing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
nm

          sha :: (a, ([Char], (a, a), a)) -> [Char]
sha (a
i, ([Char]
nm, (a
ai, a
bi), a
ctx)) = [Char]
"  " forall a. [a] -> [a] -> [a]
++ [Char]
ni forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
ai forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
bi forall a. [a] -> [a] -> [a]
++ [Char]
alias
                                       forall a. [a] -> [a] -> [a]
++ [Char]
"\n     Context: "     forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
ctx
            where ni :: [Char]
ni = [Char]
"array_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
i
                  alias :: [Char]
alias | [Char]
ni forall a. Eq a => a -> a -> Bool
== [Char]
nm = [Char]
""
                        | Bool
True     = [Char]
", aliasing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
nm

          shui :: ([Char], a) -> [Char]
shui ([Char]
nm, a
t) = [Char]
"  [uninterpreted] " forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
t

          shax :: (Bool, [Char], [[Char]]) -> [Char]
shax (Bool
hasDefinition, [Char]
nm, [[Char]]
ss) = [Char]
"  -- user defined " forall a. [a] -> [a] -> [a]
++ [Char]
what forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
"\n  " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n  " [[Char]]
ss
             where what :: [Char]
what | Bool
hasDefinition = [Char]
"value"
                        | Bool
True          = [Char]
"axiom"

          shCstr :: (Bool, [(a, [Char])], a) -> [Char]
shCstr (Bool
isSoft, [], a
c)               = forall {a}. IsString a => Bool -> a
soft Bool
isSoft forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
c
          shCstr (Bool
isSoft, [(a
":named", [Char]
nm)], a
c) = forall {a}. IsString a => Bool -> a
soft Bool
isSoft forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
c
          shCstr (Bool
isSoft, [(a, [Char])]
attrs, a
c)            = forall {a}. IsString a => Bool -> a
soft Bool
isSoft forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
c forall a. [a] -> [a] -> [a]
++ [Char]
" (attributes: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [(a, [Char])]
attrs forall a. [a] -> [a] -> [a]
++ [Char]
")"

          soft :: Bool -> a
soft Bool
True  = a
"[SOFT] "
          soft Bool
False = a
""

          shAssert :: ([Char], Maybe CallStack, a) -> [Char]
shAssert ([Char]
nm, Maybe CallStack
stk, a
p) = [Char]
"  -- assertion: " forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"[No location]"
#if MIN_VERSION_base(4,9,0)
                CallStack -> [Char]
prettyCallStack
#else
                showCallStack
#endif
                Maybe CallStack
stk forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
p

-- | The context of a symbolic array as created
data ArrayContext = ArrayFree (Maybe SV)                   -- ^ A new array, the contents are initialized with the given value, if any
                  | ArrayMutate ArrayIndex SV SV           -- ^ An array created by mutating another array at a given cell
                  | ArrayMerge  SV ArrayIndex ArrayIndex   -- ^ An array created by symbolically merging two other arrays

instance Show ArrayContext where
  show :: ArrayContext -> [Char]
show (ArrayFree Maybe SV
Nothing)   = [Char]
" initialized with random elements"
  show (ArrayFree (Just SV
sv)) = [Char]
" initialized with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
sv
  show (ArrayMutate ArrayIndex
i SV
a SV
b)   = [Char]
" cloned from array_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ArrayIndex
i forall a. [a] -> [a] -> [a]
++ [Char]
" with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
a forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SV -> Kind
swKind SV
a) forall a. [a] -> [a] -> [a]
++ [Char]
" |-> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
b forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SV -> Kind
swKind SV
b)
  show (ArrayMerge  SV
s ArrayIndex
i ArrayIndex
j)   = [Char]
" merged arrays " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ArrayIndex
i forall a. [a] -> [a] -> [a]
++ [Char]
" and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ArrayIndex
j forall a. [a] -> [a] -> [a]
++ [Char]
" on condition " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
s

-- | Expression map, used for hash-consing
type ExprMap = Map.Map SBVExpr SV

-- | Constants are stored in a map, for hash-consing.
type CnstMap = Map.Map CV SV

-- | Kinds used in the program; used for determining the final SMT-Lib logic to pick
type KindSet = Set.Set Kind

-- | Tables generated during a symbolic run
type TableMap = Map.Map (Kind, Kind, [SV]) Int

-- | Representation for symbolic arrays
type ArrayInfo = (String, (Kind, Kind), ArrayContext)

-- | SMT Arrays generated during a symbolic run
type ArrayMap  = IMap.IntMap ArrayInfo

-- | Functional Arrays generated during a symbolic run
type FArrayMap  = IMap.IntMap (SVal -> SVal, IORef (IMap.IntMap SV))

-- | Uninterpreted-constants generated during a symbolic run
type UIMap     = Map.Map String SBVType

-- | Code-segments for Uninterpreted-constants, as given by the user
type CgMap     = Map.Map String [String]

-- | Cached values, implementing sharing
type Cache a   = IMap.IntMap [(StableName (State -> IO a), a)]

-- | Stage of an interactive run
data IStage = ISetup        -- Before we initiate contact.
            | ISafe         -- In the context of a safe/safeWith call
            | IRun          -- After the contact is started

-- | Are we checking safety
isSafetyCheckingIStage :: IStage -> Bool
isSafetyCheckingIStage :: IStage -> Bool
isSafetyCheckingIStage IStage
s = case IStage
s of
                             IStage
ISetup -> Bool
False
                             IStage
ISafe  -> Bool
True
                             IStage
IRun   -> Bool
False

-- | Are we in setup?
isSetupIStage :: IStage -> Bool
isSetupIStage :: IStage -> Bool
isSetupIStage IStage
s = case IStage
s of
                   IStage
ISetup -> Bool
True
                   IStage
ISafe  -> Bool
False
                   IStage
IRun   -> Bool
True

-- | Are we in a run?
isRunIStage :: IStage -> Bool
isRunIStage :: IStage -> Bool
isRunIStage IStage
s = case IStage
s of
                  IStage
ISetup -> Bool
False
                  IStage
ISafe  -> Bool
False
                  IStage
IRun   -> Bool
True

-- | Different means of running a symbolic piece of code
data SBVRunMode = SMTMode QueryContext IStage Bool SMTConfig                        -- ^ In regular mode, with a stage. Bool is True if this is SAT.
                | CodeGen                                                           -- ^ Code generation mode.
                | Concrete (Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)]))  -- ^ Concrete simulation mode, with given environment if any. If Nothing: Random.

-- Show instance for SBVRunMode; debugging purposes only
instance Show SBVRunMode where
   show :: SBVRunMode -> [Char]
show (SMTMode QueryContext
qc IStage
ISetup Bool
True  SMTConfig
_)  = [Char]
"Satisfiability setup (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show QueryContext
qc forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
ISafe  Bool
True  SMTConfig
_)  = [Char]
"Safety setup (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show QueryContext
qc forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
IRun   Bool
True  SMTConfig
_)  = [Char]
"Satisfiability (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show QueryContext
qc forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
ISetup Bool
False SMTConfig
_)  = [Char]
"Proof setup (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show QueryContext
qc forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
ISafe  Bool
False SMTConfig
_)  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"ISafe-False is not an expected/supported combination for SBVRunMode! (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show QueryContext
qc forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
IRun   Bool
False SMTConfig
_)  = [Char]
"Proof (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show QueryContext
qc forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show SBVRunMode
CodeGen                      = [Char]
"Code generation"
   show (Concrete Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)])
Nothing)           = [Char]
"Concrete evaluation with random values"
   show (Concrete (Just (Bool
True, [((Quantifier, NamedSymVar), Maybe CV)]
_)))  = [Char]
"Concrete evaluation during model validation for sat"
   show (Concrete (Just (Bool
False, [((Quantifier, NamedSymVar), Maybe CV)]
_))) = [Char]
"Concrete evaluation during model validation for prove"

-- | Is this a CodeGen run? (i.e., generating code)
isCodeGenMode :: State -> IO Bool
isCodeGenMode :: State -> IO Bool
isCodeGenMode State{IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode} = do SBVRunMode
rm <- forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case SBVRunMode
rm of
                                             Concrete{} -> Bool
False
                                             SMTMode{}  -> Bool
False
                                             SBVRunMode
CodeGen    -> Bool
True

-- | The state in query mode, i.e., additional context
data IncState = IncState { IncState -> IORef [NamedSymVar]
rNewInps        :: IORef [NamedSymVar]   -- always existential!
                         , 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, [([Char], [Char])], SV))
rNewConstraints :: IORef (S.Seq (Bool, [(String, String)], SV))
                         }

-- | Get a new IncState
newIncState :: IO IncState
newIncState :: IO IncState
newIncState = do
        IORef [NamedSymVar]
is    <- forall a. a -> IO (IORef a)
newIORef []
        IORef (Set Kind)
ks    <- forall a. a -> IO (IORef a)
newIORef forall a. Set a
Set.empty
        IORef CnstMap
nc    <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
        IORef ArrayMap
am    <- forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
IMap.empty
        IORef TableMap
tm    <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
        IORef UIMap
ui    <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
        IORef SBVPgm
pgm   <- forall a. a -> IO (IORef a)
newIORef (Seq (SV, SBVExpr) -> SBVPgm
SBVPgm forall a. Seq a
S.empty)
        IORef (Seq (Bool, [([Char], [Char])], SV))
cstrs <- forall a. a -> IO (IORef a)
newIORef forall a. Seq a
S.empty
        forall (m :: * -> *) a. Monad m => a -> m a
return 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, [([Char], [Char])], SV))
rNewConstraints = IORef (Seq (Bool, [([Char], [Char])], SV))
cstrs
                        }

-- | Get a new IncState
withNewIncState :: State -> (State -> IO a) -> IO (IncState, a)
withNewIncState :: forall a. State -> (State -> IO a) -> IO (IncState, a)
withNewIncState State
st State -> IO a
cont = do
        IncState
is <- IO IncState
newIncState
        forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (State -> IORef IncState
rIncState State
st) (forall a b. a -> b -> a
const IncState
is)
        a
r  <- State -> IO a
cont State
st
        IncState
finalIncState <- forall a. IORef a -> IO a
readIORef (State -> IORef IncState
rIncState State
st)
        forall (m :: * -> *) a. Monad m => a -> m a
return (IncState
finalIncState, a
r)

-- | User defined, with proper quantifiers
type UserInputs = S.Seq (Quantifier, NamedSymVar)

-- | Internally declared, always existential
type InternInps = S.Seq NamedSymVar

-- | Entire set of names, for faster lookup
type AllInps = Set.Set Name

-- | Inputs as a record of maps and sets. See above type-synonyms for their roles.
data Inputs = Inputs { Inputs -> UserInputs
userInputs   :: !UserInputs
                     , Inputs -> InternInps
internInputs :: !InternInps
                     , Inputs -> AllInps
allInputs    :: !AllInps
                     } deriving (Inputs -> Inputs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inputs -> Inputs -> Bool
$c/= :: Inputs -> Inputs -> Bool
== :: Inputs -> Inputs -> Bool
$c== :: Inputs -> Inputs -> Bool
Eq,Int -> Inputs -> ShowS
[Inputs] -> ShowS
Inputs -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Inputs] -> ShowS
$cshowList :: [Inputs] -> ShowS
show :: Inputs -> [Char]
$cshow :: Inputs -> [Char]
showsPrec :: Int -> Inputs -> ShowS
$cshowsPrec :: Int -> Inputs -> ShowS
Show)

-- | Semigroup instance; combining according to indexes.
instance Semigroup Inputs where
  (Inputs UserInputs
lui InternInps
lii AllInps
lai) <> :: Inputs -> Inputs -> Inputs
<> (Inputs UserInputs
rui InternInps
rii AllInps
rai) = UserInputs -> InternInps -> AllInps -> Inputs
Inputs (UserInputs
lui forall a. Semigroup a => a -> a -> a
<> UserInputs
rui) (InternInps
lii forall a. Semigroup a => a -> a -> a
<> InternInps
rii) (AllInps
lai forall a. Semigroup a => a -> a -> a
<> AllInps
rai)

-- | Monoid instance, we start with no maps.
instance Monoid Inputs where
  mempty :: Inputs
mempty = Inputs { userInputs :: UserInputs
userInputs   = forall a. Monoid a => a
mempty
                  , internInputs :: InternInps
internInputs = forall a. Monoid a => a
mempty
                  , allInputs :: AllInps
allInputs    = forall a. Monoid a => a
mempty
                  }

-- | Get the quantifier
quantifier :: (Quantifier, NamedSymVar) -> Quantifier
quantifier :: (Quantifier, NamedSymVar) -> Quantifier
quantifier = forall a b. (a, b) -> a
fst

-- | Get the named symbolic variable
namedSymVar :: (Quantifier, NamedSymVar) -> NamedSymVar
namedSymVar :: (Quantifier, NamedSymVar) -> NamedSymVar
namedSymVar = forall a b. (a, b) -> b
snd

-- | Modify the user-inputs field
onUserInputs :: (UserInputs -> UserInputs) -> Inputs -> Inputs
onUserInputs :: (UserInputs -> UserInputs) -> Inputs -> Inputs
onUserInputs UserInputs -> UserInputs
f inp :: Inputs
inp@Inputs{UserInputs
userInputs :: UserInputs
userInputs :: Inputs -> UserInputs
userInputs} = Inputs
inp{userInputs :: UserInputs
userInputs = UserInputs -> UserInputs
f UserInputs
userInputs}

-- | Modify the internal-inputs field
onInternInputs :: (InternInps -> InternInps) -> Inputs -> Inputs
onInternInputs :: (InternInps -> InternInps) -> Inputs -> Inputs
onInternInputs InternInps -> InternInps
f inp :: Inputs
inp@Inputs{InternInps
internInputs :: InternInps
internInputs :: Inputs -> InternInps
internInputs} = Inputs
inp{internInputs :: InternInps
internInputs = InternInps -> InternInps
f InternInps
internInputs}

-- | Modify the all-inputs field
onAllInputs :: (AllInps -> AllInps) -> Inputs -> Inputs
onAllInputs :: (AllInps -> AllInps) -> Inputs -> Inputs
onAllInputs AllInps -> AllInps
f inp :: Inputs
inp@Inputs{AllInps
allInputs :: AllInps
allInputs :: Inputs -> AllInps
allInputs} = Inputs
inp{allInputs :: AllInps
allInputs = AllInps -> AllInps
f AllInps
allInputs}

-- | Add a new internal input
addInternInput :: SV -> Name -> Inputs -> Inputs
addInternInput :: SV -> Name -> Inputs -> Inputs
addInternInput SV
sv Name
nm = Inputs -> Inputs
goAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inputs -> Inputs
goIntern
  where !new :: NamedSymVar
new = SV -> Name -> NamedSymVar
toNamedSV SV
sv Name
nm
        goIntern :: Inputs -> Inputs
goIntern = (InternInps -> InternInps) -> Inputs -> Inputs
onInternInputs (forall a. Seq a -> a -> Seq a
S.|> NamedSymVar
new)
        goAll :: Inputs -> Inputs
goAll    = (AllInps -> AllInps) -> Inputs -> Inputs
onAllInputs    (forall a. Ord a => a -> Set a -> Set a
Set.insert Name
nm)

-- | Add a new user input
addUserInput :: Quantifier -> SV -> Name -> Inputs -> Inputs
addUserInput :: Quantifier -> SV -> Name -> Inputs -> Inputs
addUserInput Quantifier
q SV
sv Name
nm = Inputs -> Inputs
goAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inputs -> Inputs
goUser
  where new :: NamedSymVar
new = SV -> Name -> NamedSymVar
toNamedSV SV
sv Name
nm
        goUser :: Inputs -> Inputs
goUser = (UserInputs -> UserInputs) -> Inputs -> Inputs
onUserInputs (forall a. Seq a -> a -> Seq a
S.|> (Quantifier
q, NamedSymVar
new)) -- add to the end of the sequence
        goAll :: Inputs -> Inputs
goAll  = (AllInps -> AllInps) -> Inputs -> Inputs
onAllInputs  (forall a. Ord a => a -> Set a -> Set a
Set.insert Name
nm)

-- | Return user and internal inputs
getInputs :: Inputs -> (UserInputs, InternInps)
getInputs :: Inputs -> (UserInputs, InternInps)
getInputs Inputs{UserInputs
userInputs :: UserInputs
userInputs :: Inputs -> UserInputs
userInputs, InternInps
internInputs :: InternInps
internInputs :: Inputs -> InternInps
internInputs} = (UserInputs
userInputs, InternInps
internInputs)

-- | Find a user-input from its SV
lookupInput :: Eq a => (a -> SV) -> SV -> S.Seq a -> Maybe a
lookupInput :: forall a. Eq a => (a -> SV) -> SV -> Seq a -> Maybe a
lookupInput a -> SV
f SV
sv Seq a
ns = Maybe a
res
  where
    i :: Int
i   = NodeId -> Int
getId (SV -> NodeId
swNodeId SV
sv)
    svs :: Seq SV
svs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> SV
f Seq a
ns
    res :: Maybe a
res = case forall a. Int -> Seq a -> Maybe a
S.lookup Int
i Seq a
ns of -- Nothing on negative Int or Int > length seq
            Maybe a
Nothing    -> Maybe a
secondLookup
            x :: Maybe a
x@(Just a
e) -> if SV
sv forall a. Eq a => a -> a -> Bool
== a -> SV
f a
e then Maybe a
x else Maybe a
secondLookup
              -- we try the fast lookup first, if the node ids don't match then
              -- we use the more expensive O (n) to find the index and the elem
    secondLookup :: Maybe a
secondLookup = forall a. Eq a => a -> Seq a -> Maybe Int
S.elemIndexL SV
sv Seq SV
svs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> Seq a -> Maybe a
S.lookup Seq a
ns

-- | Extract universals
getUniversals :: UserInputs -> S.Seq NamedSymVar
getUniversals :: UserInputs -> InternInps
getUniversals = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Quantifier, NamedSymVar) -> NamedSymVar
namedSymVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
S.filter ((forall a. Eq a => a -> a -> Bool
== Quantifier
ALL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantifier, NamedSymVar) -> Quantifier
quantifier)

-- | Get a prefix of the user inputs by a predicate. Note that we could not rely
-- on fusion here but this is cheap and easy until there is an observable slow down from not fusing.
userInpsPrefixBy :: ((Quantifier, NamedSymVar) -> Bool) -> UserInputs -> UserInputs
userInpsPrefixBy :: ((Quantifier, NamedSymVar) -> Bool) -> UserInputs -> UserInputs
userInpsPrefixBy = forall a. (a -> Bool) -> Seq a -> Seq a
S.takeWhileL

-- | Find prefix existentials, i.e., those that are at skolem positions and have valid model values.
prefixExistentials :: UserInputs -> UserInputs
prefixExistentials :: UserInputs -> UserInputs
prefixExistentials = ((Quantifier, NamedSymVar) -> Bool) -> UserInputs -> UserInputs
userInpsPrefixBy ((forall a. Eq a => a -> a -> Bool
/= Quantifier
ALL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantifier, NamedSymVar) -> Quantifier
quantifier)

-- | Find prefix universals. Corresponds to the above in a proof context.
prefixUniversals :: UserInputs -> UserInputs
prefixUniversals :: UserInputs -> UserInputs
prefixUniversals = ((Quantifier, NamedSymVar) -> Bool) -> UserInputs -> UserInputs
userInpsPrefixBy ((forall a. Eq a => a -> a -> Bool
== Quantifier
ALL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantifier, NamedSymVar) -> Quantifier
quantifier)

-- | Conversion from named-symvars to user-inputs
inputsFromListWith :: (NamedSymVar -> Quantifier) -> [NamedSymVar] -> UserInputs
inputsFromListWith :: (NamedSymVar -> Quantifier) -> [NamedSymVar] -> UserInputs
inputsFromListWith NamedSymVar -> Quantifier
f = forall a. [a] -> Seq a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedSymVar -> (Quantifier, NamedSymVar)
go
  where go :: NamedSymVar -> (Quantifier, NamedSymVar)
go NamedSymVar
n = (NamedSymVar -> Quantifier
f NamedSymVar
n, NamedSymVar
n)

-- | Helper functions around inputs.
-- TODO: remove these functions once lists have been pushed to edges of code base.
userInputsToList :: UserInputs -> [(Quantifier, NamedSymVar)]
userInputsToList :: UserInputs -> [(Quantifier, NamedSymVar)]
userInputsToList = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | Conversion from internal-inputs to list of named sym vars
internInputsToList :: InternInps -> [NamedSymVar]
internInputsToList :: InternInps -> [NamedSymVar]
internInputsToList = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | Convert to regular lists
inputsToList :: Inputs -> ([(Quantifier, NamedSymVar)], [NamedSymVar])
inputsToList :: Inputs -> ([(Quantifier, NamedSymVar)], [NamedSymVar])
inputsToList =  (UserInputs -> [(Quantifier, NamedSymVar)]
userInputsToList forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** InternInps -> [NamedSymVar]
internInputsToList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inputs -> (UserInputs, InternInps)
getInputs

-- | The state of the symbolic interpreter
data State  = State { State -> SVal
pathCond     :: SVal                             -- ^ kind KBool
                    , State -> UTCTime
startTime    :: UTCTime
                    , State -> IORef SBVRunMode
runMode      :: IORef SBVRunMode
                    , State -> IORef IncState
rIncState    :: IORef IncState
                    , State -> IORef [([Char], CV)]
rCInfo       :: IORef [(String, CV)]
                    , State -> IORef (Seq (Name, CV -> Bool, SV))
rObservables :: IORef (S.Seq (Name, CV -> Bool, SV))
                    , State -> IORef Int
rctr         :: IORef Int
                    , State -> IORef (Set Kind)
rUsedKinds   :: IORef KindSet
                    , State -> IORef (Set [Char])
rUsedLbls    :: IORef (Set.Set String)
                    , State -> IORef Inputs
rinps        :: IORef Inputs
                    , State -> IORef (Seq (Bool, [([Char], [Char])], 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 [(Bool, [Char], [[Char]])]
raxioms      :: IORef [(Bool, String, [String])]
                    , State -> IORef [SMTOption]
rSMTOptions  :: IORef [SMTOption]
                    , State -> IORef [Objective (SV, SV)]
rOptGoals    :: IORef [Objective (SV, SV)]
                    , State -> IORef [([Char], 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 (Maybe QueryState)
rQueryState  :: IORef (Maybe QueryState)
                    }

-- NFData is a bit of a lie, but it's sufficient, most of the content is iorefs that we don't want to touch
instance NFData State where
   rnf :: State -> ()
rnf State{} = ()

-- | Get the current path condition
getSValPathCondition :: State -> SVal
getSValPathCondition :: State -> SVal
getSValPathCondition = State -> SVal
pathCond

-- | Extend the path condition with the given test value.
extendSValPathCondition :: State -> (SVal -> SVal) -> State
extendSValPathCondition :: State -> (SVal -> SVal) -> State
extendSValPathCondition State
st SVal -> SVal
f = State
st{pathCond :: SVal
pathCond = SVal -> SVal
f (State -> SVal
pathCond State
st)}

-- | Are we running in proof mode?
inSMTMode :: State -> IO Bool
inSMTMode :: State -> IO Bool
inSMTMode State{IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode} = do SBVRunMode
rm <- forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
                              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case SBVRunMode
rm of
                                         SBVRunMode
CodeGen    -> Bool
False
                                         Concrete{} -> Bool
False
                                         SMTMode{}  -> Bool
True

-- | The "Symbolic" value. Either a constant (@Left@) or a symbolic
-- value (@Right Cached@). Note that caching is essential for making
-- sure sharing is preserved.
data SVal = SVal !Kind !(Either CV (Cached SV))

instance HasKind SVal where
  kindOf :: SVal -> Kind
kindOf (SVal Kind
k Either CV (Cached SV)
_) = Kind
k

-- Show instance for 'SVal'. Not particularly "desirable", but will do if needed
-- NB. We do not show the type info on constant KBool values, since there's no
-- implicit "fromBoolean" applied to Booleans in Haskell; and thus a statement
-- of the form "True :: SBool" is just meaningless. (There should be a fromBoolean!)
instance Show SVal where
  show :: SVal -> [Char]
show (SVal Kind
KBool (Left CV
c))  = Bool -> CV -> [Char]
showCV Bool
False CV
c
  show (SVal Kind
k     (Left CV
c))  = Bool -> CV -> [Char]
showCV Bool
False CV
c forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
  show (SVal Kind
k     (Right Cached SV
_)) =         [Char]
"<symbolic> :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k

-- | This instance is only defined so that we can define an instance for
-- 'Data.Bits.Bits'. '==' and '/=' simply throw an error.
-- We really don't want an 'Eq' instance for 'Data.SBV.Core.SBV' or 'SVal'. As it really makes no sense.
-- But since we do want the 'Data.Bits.Bits' instance, we're forced to define equality. See
-- <http://github.com/LeventErkok/sbv/issues/301>. We simply error out.
instance Eq SVal where
  SVal
a == :: SVal -> SVal -> Bool
== SVal
b = forall a. [Char] -> [Char] -> ([Char], [Char]) -> a
noEquals [Char]
"==" [Char]
".==" (forall a. Show a => a -> [Char]
show SVal
a, forall a. Show a => a -> [Char]
show SVal
b)
  SVal
a /= :: SVal -> SVal -> Bool
/= SVal
b = forall a. [Char] -> [Char] -> ([Char], [Char]) -> a
noEquals [Char]
"/=" [Char]
"./=" (forall a. Show a => a -> [Char]
show SVal
a, forall a. Show a => a -> [Char]
show SVal
b)

-- Bail out nicely.
noEquals :: String -> String -> (String, String) -> a
noEquals :: forall a. [Char] -> [Char] -> ([Char], [Char]) -> a
noEquals [Char]
o [Char]
n ([Char]
l, [Char]
r) = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
                                      , [Char]
"*** Data.SBV: Comparing symbolic values using Haskell's Eq class!"
                                      , [Char]
"***"
                                      , [Char]
"*** Received:    " forall a. [a] -> [a] -> [a]
++ [Char]
l forall a. [a] -> [a] -> [a]
++ [Char]
"  " forall a. [a] -> [a] -> [a]
++ [Char]
o forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
r
                                      , [Char]
"*** Instead use: " forall a. [a] -> [a] -> [a]
++ [Char]
l forall a. [a] -> [a] -> [a]
++ [Char]
" "  forall a. [a] -> [a] -> [a]
++ [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
r
                                      , [Char]
"***"
                                      , [Char]
"*** The Eq instance for symbolic values are necessiated only because"
                                      , [Char]
"*** of the Bits class requirement. You must use symbolic equality"
                                      , [Char]
"*** operators instead. (And complain to Haskell folks that they"
                                      , [Char]
"*** remove the 'Eq' superclass from 'Bits'!.)"
                                      ]

-- | Things we do not support in interactive mode, at least for now!
noInteractive :: [String] -> a
noInteractive :: forall a. [[Char]] -> a
noInteractive [[Char]]
ss = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$  [Char]
""
                                   forall a. a -> [a] -> [a]
:  [Char]
"*** Data.SBV: Unsupported interactive/query mode feature."
                                   forall a. a -> [a] -> [a]
:  forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"***  " forall a. [a] -> [a] -> [a]
++) [[Char]]
ss
                                   forall a. [a] -> [a] -> [a]
++ [[Char]
"*** Data.SBV: Please report this as a feature request!"]

-- | Things we do not support in interactive mode, nor we ever intend to
noInteractiveEver :: [String] -> a
noInteractiveEver :: forall a. [[Char]] -> a
noInteractiveEver [[Char]]
ss = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$  [Char]
""
                                       forall a. a -> [a] -> [a]
:  [Char]
"*** Data.SBV: Unsupported interactive/query mode feature."
                                       forall a. a -> [a] -> [a]
:  forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"***  " forall a. [a] -> [a] -> [a]
++) [[Char]]
ss

-- | Modification of the state, but carefully handling the interactive tasks.
-- Note that the state is always updated regardless of the mode, but we get
-- to also perform extra operation in interactive mode. (Typically error out, but also simply
-- ignore if it has no impact.)
modifyState :: State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState :: forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState st :: State
st@State{IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode} State -> IORef a
field a -> a
update IO ()
interactiveUpdate = do
        forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (State -> IORef a
field State
st) a -> a
update
        SBVRunMode
rm <- forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
        case SBVRunMode
rm of
          SMTMode QueryContext
_ IStage
IRun Bool
_ SMTConfig
_ -> IO ()
interactiveUpdate
          SBVRunMode
_                  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Modify the incremental state
modifyIncState  :: State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState :: forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State{IORef IncState
rIncState :: IORef IncState
rIncState :: State -> IORef IncState
rIncState} IncState -> IORef a
field a -> a
update = do
        IncState
incState <- forall a. IORef a -> IO a
readIORef IORef IncState
rIncState
        forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (IncState -> IORef a
field IncState
incState) a -> a
update

-- | Add an observable
-- notice that we cons like a list, we should build at the end of the seq, but cons to preserve semantics for now
recordObservable :: State -> String -> (CV -> Bool) -> SV -> IO ()
recordObservable :: State -> [Char] -> (CV -> Bool) -> SV -> IO ()
recordObservable State
st ([Char] -> Name
T.pack -> Name
nm) CV -> Bool
chk SV
sv = forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Seq (Name, CV -> Bool, SV))
rObservables ((Name
nm, CV -> Bool
chk, SV
sv) forall a. a -> Seq a -> Seq a
S.<|) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Increment the variable counter
incrementInternalCounter :: State -> IO Int
incrementInternalCounter :: State -> IO Int
incrementInternalCounter State
st = do Int
ctr <- forall a. IORef a -> IO a
readIORef (State -> IORef Int
rctr State
st)
                                 forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef Int
rctr (forall a. Num a => a -> a -> a
+Int
1) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                 forall (m :: * -> *) a. Monad m => a -> m a
return Int
ctr

-- | Uninterpreted constants and functions. An uninterpreted constant is
-- a value that is indexed by its name. The only property the prover assumes
-- about these values are that they are equivalent to themselves; i.e., (for
-- functions) they return the same results when applied to same arguments.
-- We support uninterpreted-functions as a general means of black-box'ing
-- operations that are /irrelevant/ for the purposes of the proof; i.e., when
-- the proofs can be performed without any knowledge about the function itself.
svUninterpreted :: Kind -> String -> Maybe [String] -> [SVal] -> SVal
svUninterpreted :: Kind -> [Char] -> Maybe [[Char]] -> [SVal] -> SVal
svUninterpreted Kind
k [Char]
nm Maybe [[Char]]
code [SVal]
args = Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
  where result :: State -> IO SV
result State
st = do let ty :: SBVType
ty = [Kind] -> SBVType
SBVType (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasKind a => a -> Kind
kindOf [SVal]
args forall a. [a] -> [a] -> [a]
++ [Kind
k])
                       State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm SBVType
ty Maybe [[Char]]
code
                       [SV]
sws <- 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
                       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 forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV]
sws

-- | Create a new uninterpreted symbol, possibly with user given code
newUninterpreted :: State -> String -> SBVType -> Maybe [String] -> IO ()
newUninterpreted :: State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm SBVType
t Maybe [[Char]]
mbCode
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
nm Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
enclosed Bool -> Bool -> Bool
&& (Bool -> Bool
not (Char -> Bool
isAlpha (forall a. [a] -> a
head [Char]
nm)) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validChar (forall a. [a] -> [a]
tail [Char]
nm)))
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Bad uninterpreted constant name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
". Must be a valid identifier."
  | Bool
True = do UIMap
uiMap <- forall a. IORef a -> IO a
readIORef (State -> IORef UIMap
rUIMap State
st)
              case [Char]
nm forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` UIMap
uiMap of
                Just SBVType
t' -> forall r. SBVType -> r -> r
checkType SBVType
t' (forall (m :: * -> *) a. Monad m => a -> m a
return ())
                Maybe SBVType
Nothing -> do forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef UIMap
rUIMap (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
nm SBVType
t)
                                        forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef UIMap
rNewUIs (\UIMap
newUIs -> case [Char]
nm forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` UIMap
newUIs of
                                                                                  Just SBVType
t' -> forall r. SBVType -> r -> r
checkType SBVType
t' UIMap
newUIs
                                                                                  Maybe SBVType
Nothing -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
nm SBVType
t UIMap
newUIs)

                              -- No need to record the code in interactive mode: CodeGen doesn't use interactive
                              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe [[Char]]
mbCode) forall a b. (a -> b) -> a -> b
$ forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef CgMap
rCgMap (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
nm (forall a. HasCallStack => Maybe a -> a
fromJust Maybe [[Char]]
mbCode)) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where checkType :: SBVType -> r -> r
        checkType :: forall r. SBVType -> r -> r
checkType SBVType
t' r
cont
          | SBVType
t forall a. Eq a => a -> a -> Bool
/= SBVType
t' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$  [Char]
"Uninterpreted constant " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" used at incompatible types\n"
                            forall a. [a] -> [a] -> [a]
++ [Char]
"      Current type      : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBVType
t forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
                            forall a. [a] -> [a] -> [a]
++ [Char]
"      Previously used at: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBVType
t'
          | Bool
True    = r
cont

        validChar :: Char -> Bool
validChar Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"_" :: String)
        enclosed :: Bool
enclosed    = forall a. [a] -> a
head [Char]
nm forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
&& forall a. [a] -> a
last [Char]
nm forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
nm forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"|\\" :: String)) (forall a. [a] -> [a]
tail (forall a. [a] -> [a]
init [Char]
nm)))

-- | Add a new sAssert based constraint
addAssertion :: State -> Maybe CallStack -> String -> SV -> IO ()
addAssertion :: State -> Maybe CallStack -> [Char] -> SV -> IO ()
addAssertion State
st Maybe CallStack
cs [Char]
msg SV
cond = forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [([Char], Maybe CallStack, SV)]
rAsserts (([Char]
msg, Maybe CallStack
cs, SV
cond)forall a. a -> [a] -> [a]
:)
                                        forall a b. (a -> b) -> a -> b
$ forall a. [[Char]] -> a
noInteractive [ [Char]
"Named assertions (sAssert):"
                                                        , [Char]
"  Tag: " forall a. [a] -> [a] -> [a]
++ [Char]
msg
                                                        , [Char]
"  Loc: " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Unknown" forall a. Show a => a -> [Char]
show Maybe CallStack
cs
                                                        ]

-- | Create an internal variable, which acts as an input but isn't visible to the user.
-- Such variables are existentially quantified in a SAT context, and universally quantified
-- in a proof context.
internalVariable :: State -> Kind -> IO SV
internalVariable :: State -> Kind -> IO SV
internalVariable State
st Kind
k = do (NamedSymVar SV
sv Name
nm) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
                           SBVRunMode
rm <- forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)
                           let q :: Quantifier
q = case SBVRunMode
rm of
                                     SMTMode  QueryContext
_ IStage
_ Bool
True  SMTConfig
_ -> Quantifier
EX
                                     SMTMode  QueryContext
_ IStage
_ Bool
False SMTConfig
_ -> Quantifier
ALL
                                     SBVRunMode
CodeGen              -> Quantifier
ALL
                                     Concrete{}           -> Quantifier
ALL
                               n :: Name
n = Name
"__internal_sbv_" forall a. Semigroup a => a -> a -> a
<> Name
nm
                               v :: NamedSymVar
v = SV -> Name -> NamedSymVar
NamedSymVar SV
sv Name
n
                           forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef Inputs
rinps (Quantifier -> SV -> Name -> Inputs -> Inputs
addUserInput Quantifier
q SV
sv Name
n)
                                     forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef [NamedSymVar]
rNewInps (\[NamedSymVar]
newInps -> case Quantifier
q of
                                                                                 Quantifier
EX -> NamedSymVar
v forall a. a -> [a] -> [a]
: [NamedSymVar]
newInps
                                                                                 -- I don't think the following can actually happen
                                                                                 -- but just be safe:
                                                                                 Quantifier
ALL  -> forall a. [[Char]] -> a
noInteractive [ [Char]
"Internal universally quantified variable creation:"
                                                                                                       , [Char]
"  Named: " forall a. Semigroup a => a -> a -> a
<> Name -> [Char]
T.unpack Name
nm
                                                                                                       ])
                           forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
{-# INLINE internalVariable #-}

-- | Create a new SV
newSV :: State -> Kind -> IO NamedSymVar
newSV :: State -> Kind -> IO NamedSymVar
newSV State
st 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
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SV -> Name -> NamedSymVar
NamedSymVar SV
sv forall a b. (a -> b) -> a -> b
$ Char
's' Char -> Name -> Name
`T.cons` [Char] -> Name
T.pack (forall a. Show a => a -> [Char]
show Int
ctr)
{-# INLINE newSV #-}

-- | Register a new kind with the system, used for uninterpreted sorts.
-- NB: Is it safe to have new kinds in query mode? It could be that
-- the new kind might introduce a constraint that effects the logic. For
-- instance, if we're seeing 'Double' for the first time and using a BV
-- logic, then things would fall apart. But this should be rare, and hopefully
-- the success-response checking mechanism will catch the rare cases where this
-- is an issue. In either case, the user can always arrange for the right
-- logic by calling 'Data.SBV.setLogic' appropriately, so it seems safe to just
-- allow for this.
registerKind :: State -> Kind -> IO ()
registerKind :: State -> Kind -> IO ()
registerKind State
st Kind
k
  | KUserSort [Char]
sortName Maybe [[Char]]
_ <- Kind
k, forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
sortName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
smtLibReservedNames
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
sortName forall a. [a] -> [a] -> [a]
++ [Char]
" is a reserved sort; please use a different name."
  | Bool
True
  = do -- Adding a kind to the incState is tricky; we only need to add it
       --     *    If it's an uninterpreted sort that's not already in the general state
       --     * OR If it's a tuple-sort whose cardinality isn't already in the general state
       --     * OR If it's a list that's not already in the general state (so we can send the flatten commands)

       Set Kind
existingKinds <- forall a. IORef a -> IO a
readIORef (State -> IORef (Set Kind)
rUsedKinds State
st)

       forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Set Kind)
rUsedKinds (forall a. Ord a => a -> Set a -> Set a
Set.insert Kind
k) forall a b. (a -> b) -> a -> b
$ do

                          -- Why do we discriminate here? Because the incremental context is sensitive to the
                          -- order: In particular, if an uninterpreted kind is already in there, we don't
                          -- want to re-add because double-declaration would be wrong. See 'cvtInc' for details.
                          let needsAdding :: Bool
needsAdding = case Kind
k of
                                              KUserSort{} -> Kind
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              KList{}     -> Kind
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              KTuple [Kind]
nks  -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
nks forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
oks | KTuple [Kind]
oks <- forall a. Set a -> [a]
Set.toList Set Kind
existingKinds]
                                              KMaybe{}    -> Kind
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              KEither{}   -> Kind
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              Kind
_           -> Bool
False

                          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsAdding forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef (Set Kind)
rNewKinds (forall a. Ord a => a -> Set a -> Set a
Set.insert Kind
k)

       -- Don't forget to register subkinds!
       case Kind
k of
         KBool     {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KBounded  {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KUnbounded{}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KReal     {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KUserSort {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KFloat    {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KDouble   {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KFP       {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KRational {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KChar     {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KString   {}    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         KList     Kind
ek    -> State -> Kind -> IO ()
registerKind State
st Kind
ek
         KSet      Kind
ek    -> State -> Kind -> IO ()
registerKind State
st Kind
ek
         KTuple    [Kind]
eks   -> 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    Kind
ke    -> State -> Kind -> IO ()
registerKind State
st Kind
ke
         KEither   Kind
k1 Kind
k2 -> 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]

-- | Register a new label with the system, making sure they are unique and have no '|'s in them
registerLabel :: String -> State -> String -> IO ()
registerLabel :: [Char] -> State -> [Char] -> IO ()
registerLabel [Char]
whence State
st [Char]
nm
  | forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
nm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
smtLibReservedNames
  = [Char] -> IO ()
err [Char]
"is a reserved string; please use a different name."
  | Char
'|' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
nm
  = [Char] -> IO ()
err [Char]
"contains the character `|', which is not allowed!"
  | Char
'\\' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
nm
  = [Char] -> IO ()
err [Char]
"contains the character `\\', which is not allowed!"
  | Bool
True
  = do Set [Char]
old <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ State -> IORef (Set [Char])
rUsedLbls State
st
       if [Char]
nm forall a. Ord a => a -> Set a -> Bool
`Set.member` Set [Char]
old
          then [Char] -> IO ()
err [Char]
"is used multiple times. Please do not use duplicate names!"
          else forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Set [Char])
rUsedLbls (forall a. Ord a => a -> Set a -> Set a
Set.insert [Char]
nm) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

  where err :: [Char] -> IO ()
err [Char]
w = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV (" forall a. [a] -> [a] -> [a]
++ [Char]
whence forall a. [a] -> [a] -> [a]
++ [Char]
"): " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
w

-- | Create a new constant; hash-cons as necessary
newConst :: State -> CV -> IO SV
newConst :: State -> CV -> IO SV
newConst State
st CV
c = do
  CnstMap
constMap <- forall a. IORef a -> IO a
readIORef (State -> IORef CnstMap
rconstMap State
st)
  case CV
c forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` CnstMap
constMap of
    -- NB. Unlike in 'newExpr', we don't have to make sure the returned sv
    -- has the kind we asked for, because the constMap stores the full CV
    -- which already has a kind field in it.
    Just SV
sv -> forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
    Maybe SV
Nothing -> do (NamedSymVar SV
sv Name
_) <- State -> Kind -> IO NamedSymVar
newSV State
st (forall a. HasKind a => a -> Kind
kindOf CV
c)
                  let ins :: CnstMap -> CnstMap
ins = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CV
c SV
sv
                  forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef CnstMap
rconstMap CnstMap -> CnstMap
ins forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef CnstMap
rNewConsts CnstMap -> CnstMap
ins
                  forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
{-# INLINE newConst #-}

-- | Create a new table; hash-cons as necessary
getTableIndex :: State -> Kind -> Kind -> [SV] -> IO Int
getTableIndex :: State -> Kind -> Kind -> [SV] -> IO Int
getTableIndex State
st Kind
at Kind
rt [SV]
elts = do
  let key :: (Kind, Kind, [SV])
key = (Kind
at, Kind
rt, [SV]
elts)
  TableMap
tblMap <- forall a. IORef a -> IO a
readIORef (State -> IORef TableMap
rtblMap State
st)
  case (Kind, Kind, [SV])
key forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` TableMap
tblMap of
    Just Int
i -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
    Maybe Int
_      -> do let i :: Int
i   = forall k a. Map k a -> Int
Map.size TableMap
tblMap
                     upd :: TableMap -> TableMap
upd = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Kind, Kind, [SV])
key Int
i
                 forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef TableMap
rtblMap TableMap -> TableMap
upd forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef TableMap
rNewTbls TableMap -> TableMap
upd
                 forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- | Create a new expression; hash-cons as necessary
newExpr :: State -> Kind -> SBVExpr -> IO SV
newExpr :: State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k SBVExpr
app = do
   let e :: SBVExpr
e = SBVExpr -> SBVExpr
reorder SBVExpr
app
   ExprMap
exprMap <- forall a. IORef a -> IO a
readIORef (State -> IORef ExprMap
rexprMap State
st)
   case SBVExpr
e forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ExprMap
exprMap of
     -- NB. Check to make sure that the kind of the hash-consed value
     -- is the same kind as we're requesting. This might look unnecessary,
     -- at first, but `svSign` and `svUnsign` rely on this as we can
     -- get the same expression but at a different type. See
     -- <http://github.com/GaloisInc/cryptol/issues/566> as an example.
     Just SV
sv | forall a. HasKind a => a -> Kind
kindOf SV
sv forall a. Eq a => a -> a -> Bool
== Kind
k -> forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
     Maybe SV
_                        -> do (NamedSymVar SV
sv Name
_) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
                                    let append :: SBVPgm -> SBVPgm
append (SBVPgm Seq (SV, SBVExpr)
xs) = Seq (SV, SBVExpr) -> SBVPgm
SBVPgm (Seq (SV, SBVExpr)
xs forall a. Seq a -> a -> Seq a
S.|> (SV
sv, SBVExpr
e))
                                    forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef SBVPgm
spgm SBVPgm -> SBVPgm
append forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef SBVPgm
rNewAsgns SBVPgm -> SBVPgm
append
                                    forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef ExprMap
rexprMap (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SBVExpr
e SV
sv) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                    forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
{-# INLINE newExpr #-}

-- | Convert a symbolic value to an internal SV
svToSV :: State -> SVal -> IO SV
svToSV :: State -> SVal -> IO SV
svToSV State
st (SVal Kind
_ (Left CV
c))  = State -> CV -> IO SV
newConst State
st CV
c
svToSV State
st (SVal Kind
_ (Right Cached SV
f)) = Cached SV -> State -> IO SV
uncache Cached SV
f State
st

-- | Generalization of 'Data.SBV.svToSymSV'
svToSymSV :: MonadSymbolic m => SVal -> m SV
svToSymSV :: forall (m :: * -> *). MonadSymbolic m => SVal -> m SV
svToSymSV SVal
sbv = do State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
                   forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ State -> SVal -> IO SV
svToSV State
st SVal
sbv

-------------------------------------------------------------------------
-- * Symbolic Computations
-------------------------------------------------------------------------
-- | A Symbolic computation. Represented by a reader monad carrying the
-- state of the computation, layered on top of IO for creating unique
-- references to hold onto intermediate results.

-- | Computations which support symbolic operations
class MonadIO m => MonadSymbolic m where
  symbolicEnv :: m State

  default symbolicEnv :: (MonadTrans t, MonadSymbolic m', m ~ t m') => m State
  symbolicEnv = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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)

-- | A generalization of 'Data.SBV.Symbolic'.
newtype SymbolicT m a = SymbolicT { forall (m :: * -> *) a. SymbolicT m a -> ReaderT State m a
runSymbolicT :: ReaderT State m a }
                   deriving ( 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
<* :: forall a b. 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
*> :: forall a b. 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 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> SymbolicT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SymbolicT m a
Applicative, 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
<$ :: forall a b. a -> SymbolicT m b -> SymbolicT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SymbolicT m b -> SymbolicT m a
fmap :: forall a b. (a -> b) -> SymbolicT m a -> SymbolicT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SymbolicT m a -> SymbolicT m b
Functor, 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 :: forall a. a -> SymbolicT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> SymbolicT m a
>> :: forall a b. 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
>>= :: forall a 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
Monad, 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 :: forall a. IO a -> SymbolicT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SymbolicT m a
MonadIO, 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 :: forall (m :: * -> *) a. Monad m => 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)
                            , forall a. [Char] -> SymbolicT m a
forall (m :: * -> *).
Monad m -> (forall a. [Char] -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (SymbolicT m)
forall (m :: * -> *) a. MonadFail m => [Char] -> SymbolicT m a
fail :: forall a. [Char] -> SymbolicT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => [Char] -> SymbolicT m a
Fail.MonadFail
#endif
                            )

-- | `MonadSymbolic` instance for `SymbolicT m`
instance MonadIO m => MonadSymbolic (SymbolicT m) where
  symbolicEnv :: SymbolicT m State
symbolicEnv = forall (m :: * -> *) a. ReaderT State m a -> SymbolicT m a
SymbolicT forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Map a computation over the symbolic transformer.
mapSymbolicT :: (ReaderT State m a -> ReaderT State n b) -> SymbolicT m a -> SymbolicT n b
mapSymbolicT :: 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 n b
f = forall (m :: * -> *) a. ReaderT State m a -> SymbolicT m a
SymbolicT forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT State m a -> ReaderT State n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. SymbolicT m a -> ReaderT State m a
runSymbolicT
{-# INLINE mapSymbolicT #-}

-- Have to define this one by hand, because we use ReaderT in the implementation
instance MonadReader r m => MonadReader r (SymbolicT m) where
  ask :: SymbolicT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> SymbolicT m a -> SymbolicT m a
local r -> r
f = forall (m :: * -> *) a (n :: * -> *) b.
(ReaderT State m a -> ReaderT State n b)
-> SymbolicT m a -> SymbolicT n b
mapSymbolicT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f

-- | `Symbolic` is specialization of `SymbolicT` to the `IO` monad. Unless you are using
-- transformers explicitly, this is the type you should prefer.
type Symbolic = SymbolicT IO

-- | Create a symbolic value, based on the quantifier we have. If an
-- explicit quantifier is given, we just use that. If not, then we
-- pick the quantifier appropriately based on the run-mode.
-- @randomCV@ is used for generating random values for this variable
-- when used for @quickCheck@ or 'Data.SBV.Tools.GenTest.genTest' purposes.
svMkSymVar :: VarContext -> Kind -> Maybe String -> State -> IO SVal
svMkSymVar :: VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar = Bool -> VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVarGen Bool
False

-- | Create an existentially quantified tracker variable
svMkTrackerVar :: Kind -> String -> State -> IO SVal
svMkTrackerVar :: Kind -> [Char] -> State -> IO SVal
svMkTrackerVar Kind
k [Char]
nm = Bool -> VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVarGen Bool
True (Maybe Quantifier -> VarContext
NonQueryVar (forall a. a -> Maybe a
Just Quantifier
EX)) Kind
k (forall a. a -> Maybe a
Just [Char]
nm)

-- | Generalization of 'Data.SBV.sWordN'
sWordN :: MonadSymbolic m => Int -> String -> m SVal
sWordN :: forall (m :: * -> *). MonadSymbolic m => Int -> [Char] -> m SVal
sWordN Int
w [Char]
nm = forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
False Int
w) (forall a. a -> Maybe a
Just [Char]
nm)

-- | Generalization of 'Data.SBV.sWordN_'
sWordN_ :: MonadSymbolic m => Int -> m SVal
sWordN_ :: forall (m :: * -> *). MonadSymbolic m => Int -> m SVal
sWordN_ Int
w = forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
False Int
w) forall a. Maybe a
Nothing

-- | Generalization of 'Data.SBV.sIntN'
sIntN :: MonadSymbolic m => Int -> String -> m SVal
sIntN :: forall (m :: * -> *). MonadSymbolic m => Int -> [Char] -> m SVal
sIntN Int
w [Char]
nm = forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
True Int
w) (forall a. a -> Maybe a
Just [Char]
nm)

-- | Generalization of 'Data.SBV.sIntN_'
sIntN_ :: MonadSymbolic m => Int -> m SVal
sIntN_ :: forall (m :: * -> *). MonadSymbolic m => Int -> m SVal
sIntN_ Int
w = forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
True Int
w) forall a. Maybe a
Nothing

-- | Create a symbolic value, based on the quantifier we have. If an
-- explicit quantifier is given, we just use that. If not, then we
-- pick the quantifier appropriately based on the run-mode.
-- @randomCV@ is used for generating random values for this variable
-- when used for @quickCheck@ or 'Data.SBV.Tools.GenTest.genTest' purposes.
svMkSymVarGen :: Bool -> VarContext -> Kind -> Maybe String -> State -> IO SVal
svMkSymVarGen :: Bool -> VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVarGen Bool
isTracker VarContext
varContext Kind
k Maybe [Char]
mbNm State
st = do
        SBVRunMode
rm <- forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)

        let varInfo :: [Char]
varInfo = case Maybe [Char]
mbNm of
                        Maybe [Char]
Nothing -> [Char]
", of type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                        Just [Char]
nm -> [Char]
", while defining " forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k

            disallow :: [Char] -> IO SVal
disallow [Char]
what  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Data.SBV: Unsupported: " forall a. [a] -> [a] -> [a]
++ [Char]
what forall a. [a] -> [a] -> [a]
++ [Char]
varInfo forall a. [a] -> [a] -> [a]
++ [Char]
" in mode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBVRunMode
rm

            noUI :: IO SVal -> IO SVal
noUI IO SVal
cont
              | forall a. HasKind a => a -> Bool
isUserSort Kind
k  = [Char] -> IO SVal
disallow [Char]
"User defined sorts"
              | Bool
True          = IO SVal
cont

            (Bool
isQueryVar, Maybe Quantifier
mbQ) = case VarContext
varContext of
                                  NonQueryVar Maybe Quantifier
mq -> (Bool
False, Maybe Quantifier
mq)
                                  VarContext
QueryVar       -> (Bool
True,  forall a. a -> Maybe a
Just Quantifier
EX)

            mkS :: Quantifier -> IO SVal
mkS Quantifier
q = do (NamedSymVar SV
sv Name
internalName) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
                       let nm :: [Char]
nm = forall a. a -> Maybe a -> a
fromMaybe (Name -> [Char]
T.unpack Name
internalName) Maybe [Char]
mbNm
                       State
-> (Bool, Bool) -> [Char] -> Kind -> Quantifier -> SV -> IO SVal
introduceUserName State
st (Bool
isQueryVar, Bool
isTracker) [Char]
nm Kind
k Quantifier
q SV
sv

            mkC :: CV -> IO SVal
mkC CV
cv = do State -> Kind -> IO ()
registerKind State
st Kind
k
                        forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [([Char], CV)]
rCInfo ((forall a. a -> Maybe a -> a
fromMaybe [Char]
"_" Maybe [Char]
mbNm, CV
cv)forall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (forall a b. a -> Either a b
Left CV
cv)

        case (Maybe Quantifier
mbQ, SBVRunMode
rm) of
          (Just Quantifier
q,  SMTMode{}          ) -> Quantifier -> IO SVal
mkS Quantifier
q
          (Maybe Quantifier
Nothing, SMTMode QueryContext
_ IStage
_ Bool
isSAT SMTConfig
_) -> Quantifier -> IO SVal
mkS (if Bool
isSAT then Quantifier
EX else Quantifier
ALL)

          (Just Quantifier
EX, CodeGen{})           -> [Char] -> IO SVal
disallow [Char]
"Existentially quantified variables"
          (Maybe Quantifier
_      , SBVRunMode
CodeGen)             -> IO SVal -> IO SVal
noUI forall a b. (a -> b) -> a -> b
$ Quantifier -> IO SVal
mkS Quantifier
ALL  -- code generation, pick universal

          (Just Quantifier
EX, Concrete Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)])
Nothing)    -> [Char] -> IO SVal
disallow [Char]
"Existentially quantified variables"
          (Maybe Quantifier
_      , Concrete Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)])
Nothing)    -> IO SVal -> IO SVal
noUI (Kind -> IO CV
randomCV Kind
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CV -> IO SVal
mkC)

          -- Model validation:
          (Maybe Quantifier
_      , Concrete (Just (Bool
_isSat, [((Quantifier, NamedSymVar), Maybe CV)]
env))) -> do
                        let bad :: [Char] -> [Char] -> a
bad [Char]
why [Char]
conc = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
                                                           , [Char]
"*** Data.SBV: " forall a. [a] -> [a] -> [a]
++ [Char]
why
                                                           , [Char]
"***"
                                                           , [Char]
"***   To turn validation off, use `cfg{validateModel = False}`"
                                                           , [Char]
"***"
                                                           , [Char]
"*** " forall a. [a] -> [a] -> [a]
++ [Char]
conc
                                                           ]

                            cant :: [Char]
cant   = [Char]
"Validation engine is not capable of handling this case. Failed to validate."
                            report :: [Char]
report = [Char]
"Please report this as a bug in SBV!"

                        case () of
                          () | forall a. HasKind a => a -> Bool
isUserSort Kind
k -> forall {a}. [Char] -> [Char] -> a
bad ([Char]
"Cannot validate models in the presence of user defined kinds, saw: "             forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k) [Char]
cant

                          ()
_  -> do (NamedSymVar SV
sv Name
internalName) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k

                                   let nm :: [Char]
nm = forall a. a -> Maybe a -> a
fromMaybe (Name -> [Char]
T.unpack Name
internalName) Maybe [Char]
mbNm
                                       nsv :: NamedSymVar
nsv = SV -> [Char] -> NamedSymVar
toNamedSV' SV
sv [Char]
nm

                                       cv :: CV
cv = case [(Quantifier
q, Maybe CV
v) | ((Quantifier
q, NamedSymVar
nsv'), Maybe CV
v) <- [((Quantifier, NamedSymVar), Maybe CV)]
env, NamedSymVar
nsv forall a. Eq a => a -> a -> Bool
== NamedSymVar
nsv'] of
                                              []              -> if Bool
isTracker
                                                                 then  -- The sole purpose of a tracker variable is to send the optimization
                                                                       -- directive to the solver, so we can name "expressions" that are minimized
                                                                       -- or maximized. There will be no constraints on these when we are doing
                                                                       -- the validation; in fact they will not even be used anywhere during a
                                                                       -- validation run. So, simply push a zero value that inhabits all metrics.
                                                                       forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k (Integer
0::Integer)
                                                                 else forall {a}. [Char] -> [Char] -> a
bad ([Char]
"Cannot locate variable: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (NamedSymVar
nsv, Kind
k)) [Char]
report
                                              [(Quantifier
ALL, Maybe CV
_)]      -> -- We can stop here, as we can't really validate in the presence of a universal quantifier:
                                                                 -- we'd have to validate for each possible value. But that's more or less useless. Instead,
                                                                 -- just issue a warning and use 0 for this value.
                                                                 forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k (Integer
0::Integer)
                                              [(Quantifier
EX, Maybe CV
Nothing)] -> forall {a}. [Char] -> [Char] -> a
bad ([Char]
"Cannot locate model value of variable: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (NamedSymVar -> [Char]
getUserName' NamedSymVar
nsv)) [Char]
report
                                              [(Quantifier
EX, Just CV
c)]  -> CV
c
                                              [(Quantifier, Maybe CV)]
r               -> forall {a}. [Char] -> [Char] -> a
bad (   [Char]
"Found multiple matching values for variable: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show NamedSymVar
nsv
                                                                      forall a. [a] -> [a] -> [a]
++ [Char]
"\n*** " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [(Quantifier, Maybe CV)]
r) [Char]
report

                                   CV -> IO SVal
mkC CV
cv

-- | Introduce a new user name. We simply append a suffix if we have seen this variable before.
introduceUserName :: State -> (Bool, Bool) -> String -> Kind -> Quantifier -> SV -> IO SVal
introduceUserName :: State
-> (Bool, Bool) -> [Char] -> Kind -> Quantifier -> SV -> IO SVal
introduceUserName st :: State
st@State{IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode} (Bool
isQueryVar, Bool
isTracker) [Char]
nmOrig Kind
k Quantifier
q SV
sv = do
        AllInps
old <- Inputs -> AllInps
allInputs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef (State -> IORef Inputs
rinps State
st)

        let nm :: Name
nm  = Name -> AllInps -> Name
mkUnique ([Char] -> Name
T.pack [Char]
nmOrig) AllInps
old

        -- If this is not a query variable and we're in a query, reject it.
        -- See https://github.com/LeventErkok/sbv/issues/554 for the rationale.
        -- In theory, it should be possible to support this, but fixing it is
        -- rather costly as we'd have to track the regular updates and sync the
        -- incremental state appropriately. Instead, we issue an error message
        -- and ask the user to obey the query mode rules.
        SBVRunMode
rm <- forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
        case SBVRunMode
rm of
          SMTMode QueryContext
_ IStage
IRun Bool
_ SMTConfig
_ | Bool -> Bool
not Bool
isQueryVar -> forall a. [[Char]] -> a
noInteractiveEver [ [Char]
"Adding a new input variable in query mode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
nm
                                                                   , [Char]
""
                                                                   , [Char]
"Hint: Use freshVar/freshVar_ for introducing new inputs in query mode."
                                                                   ]
          SBVRunMode
_                                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        if Bool
isTracker Bool -> Bool -> Bool
&& Quantifier
q forall a. Eq a => a -> a -> Bool
== Quantifier
ALL
           then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV: Impossible happened! A universally quantified tracker variable is being introduced: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
nm
           else do let newInp :: [NamedSymVar] -> [NamedSymVar]
newInp [NamedSymVar]
olds = case Quantifier
q of
                                      Quantifier
EX  -> SV -> Name -> NamedSymVar
toNamedSV SV
sv Name
nm forall a. a -> [a] -> [a]
: [NamedSymVar]
olds
                                      Quantifier
ALL -> forall a. [[Char]] -> a
noInteractive [ [Char]
"Adding a new universally quantified variable: "
                                                           , [Char]
"  Name      : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
nm
                                                           , [Char]
"  Kind      : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                                                           , [Char]
"  Quantifier: Universal"
                                                           , [Char]
"  Node      : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SV
sv
                                                           , [Char]
"Only existential variables are supported in query mode."
                                                           ]
                   if Bool
isTracker
                      then forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef Inputs
rinps (SV -> Name -> Inputs -> Inputs
addInternInput SV
sv Name
nm)
                                     forall a b. (a -> b) -> a -> b
$ forall a. [[Char]] -> a
noInteractive [[Char]
"Adding a new tracker variable in interactive mode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Name
nm]
                      else forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef Inputs
rinps (Quantifier -> SV -> Name -> Inputs -> Inputs
addUserInput Quantifier
q SV
sv Name
nm)
                                     forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef [NamedSymVar]
rNewInps [NamedSymVar] -> [NamedSymVar]
newInp
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv))

   where -- The following can be rather slow if we keep reusing the same prefix, but I doubt it'll be a problem in practice
         -- Also, the following will fail if we span the range of integers without finding a match, but your computer would
         -- die way ahead of that happening if that's the case!
         mkUnique :: T.Text -> Set.Set Name -> T.Text
         mkUnique :: Name -> AllInps -> Name
mkUnique Name
prefix AllInps
names = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> Set a -> Bool
`Set.member` AllInps
names) (Name
prefix forall a. a -> [a] -> [a]
: [Name
prefix forall a. Semigroup a => a -> a -> a
<> Name
"_" forall a. Semigroup a => a -> a -> a
<> [Char] -> Name
T.pack (forall a. Show a => a -> [Char]
show Int
i) | Int
i <- [(Int
0::Int)..]])

-- | Generalization of 'Data.SBV.runSymbolic'
runSymbolic :: MonadIO m => SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic :: forall (m :: * -> *) a.
MonadIO m =>
SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic SBVRunMode
currentRunMode (SymbolicT ReaderT State m a
c) = do
   State
st <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
     UTCTime
currTime  <- IO UTCTime
getCurrentTime
     IORef SBVRunMode
rm        <- forall a. a -> IO (IORef a)
newIORef SBVRunMode
currentRunMode
     IORef Int
ctr       <- forall a. a -> IO (IORef a)
newIORef (-Int
2) -- start from -2; False and True will always occupy the first two elements
     IORef [([Char], CV)]
cInfo     <- forall a. a -> IO (IORef a)
newIORef []
     IORef (Seq (Name, CV -> Bool, SV))
observes  <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
     IORef SBVPgm
pgm       <- forall a. a -> IO (IORef a)
newIORef (Seq (SV, SBVExpr) -> SBVPgm
SBVPgm forall a. Seq a
S.empty)
     IORef ExprMap
emap      <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
     IORef CnstMap
cmap      <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
     IORef Inputs
inps      <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
     IORef [SV]
outs      <- forall a. a -> IO (IORef a)
newIORef []
     IORef TableMap
tables    <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
     IORef ArrayMap
arrays    <- forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
IMap.empty
     IORef FArrayMap
fArrays   <- forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
IMap.empty
     IORef UIMap
uis       <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
     IORef CgMap
cgs       <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
     IORef [(Bool, [Char], [[Char]])]
axioms    <- forall a. a -> IO (IORef a)
newIORef []
     IORef (Cache SV)
swCache   <- forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
IMap.empty
     IORef (Cache ArrayIndex)
aiCache   <- forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
IMap.empty
     IORef (Set Kind)
usedKinds <- forall a. a -> IO (IORef a)
newIORef forall a. Set a
Set.empty
     IORef (Set [Char])
usedLbls  <- forall a. a -> IO (IORef a)
newIORef forall a. Set a
Set.empty
     IORef (Seq (Bool, [([Char], [Char])], SV))
cstrs     <- forall a. a -> IO (IORef a)
newIORef forall a. Seq a
S.empty
     IORef [SMTOption]
smtOpts   <- forall a. a -> IO (IORef a)
newIORef []
     IORef [Objective (SV, SV)]
optGoals  <- forall a. a -> IO (IORef a)
newIORef []
     IORef [([Char], Maybe CallStack, SV)]
asserts   <- forall a. a -> IO (IORef a)
newIORef []
     IORef IncState
istate    <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO IncState
newIncState
     IORef (Maybe QueryState)
qstate    <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 (forall a b. a -> Either a b
Left CV
trueCV)
                  , rIncState :: IORef IncState
rIncState    = IORef IncState
istate
                  , rCInfo :: IORef [([Char], CV)]
rCInfo       = IORef [([Char], CV)]
cInfo
                  , rObservables :: IORef (Seq (Name, CV -> Bool, SV))
rObservables = IORef (Seq (Name, CV -> Bool, SV))
observes
                  , rctr :: IORef Int
rctr         = IORef Int
ctr
                  , rUsedKinds :: IORef (Set Kind)
rUsedKinds   = IORef (Set Kind)
usedKinds
                  , rUsedLbls :: IORef (Set [Char])
rUsedLbls    = IORef (Set [Char])
usedLbls
                  , rinps :: IORef Inputs
rinps        = IORef Inputs
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 [(Bool, [Char], [[Char]])]
raxioms      = IORef [(Bool, [Char], [[Char]])]
axioms
                  , rSVCache :: IORef (Cache SV)
rSVCache     = IORef (Cache SV)
swCache
                  , rAICache :: IORef (Cache ArrayIndex)
rAICache     = IORef (Cache ArrayIndex)
aiCache
                  , rConstraints :: IORef (Seq (Bool, [([Char], [Char])], SV))
rConstraints = IORef (Seq (Bool, [([Char], [Char])], SV))
cstrs
                  , rSMTOptions :: IORef [SMTOption]
rSMTOptions  = IORef [SMTOption]
smtOpts
                  , rOptGoals :: IORef [Objective (SV, SV)]
rOptGoals    = IORef [Objective (SV, SV)]
optGoals
                  , rAsserts :: IORef [([Char], Maybe CallStack, SV)]
rAsserts     = IORef [([Char], Maybe CallStack, SV)]
asserts
                  , rQueryState :: IORef (Maybe QueryState)
rQueryState  = IORef (Maybe QueryState)
qstate
                  }
   SV
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
falseCV -- s(-2) == falseSV
   SV
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
trueCV  -- s(-1) == trueSV
   a
r <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT State m a
c State
st
   Result
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ State -> IO Result
extractSymbolicSimulationState State
st

   -- Clean-up after ourselves
   Maybe QueryState
qs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ State -> IORef (Maybe QueryState)
rQueryState State
st
   case Maybe QueryState
qs of
     Maybe QueryState
Nothing                         -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just QueryState{IO ()
queryTerminate :: IO ()
queryTerminate :: QueryState -> IO ()
queryTerminate} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
queryTerminate

   forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, Result
res)

-- | Grab the program from a running symbolic simulation state.
extractSymbolicSimulationState :: State -> IO Result
extractSymbolicSimulationState :: State -> IO Result
extractSymbolicSimulationState st :: State
st@State{ spgm :: State -> IORef SBVPgm
spgm=IORef SBVPgm
pgm, rinps :: State -> IORef Inputs
rinps=IORef Inputs
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 [(Bool, [Char], [[Char]])]
raxioms=IORef [(Bool, [Char], [[Char]])]
axioms
                                       , rAsserts :: State -> IORef [([Char], Maybe CallStack, SV)]
rAsserts=IORef [([Char], 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 [([Char], CV)]
rCInfo=IORef [([Char], CV)]
cInfo, rConstraints :: State -> IORef (Seq (Bool, [([Char], [Char])], SV))
rConstraints=IORef (Seq (Bool, [([Char], [Char])], SV))
cstrs
                                       , rObservables :: State -> IORef (Seq (Name, CV -> Bool, SV))
rObservables=IORef (Seq (Name, CV -> Bool, SV))
observes
                                       } = do
   SBVPgm Seq (SV, SBVExpr)
rpgm  <- forall a. IORef a -> IO a
readIORef IORef SBVPgm
pgm
   ([(Quantifier, NamedSymVar)], [NamedSymVar])
inpsO <- Inputs -> ([(Quantifier, NamedSymVar)], [NamedSymVar])
inputsToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef Inputs
inps
   [SV]
outsO <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [SV]
outs

   let swap :: (b, a) -> (a, b)
swap  (b
a, a
b)              = (a
b, b
a)
       cmp :: (a, b) -> (a, b) -> Ordering
cmp   (a
a, b
_) (a
b, b
_)       = a
a forall a. Ord a => a -> a -> Ordering
`compare` a
b
       arrange :: (a, (b, c, b)) -> ((a, b, c), b)
arrange (a
i, (b
at, c
rt, b
es)) = ((a
i, b
at, c
rt), b
es)

   CnstMap
constMap <- forall a. IORef a -> IO a
readIORef (State -> IORef CnstMap
rconstMap State
st)
   let cnsts :: [(SV, CV)]
cnsts = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
cmp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ CnstMap
constMap

   [((Int, Kind, Kind), [SV])]
tbls  <- forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {b}. (a, (b, c, b)) -> ((a, b, c), b)
arrange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
cmp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef TableMap
tables
   [(Int, ArrayInfo)]
arrs  <- forall a. IntMap a -> [(Int, a)]
IMap.toAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef ArrayMap
arrays
   [(Bool, [Char], [[Char]])]
axs   <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [(Bool, [Char], [[Char]])]
axioms
   [([Char], SBVType)]
unint <- do [([Char], SBVType)]
unints <- forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef UIMap
uis
               -- drop those that has an axiom associated with it
               let defineds :: [[Char]]
defineds = [[Char]
nm | (Bool
True, [Char]
nm, [[Char]]
_) <- [(Bool, [Char], [[Char]])]
axs]
               forall (f :: * -> *) a. Applicative f => a -> f a
pure [([Char], SBVType)
ui | ui :: ([Char], SBVType)
ui@([Char]
nm, SBVType
_) <- [([Char], SBVType)]
unints, [Char]
nm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
defineds]
   Set Kind
knds  <- forall a. IORef a -> IO a
readIORef IORef (Set Kind)
usedKinds
   [([Char], [[Char]])]
cgMap <- forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef CgMap
cgs

   [([Char], CV)]
traceVals   <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [([Char], CV)]
cInfo
   [([Char], CV -> Bool, SV)]
observables <- forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Name
n,CV -> Bool
f,SV
sv) -> (Name -> [Char]
T.unpack Name
n, CV -> Bool
f, SV
sv)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (Seq (Name, CV -> Bool, SV))
observes
   Seq (Bool, [([Char], [Char])], SV)
extraCstrs  <- forall a. IORef a -> IO a
readIORef IORef (Seq (Bool, [([Char], [Char])], SV))
cstrs
   [([Char], Maybe CallStack, SV)]
assertions  <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [([Char], Maybe CallStack, SV)]
asserts

   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Set Kind
-> [([Char], CV)]
-> [([Char], CV -> Bool, SV)]
-> [([Char], [[Char]])]
-> ([(Quantifier, NamedSymVar)], [NamedSymVar])
-> (CnstMap, [(SV, CV)])
-> [((Int, Kind, Kind), [SV])]
-> [(Int, ArrayInfo)]
-> [([Char], SBVType)]
-> [(Bool, [Char], [[Char]])]
-> SBVPgm
-> Seq (Bool, [([Char], [Char])], SV)
-> [([Char], Maybe CallStack, SV)]
-> [SV]
-> Result
Result Set Kind
knds [([Char], CV)]
traceVals [([Char], CV -> Bool, SV)]
observables [([Char], [[Char]])]
cgMap ([(Quantifier, NamedSymVar)], [NamedSymVar])
inpsO (CnstMap
constMap, [(SV, CV)]
cnsts) [((Int, Kind, Kind), [SV])]
tbls [(Int, ArrayInfo)]
arrs [([Char], SBVType)]
unint [(Bool, [Char], [[Char]])]
axs (Seq (SV, SBVExpr) -> SBVPgm
SBVPgm Seq (SV, SBVExpr)
rpgm) Seq (Bool, [([Char], [Char])], SV)
extraCstrs [([Char], Maybe CallStack, SV)]
assertions [SV]
outsO

-- | Generalization of 'Data.SBV.addNewSMTOption'
addNewSMTOption :: MonadSymbolic m => SMTOption -> m ()
addNewSMTOption :: forall (m :: * -> *). MonadSymbolic m => SMTOption -> m ()
addNewSMTOption SMTOption
o = do State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
                       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [SMTOption]
rSMTOptions (SMTOption
oforall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Generalization of 'Data.SBV.imposeConstraint'
imposeConstraint :: MonadSymbolic m => Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint :: forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
isSoft [([Char], [Char])]
attrs SVal
c = do State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
                                     SBVRunMode
rm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)

                                     case SBVRunMode
rm of
                                       SBVRunMode
CodeGen -> forall a. HasCallStack => [Char] -> a
error [Char]
"SBV: constraints are not allowed in code-generation"
                                       SBVRunMode
_       -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> State -> [Char] -> IO ()
registerLabel [Char]
"Constraint" State
st) [[Char]
nm | ([Char]
":named",  [Char]
nm) <- [([Char], [Char])]
attrs]
                                                              State -> Bool -> [([Char], [Char])] -> SVal -> IO ()
internalConstraint State
st Bool
isSoft [([Char], [Char])]
attrs SVal
c

-- | Require a boolean condition to be true in the state. Only used for internal purposes.
internalConstraint :: State -> Bool -> [(String, String)] -> SVal -> IO ()
internalConstraint :: State -> Bool -> [([Char], [Char])] -> SVal -> IO ()
internalConstraint State
st Bool
isSoft [([Char], [Char])]
attrs SVal
b = do SV
v <- State -> SVal -> IO SV
svToSV State
st SVal
b

                                          SBVRunMode
rm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)

                                          -- Are we running validation? If so, we always want to
                                          -- add the constraint for debug purposes. Otherwie
                                          -- we only add it if it's interesting; i.e., not directly
                                          -- true or has some attributes.
                                          let isValidating :: Bool
isValidating = case SBVRunMode
rm of
                                                               SMTMode QueryContext
_ IStage
_ Bool
_ SMTConfig
cfg -> SMTConfig -> Bool
validationRequested SMTConfig
cfg
                                                               SBVRunMode
CodeGen           -> Bool
False
                                                               Concrete Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)])
Nothing  -> Bool
False
                                                               Concrete (Just (Bool, [((Quantifier, NamedSymVar), Maybe CV)])
_) -> Bool
True   -- The case when we *are* running the validation

                                          let c :: (Bool, [([Char], [Char])], SV)
c           = (Bool
isSoft, [([Char], [Char])]
attrs, SV
v)
                                              interesting :: Bool
interesting = SV
v forall a. Eq a => a -> a -> Bool
/= SV
trueSV Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], [Char])]
attrs)

                                          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isValidating Bool -> Bool -> Bool
|| Bool
interesting) forall a b. (a -> b) -> a -> b
$
                                               forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Seq (Bool, [([Char], [Char])], SV))
rConstraints (forall a. Seq a -> a -> Seq a
S.|> (Bool, [([Char], [Char])], SV)
c)
                                                            forall a b. (a -> b) -> a -> b
$ forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef (Seq (Bool, [([Char], [Char])], SV))
rNewConstraints (forall a. Seq a -> a -> Seq a
S.|> (Bool, [([Char], [Char])], SV)
c)

-- | Generalization of 'Data.SBV.addSValOptGoal'
addSValOptGoal :: MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal :: forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal Objective SVal
obj = do State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv

                        -- create the tracking variable here for the metric
                        let mkGoal :: [Char] -> SVal -> m (SV, SV)
mkGoal [Char]
nm SVal
orig = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do SV
origSV  <- State -> SVal -> IO SV
svToSV State
st SVal
orig
                                                         SVal
track   <- Kind -> [Char] -> State -> IO SVal
svMkTrackerVar (forall a. HasKind a => a -> Kind
kindOf SVal
orig) [Char]
nm State
st
                                                         SV
trackSV <- State -> SVal -> IO SV
svToSV State
st SVal
track
                                                         forall (m :: * -> *) a. Monad m => a -> m a
return (SV
origSV, SV
trackSV)

                        let walk :: Objective SVal -> m (Objective (SV, SV))
walk (Minimize          [Char]
nm SVal
v)     = forall a. [Char] -> a -> Objective a
Minimize [Char]
nm                     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> SVal -> m (SV, SV)
mkGoal [Char]
nm SVal
v
                            walk (Maximize          [Char]
nm SVal
v)     = forall a. [Char] -> a -> Objective a
Maximize [Char]
nm                     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> SVal -> m (SV, SV)
mkGoal [Char]
nm SVal
v
                            walk (AssertWithPenalty [Char]
nm SVal
v Penalty
mbP) = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. [Char] -> a -> Penalty -> Objective a
AssertWithPenalty [Char]
nm) Penalty
mbP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> SVal -> m (SV, SV)
mkGoal [Char]
nm SVal
v

                        !Objective (SV, SV)
obj' <- Objective SVal -> m (Objective (SV, SV))
walk Objective SVal
obj
                        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [Objective (SV, SV)]
rOptGoals (Objective (SV, SV)
obj' forall a. a -> [a] -> [a]
:)
                                           forall a b. (a -> b) -> a -> b
$ forall a. [[Char]] -> a
noInteractive [ [Char]
"Adding an optimization objective:"
                                                           , [Char]
"  Objective: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Objective SVal
obj
                                                           ]

-- | Generalization of 'Data.SBV.outputSVal'
outputSVal :: MonadSymbolic m => SVal -> m ()
outputSVal :: forall (m :: * -> *). MonadSymbolic m => SVal -> m ()
outputSVal (SVal Kind
_ (Left CV
c)) = do
  State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
  SV
sv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
c
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [SV]
routs (SV
svforall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
outputSVal (SVal Kind
_ (Right Cached SV
f)) = do
  State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
  SV
sv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Cached SV -> State -> IO SV
uncache Cached SV
f State
st
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [SV]
routs (SV
svforall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

---------------------------------------------------------------------------------
-- * Cached values
---------------------------------------------------------------------------------

-- | We implement a peculiar caching mechanism, applicable to the use case in
-- implementation of SBV's.  Whenever we do a state based computation, we do
-- not want to keep on evaluating it in the then-current state. That will
-- produce essentially a semantically equivalent value. Thus, we want to run
-- it only once, and reuse that result, capturing the sharing at the Haskell
-- level. This is similar to the "type-safe observable sharing" work, but also
-- takes into the account of how symbolic simulation executes.
--
-- See Andy Gill's type-safe observable sharing trick for the inspiration behind
-- this technique: <http://ku-fpg.github.io/files/Gill-09-TypeSafeReification.pdf>
--
-- Note that this is *not* a general memo utility!
newtype Cached a = Cached (State -> IO a)

-- | Cache a state-based computation
cache :: (State -> IO a) -> Cached a
cache :: forall a. (State -> IO a) -> Cached a
cache = forall a. (State -> IO a) -> Cached a
Cached

-- | Uncache a previously cached computation
uncache :: Cached SV -> State -> IO SV
uncache :: Cached SV -> State -> IO SV
uncache = forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache SV)
rSVCache

-- | An SMT array index is simply an int value
newtype ArrayIndex = ArrayIndex { ArrayIndex -> Int
unArrayIndex :: Int } deriving (ArrayIndex -> ArrayIndex -> Bool
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
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
Ord, Typeable ArrayIndex
ArrayIndex -> DataType
ArrayIndex -> Constr
(forall b. Data b => b -> b) -> ArrayIndex -> ArrayIndex
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) -> ArrayIndex -> u
forall u. (forall d. Data d => d -> u) -> ArrayIndex -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayIndex -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayIndex -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArrayIndex
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArrayIndex -> c ArrayIndex
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArrayIndex)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayIndex)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArrayIndex -> m ArrayIndex
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArrayIndex -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArrayIndex -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ArrayIndex -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArrayIndex -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayIndex -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayIndex -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayIndex -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayIndex -> r
gmapT :: (forall b. Data b => b -> b) -> ArrayIndex -> ArrayIndex
$cgmapT :: (forall b. Data b => b -> b) -> ArrayIndex -> ArrayIndex
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayIndex)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayIndex)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArrayIndex)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArrayIndex)
dataTypeOf :: ArrayIndex -> DataType
$cdataTypeOf :: ArrayIndex -> DataType
toConstr :: ArrayIndex -> Constr
$ctoConstr :: ArrayIndex -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArrayIndex
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArrayIndex
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArrayIndex -> c ArrayIndex
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArrayIndex -> c ArrayIndex
G.Data)

-- | We simply show indexes as the underlying integer
instance Show ArrayIndex where
  show :: ArrayIndex -> [Char]
show (ArrayIndex Int
i) = forall a. Show a => a -> [Char]
show Int
i

-- | Uncache, retrieving SMT array indexes
uncacheAI :: Cached ArrayIndex -> State -> IO ArrayIndex
uncacheAI :: Cached ArrayIndex -> State -> IO ArrayIndex
uncacheAI = forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache ArrayIndex)
rAICache

-- | Generic uncaching. Note that this is entirely safe, since we do it in the IO monad.
uncacheGen :: (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen :: forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache a)
getCache (Cached State -> IO a
f) State
st = do
        let rCache :: IORef (Cache a)
rCache = State -> IORef (Cache a)
getCache State
st
        Cache a
stored <- forall a. IORef a -> IO a
readIORef IORef (Cache a)
rCache
        StableName (State -> IO a)
sn <- State -> IO a
f seq :: forall a b. a -> b -> b
`seq` forall a. a -> IO (StableName a)
makeStableName State -> IO a
f
        let h :: Int
h = forall a. StableName a -> Int
hashStableName StableName (State -> IO a)
sn
        case (Int
h forall a. Int -> IntMap a -> Maybe a
`IMap.lookup` Cache a
stored) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StableName (State -> IO a)
sn forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup`) of
          Just a
r  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
          Maybe a
Nothing -> do a
r <- State -> IO a
f State
st
                        a
r seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' IORef (Cache a)
rCache (forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IMap.insertWith forall a. [a] -> [a] -> [a]
(++) Int
h [(StableName (State -> IO a)
sn, a
r)])
                        forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Representation of SMTLib Program versions. As of June 2015, we're dropping support
-- for SMTLib1, and supporting SMTLib2 only. We keep this data-type around in case
-- SMTLib3 comes along and we want to support 2 and 3 simultaneously.
data SMTLibVersion = SMTLib2
                   deriving (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]
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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SMTLibVersion] -> ShowS
$cshowList :: [SMTLibVersion] -> ShowS
show :: SMTLibVersion -> [Char]
$cshow :: SMTLibVersion -> [Char]
showsPrec :: Int -> SMTLibVersion -> ShowS
$cshowsPrec :: Int -> SMTLibVersion -> ShowS
Show)

-- | The extension associated with the version
smtLibVersionExtension :: SMTLibVersion -> String
smtLibVersionExtension :: SMTLibVersion -> [Char]
smtLibVersionExtension SMTLibVersion
SMTLib2 = [Char]
"smt2"

-- | Representation of an SMT-Lib program. In between pre and post goes the refuted models
data SMTLibPgm = SMTLibPgm SMTLibVersion [String]

instance NFData SMTLibVersion where rnf :: SMTLibVersion -> ()
rnf SMTLibVersion
a               = SMTLibVersion
a seq :: forall a b. a -> b -> b
`seq` ()
instance NFData SMTLibPgm     where rnf :: SMTLibPgm -> ()
rnf (SMTLibPgm SMTLibVersion
v [[Char]]
p) = forall a. NFData a => a -> ()
rnf SMTLibVersion
v seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [[Char]]
p

instance Show SMTLibPgm where
  show :: SMTLibPgm -> [Char]
show (SMTLibPgm SMTLibVersion
_ [[Char]]
pre) = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
pre

-- Other Technicalities..
instance NFData CV where
  rnf :: CV -> ()
rnf (CV Kind
x CVal
y) = Kind
x seq :: forall a b. a -> b -> b
`seq` CVal
y seq :: forall a b. a -> b -> b
`seq` ()

instance NFData GeneralizedCV where
  rnf :: GeneralizedCV -> ()
rnf (ExtendedCV ExtCV
e) = ExtCV
e seq :: forall a b. a -> b -> b
`seq` ()
  rnf (RegularCV  CV
c) = CV
c seq :: forall a b. a -> b -> b
`seq` ()

#if MIN_VERSION_base(4,9,0)
#else
-- Can't really force this, but not a big deal
instance NFData CallStack where
  rnf _ = ()
#endif

instance NFData NamedSymVar where
  rnf :: NamedSymVar -> ()
rnf (NamedSymVar SV
s Name
n) = forall a. NFData a => a -> ()
rnf SV
s seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Name
n

instance NFData Result where
  rnf :: Result -> ()
rnf (Result Set Kind
kindInfo [([Char], CV)]
qcInfo [([Char], CV -> Bool, SV)]
obs [([Char], [[Char]])]
cgs ([(Quantifier, NamedSymVar)], [NamedSymVar])
inps (CnstMap, [(SV, CV)])
consts [((Int, Kind, Kind), [SV])]
tbls [(Int, ArrayInfo)]
arrs [([Char], SBVType)]
uis [(Bool, [Char], [[Char]])]
axs SBVPgm
pgm Seq (Bool, [([Char], [Char])], SV)
cstr [([Char], Maybe CallStack, SV)]
asserts [SV]
outs)
        = forall a. NFData a => a -> ()
rnf Set Kind
kindInfo seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], CV)]
qcInfo  seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], CV -> Bool, SV)]
obs    seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], [[Char]])]
cgs
                       seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf ([(Quantifier, NamedSymVar)], [NamedSymVar])
inps    seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf (CnstMap, [(SV, CV)])
consts seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [((Int, Kind, Kind), [SV])]
tbls
                       seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [(Int, ArrayInfo)]
arrs    seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], SBVType)]
uis    seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [(Bool, [Char], [[Char]])]
axs
                       seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf SBVPgm
pgm     seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Seq (Bool, [([Char], [Char])], SV)
cstr   seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], Maybe CallStack, SV)]
asserts
                       seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [SV]
outs
instance NFData Kind         where rnf :: Kind -> ()
rnf Kind
a          = seq :: forall a b. a -> b -> b
seq Kind
a ()
instance NFData ArrayContext where rnf :: ArrayContext -> ()
rnf ArrayContext
a          = seq :: forall a b. a -> b -> b
seq ArrayContext
a ()
instance NFData SV           where rnf :: SV -> ()
rnf SV
a          = seq :: forall a b. a -> b -> b
seq SV
a ()
instance NFData SBVExpr      where rnf :: SBVExpr -> ()
rnf SBVExpr
a          = seq :: forall a b. a -> b -> b
seq SBVExpr
a ()
instance NFData Quantifier   where rnf :: Quantifier -> ()
rnf Quantifier
a          = seq :: forall a b. a -> b -> b
seq Quantifier
a ()
instance NFData SBVType      where rnf :: SBVType -> ()
rnf SBVType
a          = seq :: forall a b. a -> b -> b
seq SBVType
a ()
instance NFData SBVPgm       where rnf :: SBVPgm -> ()
rnf SBVPgm
a          = seq :: forall a b. a -> b -> b
seq SBVPgm
a ()
instance NFData (Cached a)   where rnf :: Cached a -> ()
rnf (Cached State -> IO a
f) = State -> IO a
f seq :: forall a b. a -> b -> b
`seq` ()
instance NFData SVal         where rnf :: SVal -> ()
rnf (SVal Kind
x Either CV (Cached SV)
y) = forall a. NFData a => a -> ()
rnf Kind
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Either CV (Cached SV)
y

instance NFData SMTResult where
  rnf :: SMTResult -> ()
rnf (Unsatisfiable SMTConfig
_   Maybe [[Char]]
m   ) = forall a. NFData a => a -> ()
rnf Maybe [[Char]]
m
  rnf (Satisfiable   SMTConfig
_   SMTModel
m   ) = forall a. NFData a => a -> ()
rnf SMTModel
m
  rnf (DeltaSat      SMTConfig
_ Maybe [Char]
p SMTModel
m   ) = forall a. NFData a => a -> ()
rnf SMTModel
m seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe [Char]
p
  rnf (SatExtField   SMTConfig
_   SMTModel
m   ) = forall a. NFData a => a -> ()
rnf SMTModel
m
  rnf (Unknown       SMTConfig
_   SMTReasonUnknown
m   ) = forall a. NFData a => a -> ()
rnf SMTReasonUnknown
m
  rnf (ProofError    SMTConfig
_   [[Char]]
m Maybe SMTResult
mr) = forall a. NFData a => a -> ()
rnf [[Char]]
m seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe SMTResult
mr

instance NFData SMTModel where
  rnf :: SMTModel -> ()
rnf (SMTModel [([Char], GeneralizedCV)]
objs Maybe [((Quantifier, NamedSymVar), Maybe CV)]
bndgs [([Char], CV)]
assocs [([Char], (SBVType, ([([CV], CV)], CV)))]
uifuns) = forall a. NFData a => a -> ()
rnf [([Char], GeneralizedCV)]
objs seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe [((Quantifier, NamedSymVar), Maybe CV)]
bndgs seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], CV)]
assocs seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [([Char], (SBVType, ([([CV], CV)], CV)))]
uifuns

instance NFData SMTScript where
  rnf :: SMTScript -> ()
rnf (SMTScript [Char]
b [[Char]]
m) = forall a. NFData a => a -> ()
rnf [Char]
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [[Char]]
m

-- | Translation tricks needed for specific capabilities afforded by each solver
data SolverCapabilities = SolverCapabilities {
         SolverCapabilities -> Bool
supportsQuantifiers        :: Bool           -- ^ Supports SMT-Lib2 style quantifiers?
       , SolverCapabilities -> Bool
supportsDefineFun          :: Bool           -- ^ Supports define-fun construct?
       , SolverCapabilities -> Bool
supportsDistinct           :: Bool           -- ^ Supports calls to distinct?
       , SolverCapabilities -> Bool
supportsBitVectors         :: Bool           -- ^ Supports bit-vectors?
       , SolverCapabilities -> Bool
supportsUninterpretedSorts :: Bool           -- ^ Supports SMT-Lib2 style uninterpreted-sorts
       , SolverCapabilities -> Bool
supportsUnboundedInts      :: Bool           -- ^ Supports unbounded integers?
       , SolverCapabilities -> Bool
supportsInt2bv             :: Bool           -- ^ Supports int2bv?
       , SolverCapabilities -> Bool
supportsReals              :: Bool           -- ^ Supports reals?
       , SolverCapabilities -> Bool
supportsApproxReals        :: Bool           -- ^ Supports printing of approximations of reals?
       , SolverCapabilities -> Maybe [Char]
supportsDeltaSat           :: Maybe String   -- ^ Supports delta-satisfiability? (With given precision query)
       , SolverCapabilities -> Bool
supportsIEEE754            :: Bool           -- ^ Supports floating point numbers?
       , SolverCapabilities -> Bool
supportsSets               :: Bool           -- ^ Supports set operations?
       , SolverCapabilities -> Bool
supportsOptimization       :: Bool           -- ^ Supports optimization routines?
       , SolverCapabilities -> Bool
supportsPseudoBooleans     :: Bool           -- ^ Supports pseudo-boolean operations?
       , SolverCapabilities -> Bool
supportsCustomQueries      :: Bool           -- ^ Supports interactive queries per SMT-Lib?
       , SolverCapabilities -> Bool
supportsGlobalDecls        :: Bool           -- ^ Supports global declarations? (Needed for push-pop.)
       , SolverCapabilities -> Bool
supportsDataTypes          :: Bool           -- ^ Supports datatypes?
       , SolverCapabilities -> Bool
supportsDirectAccessors    :: Bool           -- ^ Supports data-type accessors without full ascription?
       , SolverCapabilities -> Maybe [[Char]]
supportsFlattenedModels    :: Maybe [String] -- ^ Supports flattened model output? (With given config lines.)
       }

-- | Solver configuration. See also 'Data.SBV.z3', 'Data.SBV.yices', 'Data.SBV.cvc4', 'Data.SBV.boolector', 'Data.SBV.mathSAT', etc.
-- which are instantiations of this type for those solvers, with reasonable defaults. In particular, custom configuration can be
-- created by varying those values. (Such as @z3{verbose=True}@.)
--
-- Most fields are self explanatory. The notion of precision for printing algebraic reals stems from the fact that such values does
-- not necessarily have finite decimal representations, and hence we have to stop printing at some depth. It is important to
-- emphasize that such values always have infinite precision internally. The issue is merely with how we print such an infinite
-- precision value on the screen. The field 'printRealPrec' controls the printing precision, by specifying the number of digits after
-- the decimal point. The default value is 16, but it can be set to any positive integer.
--
-- When printing, SBV will add the suffix @...@ at the and of a real-value, if the given bound is not sufficient to represent the real-value
-- exactly. Otherwise, the number will be written out in standard decimal notation. Note that SBV will always print the whole value if it
-- is precise (i.e., if it fits in a finite number of digits), regardless of the precision limit. The limit only applies if the representation
-- of the real value is not finite, i.e., if it is not rational.
--
-- The 'printBase' field can be used to print numbers in base 2, 10, or 16.
--
-- The 'crackNum' field can be used to display numbers in detail, all its bits and how they are laid out in memory. Works with all bounded number types
-- (i.e., SWord and SInt), but also with floats. It is particularly useful with floating-point numbers, as it shows you how they are laid out in
-- memory following the IEEE754 rules.
data SMTConfig = SMTConfig {
         SMTConfig -> Bool
verbose                     :: Bool           -- ^ Debug mode
       , SMTConfig -> Timing
timing                      :: Timing         -- ^ Print timing information on how long different phases took (construction, solving, etc.)
       , SMTConfig -> Int
printBase                   :: Int            -- ^ Print integral literals in this base (2, 10, and 16 are supported.)
       , SMTConfig -> Int
printRealPrec               :: Int            -- ^ Print algebraic real values with this precision. (SReal, default: 16)
       , SMTConfig -> Bool
crackNum                    :: Bool           -- ^ For each numeric value, show it in detail in the model with its bits spliced out. Good for floats.
       , SMTConfig -> [Char]
satCmd                      :: String         -- ^ Usually "(check-sat)". However, users might tweak it based on solver characteristics.
       , SMTConfig -> Maybe Int
allSatMaxModelCount         :: Maybe Int      -- ^ In a 'Data.SBV.allSat' call, return at most this many models. If nothing, return all.
       , SMTConfig -> Bool
allSatPrintAlong            :: Bool           -- ^ In a 'Data.SBV.allSat' call, print models as they are found.
       , SMTConfig -> Bool
satTrackUFs                 :: Bool           -- ^ In a 'Data.SBV.sat' call, should we try to extract values of uninterpreted functions?
       , SMTConfig -> [Char] -> Bool
isNonModelVar               :: String -> Bool -- ^ When constructing a model, ignore variables whose name satisfy this predicate. (Default: (const False), i.e., don't ignore anything)
       , SMTConfig -> Bool
validateModel               :: Bool           -- ^ If set, SBV will attempt to validate the model it gets back from the solver.
       , SMTConfig -> Bool
optimizeValidateConstraints :: Bool           -- ^ Validate optimization results. NB: Does NOT make sure the model is optimal, just checks they satisfy the constraints.
       , SMTConfig -> Maybe [Char]
transcript                  :: Maybe FilePath -- ^ If Just, the entire interaction will be recorded as a playable file (for debugging purposes mostly)
       , SMTConfig -> SMTLibVersion
smtLibVersion               :: SMTLibVersion  -- ^ What version of SMT-lib we use for the tool
       , SMTConfig -> Maybe Double
dsatPrecision               :: Maybe Double   -- ^ Delta-sat precision
       , SMTConfig -> SMTSolver
solver                      :: SMTSolver      -- ^ The actual SMT solver.
       , SMTConfig -> [[Char]]
extraArgs                   :: [String]       -- ^ Extra command line arguments to pass to the solver.
       , SMTConfig -> Bool
allowQuantifiedQueries      :: Bool           -- ^ Should we permit use of quantifiers in the query mode? (Default: False. See <http://github.com/LeventErkok/sbv/issues/459> for why.)
       , SMTConfig -> RoundingMode
roundingMode                :: RoundingMode   -- ^ Rounding mode to use for floating-point conversions
       , SMTConfig -> [SMTOption]
solverSetOptions            :: [SMTOption]    -- ^ Options to set as we start the solver
       , SMTConfig -> Bool
ignoreExitCode              :: Bool           -- ^ If true, we shall ignore the exit code upon exit. Otherwise we require ExitSuccess.
       , SMTConfig -> Maybe [Char]
redirectVerbose             :: Maybe FilePath -- ^ Redirect the verbose output to this file if given. If Nothing, stdout is implied.
       }

-- | We show the name of the solver for the config. Arguably this is misleading, but better than nothing.
instance Show SMTConfig where
  show :: SMTConfig -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMTSolver -> Solver
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMTConfig -> SMTSolver
solver

-- | Returns true if we have to perform validation
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

-- We're just seq'ing top-level here, it shouldn't really matter. (i.e., no need to go deeper.)
instance NFData SMTConfig where
  rnf :: SMTConfig -> ()
rnf SMTConfig{} = ()

-- | A model, as returned by a solver
data SMTModel = SMTModel {
       SMTModel -> [([Char], GeneralizedCV)]
modelObjectives :: [(String, GeneralizedCV)]                     -- ^ Mapping of symbolic values to objective values.
     , SMTModel -> Maybe [((Quantifier, NamedSymVar), Maybe CV)]
modelBindings   :: Maybe [((Quantifier, NamedSymVar), Maybe CV)] -- ^ Mapping of input variables as reported by the solver. Only collected if model validation is requested.
     , SMTModel -> [([Char], CV)]
modelAssocs     :: [(String, CV)]                                -- ^ Mapping of symbolic values to constants.
     , SMTModel -> [([Char], (SBVType, ([([CV], CV)], CV)))]
modelUIFuns     :: [(String, (SBVType, ([([CV], CV)], CV)))]     -- ^ Mapping of uninterpreted functions to association lists in the model.
                                                                        -- Note that an uninterpreted constant (function of arity 0) will be stored
                                                                        -- in the 'modelAssocs' field.
     }
     deriving Int -> SMTModel -> ShowS
[SMTModel] -> ShowS
SMTModel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SMTModel] -> ShowS
$cshowList :: [SMTModel] -> ShowS
show :: SMTModel -> [Char]
$cshow :: SMTModel -> [Char]
showsPrec :: Int -> SMTModel -> ShowS
$cshowsPrec :: Int -> SMTModel -> ShowS
Show

-- | The result of an SMT solver call. Each constructor is tagged with
-- the 'SMTConfig' that created it so that further tools can inspect it
-- and build layers of results, if needed. For ordinary uses of the library,
-- this type should not be needed, instead use the accessor functions on
-- it. (Custom Show instances and model extractors.)
data SMTResult = Unsatisfiable SMTConfig (Maybe [String])            -- ^ Unsatisfiable. If unsat-cores are enabled, they will be returned in the second parameter.
               | Satisfiable   SMTConfig SMTModel                    -- ^ Satisfiable with model
               | DeltaSat      SMTConfig (Maybe String) SMTModel     -- ^ Delta satisfiable with queried string if available and model
               | SatExtField   SMTConfig SMTModel                    -- ^ Prover returned a model, but in an extension field containing Infinite/epsilon
               | Unknown       SMTConfig SMTReasonUnknown            -- ^ Prover returned unknown, with the given reason
               | ProofError    SMTConfig [String] (Maybe SMTResult)  -- ^ Prover errored out, with possibly a bogus result

-- | A script, to be passed to the solver.
data SMTScript = SMTScript {
          SMTScript -> [Char]
scriptBody  :: String   -- ^ Initial feed
        , SMTScript -> [[Char]]
scriptModel :: [String] -- ^ Continuation script, to extract results
        }

-- | An SMT engine
type SMTEngine =  forall res.
                  SMTConfig         -- ^ current configuration
               -> State             -- ^ the state in which to run the engine
               -> String            -- ^ program
               -> (State -> IO res) -- ^ continuation
               -> IO res

-- | Solvers that SBV is aware of
data Solver = ABC
            | Boolector
            | Bitwuzla
            | CVC4
            | CVC5
            | DReal
            | MathSAT
            | Yices
            | Z3
            deriving (Int -> Solver -> ShowS
[Solver] -> ShowS
Solver -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Solver] -> ShowS
$cshowList :: [Solver] -> ShowS
show :: Solver -> [Char]
$cshow :: Solver -> [Char]
showsPrec :: Int -> Solver -> ShowS
$cshowsPrec :: Int -> Solver -> ShowS
Show, Int -> Solver
Solver -> Int
Solver -> [Solver]
Solver -> Solver
Solver -> Solver -> [Solver]
Solver -> Solver -> Solver -> [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
forall a. a -> a -> Bounded a
maxBound :: Solver
$cmaxBound :: Solver
minBound :: Solver
$cminBound :: Solver
Bounded)

-- | An SMT solver
data SMTSolver = SMTSolver {
         SMTSolver -> Solver
name           :: Solver                -- ^ The solver in use
       , SMTSolver -> [Char]
executable     :: String                -- ^ The path to its executable
       , SMTSolver -> ShowS
preprocess     :: String -> String      -- ^ Each line sent to the solver will be passed through this function (typically id)
       , SMTSolver -> SMTConfig -> [[Char]]
options        :: SMTConfig -> [String] -- ^ Options to provide to the solver
       , SMTSolver -> SMTEngine
engine         :: SMTEngine             -- ^ The solver engine, responsible for interpreting solver output
       , SMTSolver -> SolverCapabilities
capabilities   :: SolverCapabilities    -- ^ Various capabilities of the solver
       }

-- | Query execution context
data QueryContext = QueryInternal       -- ^ Triggered from inside SBV
                  | QueryExternal       -- ^ Triggered from user code

-- | Show instance for 'QueryContext', for debugging purposes
instance Show QueryContext where
   show :: QueryContext -> [Char]
show QueryContext
QueryInternal = [Char]
"Internal Query"
   show QueryContext
QueryExternal = [Char]
"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) #-}
{-# ANN type NROp ("HLint: ignore Use camelCase" :: String) #-}