-----------------------------------------------------------------------------
-- |
-- 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 DeriveAnyClass             #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}

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

module Data.SBV.Core.Symbolic
  ( NodeId(..)
  , SV(..), swKind, trueSV, falseSV, contextOfSV
  , Op(..), PBOp(..), OvOp(..), FPOp(..), NROp(..), StrOp(..), RegExOp(..), SeqOp(..), SetOp(..), SpecialRelOp(..)
  , RegExp(..), regExpToSMTString, SMTLambda(..)
  , Quantifier(..), needsExistentials, SBVContext(..), checkCompatibleContext, VarContext(..)
  , RoundingMode(..)
  , SBVType(..), svUninterpreted, svUninterpretedNamedArgs, newUninterpreted
  , SVal(..)
  , svMkSymVar, sWordN, sWordN_, sIntN, sIntN_
  , svToSV, svToSymSV, forceSVArg
  , SBVExpr(..), newExpr, isCodeGenMode, isSafetyCheckingIStage, isRunIStage, isSetupIStage
  , Cached, cache, uncache, modifyState, modifyIncState
  , NamedSymVar(..), Name, UserInputs, Inputs(..), getSV, swNodeId, namedNodeId
  , addInternInput, addUserInput
  , getUserName', getUserName
  , lookupInput , getSValPathCondition, extendSValPathCondition
  , getTableIndex, sObserve
  , SBVPgm(..), MonadSymbolic(..), SymbolicT, Symbolic, runSymbolic, mkNewState, runSymbolicInState, State(..), SMTDef(..), smtDefGivenName, withNewIncState, IncState(..), incrementInternalCounter
  , inSMTMode, SBVRunMode(..), IStage(..), Result(..), ResultInp(..), UICodeKind(..), UIName(..)
  , registerKind, registerLabel, registerSpecialFunction, recordObservable
  , addAssertion, addNewSMTOption, imposeConstraint, internalConstraint, newInternalVariable, lambdaVar, quantVar
  , SMTLibPgm(..), SMTLibVersion(..), smtLibVersionExtension
  , SolverCapabilities(..)
  , extractSymbolicSimulationState, CnstMap
  , OptimizeStyle(..), Objective(..), Penalty(..), objectiveName, addSValOptGoal
  , MonadQuery(..), QueryT(..), Query, QueryState(..), QueryContext(..)
  , SMTScript(..), Solver(..), SMTSolver(..), SMTResult(..), SMTModel(..), SMTConfig(..), KDOptions(..), SMTEngine, isEmptyModel
  , validationRequested, outputSVal, ProgInfo(..), mustIgnoreVar, getRootState
  ) where

import Control.DeepSeq             (NFData(..))
import Control.Monad               (when, unless)
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                   (isSpace)
import Data.IORef                  (IORef, newIORef, readIORef)
import Data.List                   (intercalate, sortBy, isPrefixOf)
import Data.Maybe                  (fromMaybe, mapMaybe)
import Data.String                 (IsString(fromString))

import Data.Time (getCurrentTime, UTCTime)

import Data.Int (Int64)

import GHC.Stack
import GHC.Stack.Types
import GHC.Generics (Generic)

import qualified Control.Exception as C
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.Generics.Uniplate.Data as G
import qualified Data.IntMap.Strict          as IMap (IntMap, empty, lookup, insertWith)
import qualified Data.Map.Strict             as Map  (Map, empty, toList, lookup, insert, size, notMember)
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, (|>), (<|), lookup, elemIndexL)
import qualified Data.Text                   as T

import System.Mem.StableName
import System.Random

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, checkObservableName, needsBars)

import Data.Containers.ListUtils (nubOrd)

import Data.SBV.Control.Types

#if MIN_VERSION_base(4,11,0)
import Control.Monad.Fail as Fail
#endif

-- | Context identifier. 0 is reserved global context
newtype SBVContext = SBVContext Int64 deriving (SBVContext -> SBVContext -> Bool
(SBVContext -> SBVContext -> Bool)
-> (SBVContext -> SBVContext -> Bool) -> Eq SBVContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBVContext -> SBVContext -> Bool
== :: SBVContext -> SBVContext -> Bool
$c/= :: SBVContext -> SBVContext -> Bool
/= :: SBVContext -> SBVContext -> Bool
Eq, Eq SBVContext
Eq SBVContext =>
(SBVContext -> SBVContext -> Ordering)
-> (SBVContext -> SBVContext -> Bool)
-> (SBVContext -> SBVContext -> Bool)
-> (SBVContext -> SBVContext -> Bool)
-> (SBVContext -> SBVContext -> Bool)
-> (SBVContext -> SBVContext -> SBVContext)
-> (SBVContext -> SBVContext -> SBVContext)
-> Ord SBVContext
SBVContext -> SBVContext -> Bool
SBVContext -> SBVContext -> Ordering
SBVContext -> SBVContext -> SBVContext
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
$ccompare :: SBVContext -> SBVContext -> Ordering
compare :: SBVContext -> SBVContext -> Ordering
$c< :: SBVContext -> SBVContext -> Bool
< :: SBVContext -> SBVContext -> Bool
$c<= :: SBVContext -> SBVContext -> Bool
<= :: SBVContext -> SBVContext -> Bool
$c> :: SBVContext -> SBVContext -> Bool
> :: SBVContext -> SBVContext -> Bool
$c>= :: SBVContext -> SBVContext -> Bool
>= :: SBVContext -> SBVContext -> Bool
$cmax :: SBVContext -> SBVContext -> SBVContext
max :: SBVContext -> SBVContext -> SBVContext
$cmin :: SBVContext -> SBVContext -> SBVContext
min :: SBVContext -> SBVContext -> SBVContext
Ord, Typeable SBVContext
Typeable SBVContext =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SBVContext -> c SBVContext)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SBVContext)
-> (SBVContext -> Constr)
-> (SBVContext -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SBVContext))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SBVContext))
-> ((forall b. Data b => b -> b) -> SBVContext -> SBVContext)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SBVContext -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SBVContext -> r)
-> (forall u. (forall d. Data d => d -> u) -> SBVContext -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SBVContext -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SBVContext -> m SBVContext)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVContext -> m SBVContext)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVContext -> m SBVContext)
-> Data SBVContext
SBVContext -> Constr
SBVContext -> DataType
(forall b. Data b => b -> b) -> SBVContext -> SBVContext
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) -> SBVContext -> u
forall u. (forall d. Data d => d -> u) -> SBVContext -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVContext -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVContext -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVContext
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVContext -> c SBVContext
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVContext)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVContext)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVContext -> c SBVContext
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVContext -> c SBVContext
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVContext
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVContext
$ctoConstr :: SBVContext -> Constr
toConstr :: SBVContext -> Constr
$cdataTypeOf :: SBVContext -> DataType
dataTypeOf :: SBVContext -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVContext)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVContext)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVContext)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVContext)
$cgmapT :: (forall b. Data b => b -> b) -> SBVContext -> SBVContext
gmapT :: (forall b. Data b => b -> b) -> SBVContext -> SBVContext
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVContext -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVContext -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVContext -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVContext -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SBVContext -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SBVContext -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVContext -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVContext -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVContext -> m SBVContext
G.Data, Int -> SBVContext -> ShowS
[SBVContext] -> ShowS
SBVContext -> [Char]
(Int -> SBVContext -> ShowS)
-> (SBVContext -> [Char])
-> ([SBVContext] -> ShowS)
-> Show SBVContext
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SBVContext -> ShowS
showsPrec :: Int -> SBVContext -> ShowS
$cshow :: SBVContext -> [Char]
show :: SBVContext -> [Char]
$cshowList :: [SBVContext] -> ShowS
showList :: [SBVContext] -> ShowS
Show)

instance NFData SBVContext where
  rnf :: SBVContext -> ()
rnf (SBVContext Int64
i) = Int64
i Int64 -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Global context
globalSBVContext :: SBVContext
globalSBVContext :: SBVContext
globalSBVContext = Int64 -> SBVContext
SBVContext Int64
0

-- | Generate context. We make sure it isn't 0, i.e., the global context
-- The "hope" here is that each time we call this we get a different context number.
-- A random number doesn't necessarily have to do that, but I think the pseudo-generator
-- has a large enough period for this to go through OK.
genSBVContext :: IO SBVContext
genSBVContext :: IO SBVContext
genSBVContext = do ctx <- Int64 -> SBVContext
SBVContext (Int64 -> SBVContext) -> IO Int64 -> IO SBVContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                   if ctx == globalSBVContext   -- unlikely, but possible
                      then genSBVContext
                      else pure ctx

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

-- Equality is pair-wise, except we accommodate for negative node-id; which is reserved for true/false
instance Eq NodeId where
  NodeId n1 :: (SBVContext, Maybe Int, Int)
n1@(SBVContext
_, Maybe Int
_, Int
i) == :: NodeId -> NodeId -> Bool
== NodeId n2 :: (SBVContext, Maybe Int, Int)
n2@(SBVContext
_, Maybe Int
_, Int
j)
     | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
     = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
     | Bool
True
     = (SBVContext, Maybe Int, Int)
n1 (SBVContext, Maybe Int, Int)
-> (SBVContext, Maybe Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (SBVContext, Maybe Int, Int)
n2

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

-- | Which context are we using this var at?
contextOfSV :: SV -> SBVContext
contextOfSV :: SV -> SBVContext
contextOfSV (SV Kind
_ (NodeId (SBVContext
c, Maybe Int
_, Int
_))) = SBVContext
c

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

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

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

instance Show SV where
  show :: SV -> [Char]
show (SV Kind
_ (NodeId (SBVContext
_, Maybe Int
l, Int
n))) = case Int
n of
                                     -2 -> [Char]
"false"
                                     -1 -> [Char]
"true"
                                     Int
_  -> [Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
's' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
        where prefix :: [Char]
prefix = case Maybe Int
l of
                         Maybe Int
Nothing -> [Char]
"arg"   -- top-level lambda
                         Just Int
0  -> [Char]
""
                         Just Int
i  -> Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_"

-- | 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 Kind -> IO () -> IO ()
forall a b. a -> b -> b
`seq` NodeId
n NodeId -> IO () -> IO ()
forall a b. a -> b -> b
`seq` () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Constant False as an t'SV'. Note that this value always occupies slot -2 and level 0.
falseSV :: SV
falseSV :: SV
falseSV = Kind -> NodeId -> SV
SV Kind
KBool (NodeId -> SV) -> NodeId -> SV
forall a b. (a -> b) -> a -> b
$ (SBVContext, Maybe Int, Int) -> NodeId
NodeId (SBVContext
globalSBVContext, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, -Int
2)

-- | Constant True as an t'SV'. Note that this value always occupies slot -1 and level 0.
trueSV :: SV
trueSV :: SV
trueSV  = Kind -> NodeId -> SV
SV Kind
KBool (NodeId -> SV) -> NodeId -> SV
forall a b. (a -> b) -> a -> b
$ (SBVContext, Maybe Int, Int) -> NodeId
NodeId (SBVContext
globalSBVContext, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, -Int
1)

-- | Symbolic operations
data Op = Plus
        | Times
        | Minus
        | UNeg
        | Abs
        | Quot
        | Rem
        | Equal
        | Implies
        | NotEqual
        | LessThan
        | GreaterThan
        | LessEq
        | GreaterEq
        | Ite
        | And
        | Or
        | XOr
        | Not
        | Shl
        | Shr
        | Rol Int
        | Ror Int
        | Divides Integer                       -- divides k n is True if k divides n. k must be > 0 constant
        | 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
        | KindCast Kind Kind
        | Uninterpreted String
        | QuantifiedBool String                 -- When we generate a forall/exists (nested etc.) boolean value. NB. This used to be "QuantifiedBool [Op] String", keeping track of Ops. That turned out to cause memory leaks. So avoid that.
        | SpecialRelOp Kind SpecialRelOp        -- Generate the equality to the internal operation
        | 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
        | RegExOp RegExOp                       -- RegEx operations, categorized separately
        | StrOp StrOp                           -- String ops, 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
        | ArrayLambda SMTLambda                 -- An array value, created from a lambda
        | ReadArray                             -- Reading an array value
        | WriteArray                            -- Writing to an array
        deriving (Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
/= :: Op -> Op -> Bool
Eq, Eq Op
Eq Op =>
(Op -> Op -> Ordering)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Op)
-> (Op -> Op -> Op)
-> Ord Op
Op -> Op -> Bool
Op -> Op -> Ordering
Op -> Op -> Op
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Op -> Op -> Ordering
compare :: Op -> Op -> Ordering
$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
>= :: Op -> Op -> Bool
$cmax :: Op -> Op -> Op
max :: Op -> Op -> Op
$cmin :: Op -> Op -> Op
min :: Op -> Op -> Op
Ord, (forall x. Op -> Rep Op x)
-> (forall x. Rep Op x -> Op) -> Generic Op
forall x. Rep Op x -> Op
forall x. Op -> Rep Op x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Op -> Rep Op x
from :: forall x. Op -> Rep Op x
$cto :: forall x. Rep Op x -> Op
to :: forall x. Rep Op x -> Op
Generic, Typeable Op
Typeable Op =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Op -> c Op)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Op)
-> (Op -> Constr)
-> (Op -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Op -> Op)
-> (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 u. (forall d. Data d => d -> u) -> Op -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Op -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> Data Op
Op -> Constr
Op -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
$ctoConstr :: Op -> Constr
toConstr :: Op -> Constr
$cdataTypeOf :: Op -> DataType
dataTypeOf :: Op -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
$cgmapT :: (forall b. Data b => b -> b) -> Op -> Op
gmapT :: (forall b. Data b => b -> b) -> Op -> Op
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
G.Data, Op -> ()
(Op -> ()) -> NFData Op
forall a. (a -> ()) -> NFData a
$crnf :: Op -> ()
rnf :: Op -> ()
NFData)

-- | Special relations supported by z3
data SpecialRelOp = IsPartialOrder         String
                  | IsLinearOrder          String
                  | IsTreeOrder            String
                  | IsPiecewiseLinearOrder String
                  deriving (SpecialRelOp -> SpecialRelOp -> Bool
(SpecialRelOp -> SpecialRelOp -> Bool)
-> (SpecialRelOp -> SpecialRelOp -> Bool) -> Eq SpecialRelOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecialRelOp -> SpecialRelOp -> Bool
== :: SpecialRelOp -> SpecialRelOp -> Bool
$c/= :: SpecialRelOp -> SpecialRelOp -> Bool
/= :: SpecialRelOp -> SpecialRelOp -> Bool
Eq, Eq SpecialRelOp
Eq SpecialRelOp =>
(SpecialRelOp -> SpecialRelOp -> Ordering)
-> (SpecialRelOp -> SpecialRelOp -> Bool)
-> (SpecialRelOp -> SpecialRelOp -> Bool)
-> (SpecialRelOp -> SpecialRelOp -> Bool)
-> (SpecialRelOp -> SpecialRelOp -> Bool)
-> (SpecialRelOp -> SpecialRelOp -> SpecialRelOp)
-> (SpecialRelOp -> SpecialRelOp -> SpecialRelOp)
-> Ord SpecialRelOp
SpecialRelOp -> SpecialRelOp -> Bool
SpecialRelOp -> SpecialRelOp -> Ordering
SpecialRelOp -> SpecialRelOp -> SpecialRelOp
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
$ccompare :: SpecialRelOp -> SpecialRelOp -> Ordering
compare :: SpecialRelOp -> SpecialRelOp -> Ordering
$c< :: SpecialRelOp -> SpecialRelOp -> Bool
< :: SpecialRelOp -> SpecialRelOp -> Bool
$c<= :: SpecialRelOp -> SpecialRelOp -> Bool
<= :: SpecialRelOp -> SpecialRelOp -> Bool
$c> :: SpecialRelOp -> SpecialRelOp -> Bool
> :: SpecialRelOp -> SpecialRelOp -> Bool
$c>= :: SpecialRelOp -> SpecialRelOp -> Bool
>= :: SpecialRelOp -> SpecialRelOp -> Bool
$cmax :: SpecialRelOp -> SpecialRelOp -> SpecialRelOp
max :: SpecialRelOp -> SpecialRelOp -> SpecialRelOp
$cmin :: SpecialRelOp -> SpecialRelOp -> SpecialRelOp
min :: SpecialRelOp -> SpecialRelOp -> SpecialRelOp
Ord, Typeable SpecialRelOp
Typeable SpecialRelOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SpecialRelOp -> c SpecialRelOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SpecialRelOp)
-> (SpecialRelOp -> Constr)
-> (SpecialRelOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SpecialRelOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SpecialRelOp))
-> ((forall b. Data b => b -> b) -> SpecialRelOp -> SpecialRelOp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> SpecialRelOp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SpecialRelOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp)
-> Data SpecialRelOp
SpecialRelOp -> Constr
SpecialRelOp -> DataType
(forall b. Data b => b -> b) -> SpecialRelOp -> SpecialRelOp
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) -> SpecialRelOp -> u
forall u. (forall d. Data d => d -> u) -> SpecialRelOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecialRelOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecialRelOp -> c SpecialRelOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecialRelOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecialRelOp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecialRelOp -> c SpecialRelOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecialRelOp -> c SpecialRelOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecialRelOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecialRelOp
$ctoConstr :: SpecialRelOp -> Constr
toConstr :: SpecialRelOp -> Constr
$cdataTypeOf :: SpecialRelOp -> DataType
dataTypeOf :: SpecialRelOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecialRelOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecialRelOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecialRelOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecialRelOp)
$cgmapT :: (forall b. Data b => b -> b) -> SpecialRelOp -> SpecialRelOp
gmapT :: (forall b. Data b => b -> b) -> SpecialRelOp -> SpecialRelOp
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecialRelOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SpecialRelOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SpecialRelOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SpecialRelOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SpecialRelOp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecialRelOp -> m SpecialRelOp
G.Data, Int -> SpecialRelOp -> ShowS
[SpecialRelOp] -> ShowS
SpecialRelOp -> [Char]
(Int -> SpecialRelOp -> ShowS)
-> (SpecialRelOp -> [Char])
-> ([SpecialRelOp] -> ShowS)
-> Show SpecialRelOp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecialRelOp -> ShowS
showsPrec :: Int -> SpecialRelOp -> ShowS
$cshow :: SpecialRelOp -> [Char]
show :: SpecialRelOp -> [Char]
$cshowList :: [SpecialRelOp] -> ShowS
showList :: [SpecialRelOp] -> ShowS
Show)

instance NFData SpecialRelOp where
  rnf :: SpecialRelOp -> ()
rnf (IsPartialOrder         [Char]
n) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
n
  rnf (IsLinearOrder          [Char]
n) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
n
  rnf (IsTreeOrder            [Char]
n) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
n
  rnf (IsPiecewiseLinearOrder [Char]
n) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
n

-- | 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
(FPOp -> FPOp -> Bool) -> (FPOp -> FPOp -> Bool) -> Eq FPOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FPOp -> FPOp -> Bool
== :: FPOp -> FPOp -> Bool
$c/= :: FPOp -> FPOp -> Bool
/= :: FPOp -> FPOp -> Bool
Eq, Eq FPOp
Eq FPOp =>
(FPOp -> FPOp -> Ordering)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> Bool)
-> (FPOp -> FPOp -> FPOp)
-> (FPOp -> FPOp -> FPOp)
-> Ord FPOp
FPOp -> FPOp -> Bool
FPOp -> FPOp -> Ordering
FPOp -> FPOp -> FPOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FPOp -> FPOp -> Ordering
compare :: FPOp -> FPOp -> Ordering
$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
>= :: FPOp -> FPOp -> Bool
$cmax :: FPOp -> FPOp -> FPOp
max :: FPOp -> FPOp -> FPOp
$cmin :: FPOp -> FPOp -> FPOp
min :: FPOp -> FPOp -> FPOp
Ord, Typeable FPOp
Typeable FPOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FPOp -> c FPOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FPOp)
-> (FPOp -> Constr)
-> (FPOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> FPOp -> FPOp)
-> (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 u. (forall d. Data d => d -> u) -> FPOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FPOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FPOp -> m FPOp)
-> Data FPOp
FPOp -> Constr
FPOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FPOp -> c FPOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FPOp -> c FPOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FPOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FPOp
$ctoConstr :: FPOp -> Constr
toConstr :: FPOp -> Constr
$cdataTypeOf :: FPOp -> DataType
dataTypeOf :: FPOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FPOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FPOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FPOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FPOp)
$cgmapT :: (forall b. Data b => b -> b) -> FPOp -> FPOp
gmapT :: (forall b. Data b => b -> b) -> FPOp -> FPOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FPOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FPOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FPOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FPOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FPOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FPOp -> m FPOp
G.Data, FPOp -> ()
(FPOp -> ()) -> NFData FPOp
forall a. (a -> ()) -> NFData a
$crnf :: FPOp -> ()
rnf :: FPOp -> ()
NFData, (forall x. FPOp -> Rep FPOp x)
-> (forall x. Rep FPOp x -> FPOp) -> Generic FPOp
forall x. Rep FPOp x -> FPOp
forall x. FPOp -> Rep FPOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FPOp -> Rep FPOp x
from :: forall x. FPOp -> Rep FPOp x
$cto :: forall x. Rep FPOp x -> FPOp
to :: forall x. Rep FPOp x -> FPOp
Generic)

-- 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: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", using RM [" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> [Char]
forall a. Show a => a -> [Char]
show SV
r [Char] -> ShowS
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
eb [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sb [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
                                  Kind
_         -> ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.FP_Reinterpret: Unexpected conversion: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" to " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
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
(NROp -> NROp -> Bool) -> (NROp -> NROp -> Bool) -> Eq NROp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NROp -> NROp -> Bool
== :: NROp -> NROp -> Bool
$c/= :: NROp -> NROp -> Bool
/= :: NROp -> NROp -> Bool
Eq, Eq NROp
Eq NROp =>
(NROp -> NROp -> Ordering)
-> (NROp -> NROp -> Bool)
-> (NROp -> NROp -> Bool)
-> (NROp -> NROp -> Bool)
-> (NROp -> NROp -> Bool)
-> (NROp -> NROp -> NROp)
-> (NROp -> NROp -> NROp)
-> Ord 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
$ccompare :: NROp -> NROp -> Ordering
compare :: NROp -> NROp -> Ordering
$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
>= :: NROp -> NROp -> Bool
$cmax :: NROp -> NROp -> NROp
max :: NROp -> NROp -> NROp
$cmin :: NROp -> NROp -> NROp
min :: NROp -> NROp -> NROp
Ord, Typeable NROp
Typeable NROp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NROp -> c NROp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NROp)
-> (NROp -> Constr)
-> (NROp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> NROp -> NROp)
-> (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 u. (forall d. Data d => d -> u) -> NROp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NROp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NROp -> m NROp)
-> Data NROp
NROp -> Constr
NROp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NROp -> c NROp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NROp -> c NROp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NROp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NROp
$ctoConstr :: NROp -> Constr
toConstr :: NROp -> Constr
$cdataTypeOf :: NROp -> DataType
dataTypeOf :: NROp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NROp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NROp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NROp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NROp)
$cgmapT :: (forall b. Data b => b -> b) -> NROp -> NROp
gmapT :: (forall b. Data b => b -> b) -> NROp -> NROp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NROp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NROp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NROp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NROp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NROp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NROp -> m NROp
G.Data, NROp -> ()
(NROp -> ()) -> NFData NROp
forall a. (a -> ()) -> NFData a
$crnf :: NROp -> ()
rnf :: NROp -> ()
NFData, (forall x. NROp -> Rep NROp x)
-> (forall x. Rep NROp x -> NROp) -> Generic NROp
forall x. Rep NROp x -> NROp
forall x. NROp -> Rep NROp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NROp -> Rep NROp x
from :: forall x. NROp -> Rep NROp x
$cto :: forall x. Rep NROp x -> NROp
to :: forall x. Rep NROp x -> NROp
Generic)

-- | 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
(PBOp -> PBOp -> Bool) -> (PBOp -> PBOp -> Bool) -> Eq PBOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PBOp -> PBOp -> Bool
== :: PBOp -> PBOp -> Bool
$c/= :: PBOp -> PBOp -> Bool
/= :: PBOp -> PBOp -> Bool
Eq, Eq PBOp
Eq PBOp =>
(PBOp -> PBOp -> Ordering)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> Bool)
-> (PBOp -> PBOp -> PBOp)
-> (PBOp -> PBOp -> PBOp)
-> Ord PBOp
PBOp -> PBOp -> Bool
PBOp -> PBOp -> Ordering
PBOp -> PBOp -> PBOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PBOp -> PBOp -> Ordering
compare :: PBOp -> PBOp -> Ordering
$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
>= :: PBOp -> PBOp -> Bool
$cmax :: PBOp -> PBOp -> PBOp
max :: PBOp -> PBOp -> PBOp
$cmin :: PBOp -> PBOp -> PBOp
min :: PBOp -> PBOp -> PBOp
Ord, Int -> PBOp -> ShowS
[PBOp] -> ShowS
PBOp -> [Char]
(Int -> PBOp -> ShowS)
-> (PBOp -> [Char]) -> ([PBOp] -> ShowS) -> Show PBOp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PBOp -> ShowS
showsPrec :: Int -> PBOp -> ShowS
$cshow :: PBOp -> [Char]
show :: PBOp -> [Char]
$cshowList :: [PBOp] -> ShowS
showList :: [PBOp] -> ShowS
Show, Typeable PBOp
Typeable PBOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PBOp -> c PBOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PBOp)
-> (PBOp -> Constr)
-> (PBOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> PBOp -> PBOp)
-> (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 u. (forall d. Data d => d -> u) -> PBOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PBOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PBOp -> m PBOp)
-> Data PBOp
PBOp -> Constr
PBOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PBOp -> c PBOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PBOp -> c PBOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PBOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PBOp
$ctoConstr :: PBOp -> Constr
toConstr :: PBOp -> Constr
$cdataTypeOf :: PBOp -> DataType
dataTypeOf :: PBOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PBOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PBOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PBOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PBOp)
$cgmapT :: (forall b. Data b => b -> b) -> PBOp -> PBOp
gmapT :: (forall b. Data b => b -> b) -> PBOp -> PBOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PBOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PBOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PBOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PBOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PBOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PBOp -> m PBOp
G.Data, PBOp -> ()
(PBOp -> ()) -> NFData PBOp
forall a. (a -> ()) -> NFData a
$crnf :: PBOp -> ()
rnf :: PBOp -> ()
NFData, (forall x. PBOp -> Rep PBOp x)
-> (forall x. Rep PBOp x -> PBOp) -> Generic PBOp
forall x. Rep PBOp x -> PBOp
forall x. PBOp -> Rep PBOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PBOp -> Rep PBOp x
from :: forall x. PBOp -> Rep PBOp x
$cto :: forall x. Rep PBOp x -> PBOp
to :: forall x. Rep PBOp x -> PBOp
Generic)

-- | Overflow operations
data OvOp = PlusOv Bool           -- ^ Addition    overflow.    Bool is True if signed.
          | SubOv  Bool           -- ^ Subtraction overflow.    Bool is True if signed.
          | MulOv  Bool           -- ^ Multiplication overflow. Bool is True if signed.
          | DivOv                 -- ^ Division overflow.       Only signed, since unsigned division does not overflow.
          | NegOv                 -- ^ Unary negation overflow. Only signed, since unsigned negation does not overflow.
          deriving (OvOp -> OvOp -> Bool
(OvOp -> OvOp -> Bool) -> (OvOp -> OvOp -> Bool) -> Eq OvOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OvOp -> OvOp -> Bool
== :: OvOp -> OvOp -> Bool
$c/= :: OvOp -> OvOp -> Bool
/= :: OvOp -> OvOp -> Bool
Eq, Eq OvOp
Eq OvOp =>
(OvOp -> OvOp -> Ordering)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> Bool)
-> (OvOp -> OvOp -> OvOp)
-> (OvOp -> OvOp -> OvOp)
-> Ord OvOp
OvOp -> OvOp -> Bool
OvOp -> OvOp -> Ordering
OvOp -> OvOp -> OvOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OvOp -> OvOp -> Ordering
compare :: OvOp -> OvOp -> Ordering
$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
>= :: OvOp -> OvOp -> Bool
$cmax :: OvOp -> OvOp -> OvOp
max :: OvOp -> OvOp -> OvOp
$cmin :: OvOp -> OvOp -> OvOp
min :: OvOp -> OvOp -> OvOp
Ord, Typeable OvOp
Typeable OvOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OvOp -> c OvOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OvOp)
-> (OvOp -> Constr)
-> (OvOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> OvOp -> OvOp)
-> (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 u. (forall d. Data d => d -> u) -> OvOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OvOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OvOp -> m OvOp)
-> Data OvOp
OvOp -> Constr
OvOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OvOp -> c OvOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OvOp -> c OvOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OvOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OvOp
$ctoConstr :: OvOp -> Constr
toConstr :: OvOp -> Constr
$cdataTypeOf :: OvOp -> DataType
dataTypeOf :: OvOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OvOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OvOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OvOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OvOp)
$cgmapT :: (forall b. Data b => b -> b) -> OvOp -> OvOp
gmapT :: (forall b. Data b => b -> b) -> OvOp -> OvOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OvOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OvOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OvOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OvOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OvOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OvOp -> m OvOp
G.Data, OvOp -> ()
(OvOp -> ()) -> NFData OvOp
forall a. (a -> ()) -> NFData a
$crnf :: OvOp -> ()
rnf :: OvOp -> ()
NFData, (forall x. OvOp -> Rep OvOp x)
-> (forall x. Rep OvOp x -> OvOp) -> Generic OvOp
forall x. Rep OvOp x -> OvOp
forall x. OvOp -> Rep OvOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OvOp -> Rep OvOp x
from :: forall x. OvOp -> Rep OvOp x
$cto :: forall x. Rep OvOp x -> OvOp
to :: forall x. Rep OvOp x -> OvOp
Generic)

-- | Show instance. It's important that these follow the SMTLib names.
instance Show OvOp where
  show :: OvOp -> [Char]
show (PlusOv Bool
signed) = [Char]
"bv" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
signed then [Char]
"s" else [Char]
"u") [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"addo"
  show (SubOv  Bool
signed) = [Char]
"bv" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
signed then [Char]
"s" else [Char]
"u") [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"subo"
  show (MulOv  Bool
signed) = [Char]
"bv" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
signed then [Char]
"s" else [Char]
"u") [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"mulo"
  show OvOp
DivOv           = [Char]
"bvsdivo" -- This is confusing, the division is called bvsdivo, but negation is bvnego
  show OvOp
NegOv           = [Char]
"bvnego"  -- But SMTLib's choice is deliberate: https://groups.google.com/u/0/g/smt-lib/c/J4D99wT0aKI

-- | 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
(StrOp -> StrOp -> Bool) -> (StrOp -> StrOp -> Bool) -> Eq StrOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrOp -> StrOp -> Bool
== :: StrOp -> StrOp -> Bool
$c/= :: StrOp -> StrOp -> Bool
/= :: StrOp -> StrOp -> Bool
Eq, Eq StrOp
Eq StrOp =>
(StrOp -> StrOp -> Ordering)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> Bool)
-> (StrOp -> StrOp -> StrOp)
-> (StrOp -> StrOp -> StrOp)
-> Ord StrOp
StrOp -> StrOp -> Bool
StrOp -> StrOp -> Ordering
StrOp -> StrOp -> StrOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StrOp -> StrOp -> Ordering
compare :: StrOp -> StrOp -> Ordering
$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
>= :: StrOp -> StrOp -> Bool
$cmax :: StrOp -> StrOp -> StrOp
max :: StrOp -> StrOp -> StrOp
$cmin :: StrOp -> StrOp -> StrOp
min :: StrOp -> StrOp -> StrOp
Ord, Typeable StrOp
Typeable StrOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> StrOp -> c StrOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StrOp)
-> (StrOp -> Constr)
-> (StrOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> StrOp -> StrOp)
-> (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 u. (forall d. Data d => d -> u) -> StrOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> StrOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StrOp -> m StrOp)
-> Data StrOp
StrOp -> Constr
StrOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StrOp -> c StrOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StrOp -> c StrOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StrOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StrOp
$ctoConstr :: StrOp -> Constr
toConstr :: StrOp -> Constr
$cdataTypeOf :: StrOp -> DataType
dataTypeOf :: StrOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StrOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StrOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StrOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StrOp)
$cgmapT :: (forall b. Data b => b -> b) -> StrOp -> StrOp
gmapT :: (forall b. Data b => b -> b) -> StrOp -> StrOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StrOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StrOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StrOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StrOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StrOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StrOp -> m StrOp
G.Data, StrOp -> ()
(StrOp -> ()) -> NFData StrOp
forall a. (a -> ()) -> NFData a
$crnf :: StrOp -> ()
rnf :: StrOp -> ()
NFData, (forall x. StrOp -> Rep StrOp x)
-> (forall x. Rep StrOp x -> StrOp) -> Generic StrOp
forall x. Rep StrOp x -> StrOp
forall x. StrOp -> Rep StrOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StrOp -> Rep StrOp x
from :: forall x. StrOp -> Rep StrOp x
$cto :: forall x. Rep StrOp x -> StrOp
to :: forall x. Rep StrOp x -> StrOp
Generic)

-- | 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
(RegExOp -> RegExOp -> Bool)
-> (RegExOp -> RegExOp -> Bool) -> Eq RegExOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegExOp -> RegExOp -> Bool
== :: RegExOp -> RegExOp -> Bool
$c/= :: RegExOp -> RegExOp -> Bool
/= :: RegExOp -> RegExOp -> Bool
Eq, Eq RegExOp
Eq RegExOp =>
(RegExOp -> RegExOp -> Ordering)
-> (RegExOp -> RegExOp -> Bool)
-> (RegExOp -> RegExOp -> Bool)
-> (RegExOp -> RegExOp -> Bool)
-> (RegExOp -> RegExOp -> Bool)
-> (RegExOp -> RegExOp -> RegExOp)
-> (RegExOp -> RegExOp -> RegExOp)
-> Ord 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
$ccompare :: RegExOp -> RegExOp -> Ordering
compare :: RegExOp -> RegExOp -> Ordering
$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
>= :: RegExOp -> RegExOp -> Bool
$cmax :: RegExOp -> RegExOp -> RegExOp
max :: RegExOp -> RegExOp -> RegExOp
$cmin :: RegExOp -> RegExOp -> RegExOp
min :: RegExOp -> RegExOp -> RegExOp
Ord, Typeable RegExOp
Typeable RegExOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RegExOp -> c RegExOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RegExOp)
-> (RegExOp -> Constr)
-> (RegExOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> RegExOp -> RegExOp)
-> (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 u. (forall d. Data d => d -> u) -> RegExOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RegExOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RegExOp -> m RegExOp)
-> Data RegExOp
RegExOp -> Constr
RegExOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExOp -> c RegExOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExOp -> c RegExOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExOp
$ctoConstr :: RegExOp -> Constr
toConstr :: RegExOp -> Constr
$cdataTypeOf :: RegExOp -> DataType
dataTypeOf :: RegExOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExOp)
$cgmapT :: (forall b. Data b => b -> b) -> RegExOp -> RegExOp
gmapT :: (forall b. Data b => b -> b) -> RegExOp -> RegExOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegExOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RegExOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RegExOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExOp -> m RegExOp
G.Data, RegExOp -> ()
(RegExOp -> ()) -> NFData RegExOp
forall a. (a -> ()) -> NFData a
$crnf :: RegExOp -> ()
rnf :: RegExOp -> ()
NFData, (forall x. RegExOp -> Rep RegExOp x)
-> (forall x. Rep RegExOp x -> RegExOp) -> Generic RegExOp
forall x. Rep RegExOp x -> RegExOp
forall x. RegExOp -> Rep RegExOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegExOp -> Rep RegExOp x
from :: forall x. RegExOp -> Rep RegExOp x
$cto :: forall x. Rep RegExOp x -> RegExOp
to :: forall x. Rep RegExOp x -> RegExOp
Generic)

-- | 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
(RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool) -> Eq RegExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegExp -> RegExp -> Bool
== :: RegExp -> RegExp -> Bool
$c/= :: RegExp -> RegExp -> Bool
/= :: RegExp -> RegExp -> Bool
Eq, Eq RegExp
Eq RegExp =>
(RegExp -> RegExp -> Ordering)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> Bool)
-> (RegExp -> RegExp -> RegExp)
-> (RegExp -> RegExp -> RegExp)
-> Ord RegExp
RegExp -> RegExp -> Bool
RegExp -> RegExp -> Ordering
RegExp -> RegExp -> RegExp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RegExp -> RegExp -> Ordering
compare :: RegExp -> RegExp -> Ordering
$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
>= :: RegExp -> RegExp -> Bool
$cmax :: RegExp -> RegExp -> RegExp
max :: RegExp -> RegExp -> RegExp
$cmin :: RegExp -> RegExp -> RegExp
min :: RegExp -> RegExp -> RegExp
Ord, Typeable RegExp
Typeable RegExp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RegExp -> c RegExp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RegExp)
-> (RegExp -> Constr)
-> (RegExp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> RegExp -> RegExp)
-> (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 u. (forall d. Data d => d -> u) -> RegExp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RegExp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RegExp -> m RegExp)
-> Data RegExp
RegExp -> Constr
RegExp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExp -> c RegExp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegExp -> c RegExp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegExp
$ctoConstr :: RegExp -> Constr
toConstr :: RegExp -> Constr
$cdataTypeOf :: RegExp -> DataType
dataTypeOf :: RegExp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegExp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RegExp)
$cgmapT :: (forall b. Data b => b -> b) -> RegExp -> RegExp
gmapT :: (forall b. Data b => b -> b) -> RegExp -> RegExp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RegExp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RegExp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RegExp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RegExp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RegExp -> m RegExp
G.Data, (forall x. RegExp -> Rep RegExp x)
-> (forall x. Rep RegExp x -> RegExp) -> Generic RegExp
forall x. Rep RegExp x -> RegExp
forall x. RegExp -> Rep RegExp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegExp -> Rep RegExp x
from :: forall x. RegExp -> Rep RegExp x
$cto :: forall x. Rep RegExp x -> RegExp
to :: forall x. Rep RegExp x -> RegExp
Generic, RegExp -> ()
(RegExp -> ()) -> NFData RegExp
forall a. (a -> ()) -> NFData a
$crnf :: RegExp -> ()
rnf :: RegExp -> ()
NFData)

-- | 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 [RegExp] -> [RegExp] -> [RegExp]
forall a. [a] -> [a] -> [a]
++ [RegExp
y])
  RegExp
x * Conc [RegExp]
ys = [RegExp] -> RegExp
Conc (RegExp
x  RegExp -> [RegExp] -> [RegExp]
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 [RegExp] -> [RegExp] -> [RegExp]
forall a. [a] -> [a] -> [a]
++ [RegExp
y])
  RegExp
x + Union [RegExp]
ys = [RegExp] -> RegExp
Union (RegExp
x  RegExp -> [RegExp] -> [RegExp]
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         = [Char] -> RegExp -> RegExp
forall a. HasCallStack => [Char] -> a
error [Char]
"Num.RegExp: no abs method"
  signum :: RegExp -> RegExp
signum      = [Char] -> RegExp -> RegExp
forall a. HasCallStack => [Char] -> a
error [Char]
"Num.RegExp: no signum method"

  fromInteger :: Integer -> RegExp
fromInteger Integer
x
    | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = RegExp
None
    | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1    = [Char] -> RegExp
Literal [Char]
""   -- Unit for concatenation is the empty string
    | Bool
True      = [Char] -> RegExp
forall a. HasCallStack => [Char] -> a
error ([Char] -> RegExp) -> [Char] -> RegExp
forall a b. (a -> b) -> a -> b
$ [Char]
"Num.RegExp: Only 0 and 1 makes sense as a reg-exp, no meaning for: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
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 ShowS
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
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
stringToQFS [Char]
s [Char] -> ShowS
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fs [Char]
s [Char] -> ShowS
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fs [Char
ch1] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fs [Char
ch2] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
_  (Conc [])         = Integer -> [Char]
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.++ " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ((RegExp -> [Char]) -> [RegExp] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> RegExp -> [Char]
regExpToString ShowS
fs) [RegExp]
xs) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (KStar RegExp
r)         = [Char]
"(re.* " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (KPlus RegExp
r)         = [Char]
"(re.+ " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Opt   RegExp
r)         = [Char]
"(re.opt " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Comp  RegExp
r)         = [Char]
"(re.comp " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Diff  RegExp
r1 RegExp
r2)     = [Char]
"(re.diff " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
regExpToString ShowS
fs (Loop  Int
lo Int
hi RegExp
r)
   | Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
hi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lo = [Char]
"((_ re.loop " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lo [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
hi [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   | Bool
True              = ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid regular-expression Loop with arguments: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
lo, Int
hi)
regExpToString ShowS
fs (Power Int
n RegExp
r)
   | Int
n Int -> Int -> Bool
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              = ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid regular-expression Power with arguments: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
regExpToString ShowS
fs (Inter RegExp
r1 RegExp
r2)     = [Char]
"(re.inter " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> RegExp -> [Char]
regExpToString ShowS
fs RegExp
r2 [Char] -> ShowS
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ((RegExp -> [Char]) -> [RegExp] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> RegExp -> [Char]
regExpToString ShowS
fs) [RegExp]
xs) [Char] -> ShowS
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 " [Char] -> ShowS
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]
"(= "        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (RegExNEq RegExp
r1 RegExp
r2) = [Char]
"(distinct " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ RegExp -> [Char]
regExpToSMTString RegExp
r2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | For now, we represent lambda functions in op with their SMTLib equivalent strings.
-- This might change in the future.
newtype SMTLambda = SMTLambda String
                  deriving (SMTLambda -> SMTLambda -> Bool
(SMTLambda -> SMTLambda -> Bool)
-> (SMTLambda -> SMTLambda -> Bool) -> Eq SMTLambda
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SMTLambda -> SMTLambda -> Bool
== :: SMTLambda -> SMTLambda -> Bool
$c/= :: SMTLambda -> SMTLambda -> Bool
/= :: SMTLambda -> SMTLambda -> Bool
Eq, Eq SMTLambda
Eq SMTLambda =>
(SMTLambda -> SMTLambda -> Ordering)
-> (SMTLambda -> SMTLambda -> Bool)
-> (SMTLambda -> SMTLambda -> Bool)
-> (SMTLambda -> SMTLambda -> Bool)
-> (SMTLambda -> SMTLambda -> Bool)
-> (SMTLambda -> SMTLambda -> SMTLambda)
-> (SMTLambda -> SMTLambda -> SMTLambda)
-> Ord SMTLambda
SMTLambda -> SMTLambda -> Bool
SMTLambda -> SMTLambda -> Ordering
SMTLambda -> SMTLambda -> SMTLambda
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
$ccompare :: SMTLambda -> SMTLambda -> Ordering
compare :: SMTLambda -> SMTLambda -> Ordering
$c< :: SMTLambda -> SMTLambda -> Bool
< :: SMTLambda -> SMTLambda -> Bool
$c<= :: SMTLambda -> SMTLambda -> Bool
<= :: SMTLambda -> SMTLambda -> Bool
$c> :: SMTLambda -> SMTLambda -> Bool
> :: SMTLambda -> SMTLambda -> Bool
$c>= :: SMTLambda -> SMTLambda -> Bool
>= :: SMTLambda -> SMTLambda -> Bool
$cmax :: SMTLambda -> SMTLambda -> SMTLambda
max :: SMTLambda -> SMTLambda -> SMTLambda
$cmin :: SMTLambda -> SMTLambda -> SMTLambda
min :: SMTLambda -> SMTLambda -> SMTLambda
Ord, Typeable SMTLambda
Typeable SMTLambda =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SMTLambda -> c SMTLambda)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SMTLambda)
-> (SMTLambda -> Constr)
-> (SMTLambda -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SMTLambda))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTLambda))
-> ((forall b. Data b => b -> b) -> SMTLambda -> SMTLambda)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SMTLambda -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SMTLambda -> r)
-> (forall u. (forall d. Data d => d -> u) -> SMTLambda -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SMTLambda -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda)
-> Data SMTLambda
SMTLambda -> Constr
SMTLambda -> DataType
(forall b. Data b => b -> b) -> SMTLambda -> SMTLambda
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) -> SMTLambda -> u
forall u. (forall d. Data d => d -> u) -> SMTLambda -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SMTLambda -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SMTLambda -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SMTLambda
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SMTLambda -> c SMTLambda
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SMTLambda)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTLambda)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SMTLambda -> c SMTLambda
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SMTLambda -> c SMTLambda
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SMTLambda
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SMTLambda
$ctoConstr :: SMTLambda -> Constr
toConstr :: SMTLambda -> Constr
$cdataTypeOf :: SMTLambda -> DataType
dataTypeOf :: SMTLambda -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SMTLambda)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SMTLambda)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTLambda)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTLambda)
$cgmapT :: (forall b. Data b => b -> b) -> SMTLambda -> SMTLambda
gmapT :: (forall b. Data b => b -> b) -> SMTLambda -> SMTLambda
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SMTLambda -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SMTLambda -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SMTLambda -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SMTLambda -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SMTLambda -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SMTLambda -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SMTLambda -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SMTLambda -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTLambda -> m SMTLambda
G.Data, (forall x. SMTLambda -> Rep SMTLambda x)
-> (forall x. Rep SMTLambda x -> SMTLambda) -> Generic SMTLambda
forall x. Rep SMTLambda x -> SMTLambda
forall x. SMTLambda -> Rep SMTLambda x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SMTLambda -> Rep SMTLambda x
from :: forall x. SMTLambda -> Rep SMTLambda x
$cto :: forall x. Rep SMTLambda x -> SMTLambda
to :: forall x. Rep SMTLambda x -> SMTLambda
Generic)
                  deriving newtype SMTLambda -> ()
(SMTLambda -> ()) -> NFData SMTLambda
forall a. (a -> ()) -> NFData a
$crnf :: SMTLambda -> ()
rnf :: SMTLambda -> ()
NFData

-- | Simple show instance for SMTLambda
instance Show SMTLambda where
  show :: SMTLambda -> [Char]
show (SMTLambda [Char]
s) = [Char]
s

-- | 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
           -- Polymorphic and higher order functions
           | SBVReverse   Kind                     -- ^ reverse k.         Where k is either [a] or String. Reverses the argument, accordingly.
           | SBVZip       Kind Kind                -- ^ zip a b.           Where we zip [a] and [b] to produce [(a, b)]
           | SBVZipWith   Kind Kind Kind SMTLambda -- ^ zipWith a b c fun. Where fun :: a -> b -> c, and zipWith   :: (a -> b -> c) -> [a] -> [b] -> [c]
           | SBVPartition Kind           SMTLambda -- ^ partition a fun.   Where fun :: a -> SBool,  and partition :: (a -> Bool) -> [a] -> ([a], [a])
           | SBVMap       Kind Kind      SMTLambda -- ^ map    a b fun.    Where fun :: a -> b,      and map       :: (a -> b) -> [a] -> [b]
           | SBVFoldl     Kind Kind      SMTLambda -- ^ foldl  a b fun.    Where fun :: b -> a -> b, and foldl     :: (b -> a -> b) -> b -> [a] -> b
           | SBVFoldr     Kind Kind      SMTLambda -- ^ foldr  a b fun.    Where fun :: a -> b -> b, and foldr     :: (a -> b -> b) -> b -> [a] -> b
           | SBVFilter    Kind           SMTLambda -- ^ filter a fun.      Where fun :: a -> Bool,   and filter    :: (a -> Bool) -> [a] -> [a]
           | SBVAll       Kind           SMTLambda -- ^ all    a fun.      Where fun :: a -> Bool,   and all       :: (a -> Bool) -> [a] -> Bool
           | SBVAny       Kind           SMTLambda -- ^ any    a fun.      Where fun :: a -> Bool,   and any       :: (a -> Bool) -> [a] -> Bool
           | SBVConcat    Kind                     -- ^ concat a.          Where we concat [[a]] to get [a] (a is the inside-element type)
  deriving (SeqOp -> SeqOp -> Bool
(SeqOp -> SeqOp -> Bool) -> (SeqOp -> SeqOp -> Bool) -> Eq SeqOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeqOp -> SeqOp -> Bool
== :: SeqOp -> SeqOp -> Bool
$c/= :: SeqOp -> SeqOp -> Bool
/= :: SeqOp -> SeqOp -> Bool
Eq, Eq SeqOp
Eq SeqOp =>
(SeqOp -> SeqOp -> Ordering)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> SeqOp)
-> (SeqOp -> SeqOp -> SeqOp)
-> Ord SeqOp
SeqOp -> SeqOp -> Bool
SeqOp -> SeqOp -> Ordering
SeqOp -> SeqOp -> SeqOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SeqOp -> SeqOp -> Ordering
compare :: SeqOp -> SeqOp -> Ordering
$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
>= :: SeqOp -> SeqOp -> Bool
$cmax :: SeqOp -> SeqOp -> SeqOp
max :: SeqOp -> SeqOp -> SeqOp
$cmin :: SeqOp -> SeqOp -> SeqOp
min :: SeqOp -> SeqOp -> SeqOp
Ord, Typeable SeqOp
Typeable SeqOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SeqOp -> c SeqOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SeqOp)
-> (SeqOp -> Constr)
-> (SeqOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SeqOp -> SeqOp)
-> (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 u. (forall d. Data d => d -> u) -> SeqOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SeqOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SeqOp -> m SeqOp)
-> Data SeqOp
SeqOp -> Constr
SeqOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SeqOp -> c SeqOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SeqOp -> c SeqOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SeqOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SeqOp
$ctoConstr :: SeqOp -> Constr
toConstr :: SeqOp -> Constr
$cdataTypeOf :: SeqOp -> DataType
dataTypeOf :: SeqOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SeqOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SeqOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SeqOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SeqOp)
$cgmapT :: (forall b. Data b => b -> b) -> SeqOp -> SeqOp
gmapT :: (forall b. Data b => b -> b) -> SeqOp -> SeqOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SeqOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SeqOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SeqOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SeqOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SeqOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SeqOp -> m SeqOp
G.Data, SeqOp -> ()
(SeqOp -> ()) -> NFData SeqOp
forall a. (a -> ()) -> NFData a
$crnf :: SeqOp -> ()
rnf :: SeqOp -> ()
NFData, (forall x. SeqOp -> Rep SeqOp x)
-> (forall x. Rep SeqOp x -> SeqOp) -> Generic SeqOp
forall x. Rep SeqOp x -> SeqOp
forall x. SeqOp -> Rep SeqOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SeqOp -> Rep SeqOp x
from :: forall x. SeqOp -> Rep SeqOp x
$cto :: forall x. Rep SeqOp x -> SeqOp
to :: forall x. Rep SeqOp x -> SeqOp
Generic)

-- | 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: The followings aren't part of SMTLib, we explicitly handle them
  show (SBVReverse   Kind
a)       = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.reverse"   Kind
a                  Maybe SMTLambda
forall a. Maybe a
Nothing
  show (SBVZip       Kind
a Kind
b)     = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.zip"       ([Kind] -> Kind
KTuple [Kind
a, Kind
b])    Maybe SMTLambda
forall a. Maybe a
Nothing
  show (SBVZipWith   Kind
a Kind
b Kind
c SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.zipWith"   ([Kind] -> Kind
KTuple [Kind
a, Kind
b, Kind
c]) (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVPartition Kind
a     SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.partition" Kind
a                  (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVMap       Kind
a Kind
b   SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.map"       ([Kind] -> Kind
KTuple [Kind
a, Kind
b])    (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVFoldl     Kind
a Kind
b   SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.foldl"     ([Kind] -> Kind
KTuple [Kind
a, Kind
b])    (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVFoldr     Kind
a Kind
b   SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.foldr"     ([Kind] -> Kind
KTuple [Kind
a, Kind
b])    (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVFilter    Kind
a     SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.filter"    Kind
a                  (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVAll       Kind
a     SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.all"       Kind
a                  (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVAny       Kind
a     SMTLambda
f) = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.any"       Kind
a                  (SMTLambda -> Maybe SMTLambda
forall a. a -> Maybe a
Just SMTLambda
f)
  show (SBVConcat    Kind
a)       = [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
"sbv.concat"    Kind
a                  Maybe SMTLambda
forall a. Maybe a
Nothing

-- helper for above
funcWithKind :: String -> Kind -> Maybe SMTLambda -> String
funcWithKind :: [Char] -> Kind -> Maybe SMTLambda -> [Char]
funcWithKind [Char]
f Kind
k Maybe SMTLambda
mbExtra = [Char]
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" @" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ssk [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> (SMTLambda -> [Char]) -> Maybe SMTLambda -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\SMTLambda
l -> Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: SMTLambda -> [Char]
forall a. Show a => a -> [Char]
show SMTLambda
l) Maybe SMTLambda
mbExtra
  where sk :: [Char]
sk  = Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
        ssk :: [Char]
ssk | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace [Char]
sk = Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
sk [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
            | Bool
True           = [Char]
sk

-- | Set operations.
data SetOp = SetEqual
           | SetMember
           | SetInsert
           | SetDelete
           | SetIntersect
           | SetUnion
           | SetSubset
           | SetDifference
           | SetComplement
        deriving (SetOp -> SetOp -> Bool
(SetOp -> SetOp -> Bool) -> (SetOp -> SetOp -> Bool) -> Eq SetOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetOp -> SetOp -> Bool
== :: SetOp -> SetOp -> Bool
$c/= :: SetOp -> SetOp -> Bool
/= :: SetOp -> SetOp -> Bool
Eq, Eq SetOp
Eq SetOp =>
(SetOp -> SetOp -> Ordering)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> Bool)
-> (SetOp -> SetOp -> SetOp)
-> (SetOp -> SetOp -> SetOp)
-> Ord SetOp
SetOp -> SetOp -> Bool
SetOp -> SetOp -> Ordering
SetOp -> SetOp -> SetOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SetOp -> SetOp -> Ordering
compare :: SetOp -> SetOp -> Ordering
$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
>= :: SetOp -> SetOp -> Bool
$cmax :: SetOp -> SetOp -> SetOp
max :: SetOp -> SetOp -> SetOp
$cmin :: SetOp -> SetOp -> SetOp
min :: SetOp -> SetOp -> SetOp
Ord, Typeable SetOp
Typeable SetOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SetOp -> c SetOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SetOp)
-> (SetOp -> Constr)
-> (SetOp -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SetOp -> SetOp)
-> (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 u. (forall d. Data d => d -> u) -> SetOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SetOp -> m SetOp)
-> Data SetOp
SetOp -> Constr
SetOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SetOp -> c SetOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SetOp
$ctoConstr :: SetOp -> Constr
toConstr :: SetOp -> Constr
$cdataTypeOf :: SetOp -> DataType
dataTypeOf :: SetOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SetOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SetOp)
$cgmapT :: (forall b. Data b => b -> b) -> SetOp -> SetOp
gmapT :: (forall b. Data b => b -> b) -> SetOp -> SetOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SetOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SetOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SetOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SetOp -> m SetOp
G.Data, SetOp -> ()
(SetOp -> ()) -> NFData SetOp
forall a. (a -> ()) -> NFData a
$crnf :: SetOp -> ()
rnf :: SetOp -> ()
NFData, (forall x. SetOp -> Rep SetOp x)
-> (forall x. Rep SetOp x -> SetOp) -> Generic SetOp
forall x. Rep SetOp x -> SetOp
forall x. SetOp -> Rep SetOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetOp -> Rep SetOp x
from :: forall x. SetOp -> Rep SetOp x
$cto :: forall x. Rep SetOp x -> SetOp
to :: forall x. Rep SetOp x -> SetOp
Generic)

-- 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 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]
"<<<" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
  show (Ror Int
i) = [Char]
">>>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i

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

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

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

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

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

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

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

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

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

  show (TupleConstructor   Int
0) = [Char]
"mkSBVTuple0"
  show (TupleConstructor   Int
n) = [Char]
"mkSBVTuple" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
  show (TupleAccess      Int
i Int
n) = [Char]
"proj_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_SBVTuple" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
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 "  [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (EitherConstructor Kind
k1 Kind
k2  Bool
True ) = [Char]
"(_ right_SBVEither " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (EitherIs          Kind
k1 Kind
k2  Bool
False) = [Char]
"(_ is (left_SBVEither ("  [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show (EitherIs          Kind
k1 Kind
k2  Bool
True ) = [Char]
"(_ is (right_SBVEither (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind -> Kind
KEither Kind
k1 Kind
k2) [Char] -> ShowS
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (MaybeConstructor Kind
k Bool
True)        = [Char]
"(_ just_SBVMaybe "    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (MaybeIs          Kind
k Bool
False)       = [Char]
"(_ is (nothing_SBVMaybe () "              [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show (MaybeIs          Kind
k Bool
True )       = [Char]
"(_ is (just_SBVMaybe (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (Kind -> Kind
KMaybe Kind
k) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"))"
  show Op
MaybeAccess                      = [Char]
"get_just_SBVMaybe"
  show (ArrayLambda SMTLambda
s)                  = SMTLambda -> [Char]
forall a. Show a => a -> [Char]
show SMTLambda
s
  show Op
ReadArray                        = [Char]
"select"
  show Op
WriteArray                       = [Char]
"store"

  show Op
op
    | Just [Char]
s <- Op
op Op -> [(Op, [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Op, [Char])]
syms = [Char]
s
    | Bool
True                       = ShowS
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible happened; can't find op!" -- NB. Can't display the OP here! it's the show instance after all.
    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
Implies, [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
(Quantifier -> Quantifier -> Bool)
-> (Quantifier -> Quantifier -> Bool) -> Eq Quantifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quantifier -> Quantifier -> Bool
== :: Quantifier -> Quantifier -> Bool
$c/= :: Quantifier -> Quantifier -> Bool
/= :: Quantifier -> Quantifier -> Bool
Eq, Typeable Quantifier
Typeable Quantifier =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Quantifier -> c Quantifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Quantifier)
-> (Quantifier -> Constr)
-> (Quantifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Quantifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Quantifier))
-> ((forall b. Data b => b -> b) -> Quantifier -> Quantifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Quantifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Quantifier -> r)
-> (forall u. (forall d. Data d => d -> u) -> Quantifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Quantifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Quantifier -> m Quantifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Quantifier -> m Quantifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Quantifier -> m Quantifier)
-> Data Quantifier
Quantifier -> Constr
Quantifier -> DataType
(forall b. Data b => b -> b) -> Quantifier -> Quantifier
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) -> Quantifier -> u
forall u. (forall d. Data d => d -> u) -> Quantifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Quantifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Quantifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quantifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quantifier -> c Quantifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quantifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantifier)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quantifier -> c Quantifier
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quantifier -> c Quantifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quantifier
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quantifier
$ctoConstr :: Quantifier -> Constr
toConstr :: Quantifier -> Constr
$cdataTypeOf :: Quantifier -> DataType
dataTypeOf :: Quantifier -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quantifier)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quantifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantifier)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantifier)
$cgmapT :: (forall b. Data b => b -> b) -> Quantifier -> Quantifier
gmapT :: (forall b. Data b => b -> b) -> Quantifier -> Quantifier
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Quantifier -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Quantifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Quantifier -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Quantifier -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Quantifier -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Quantifier -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Quantifier -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Quantifier -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantifier -> m Quantifier
G.Data)

-- | 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 Quantifier -> [Quantifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
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
(SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool) -> Eq SBVType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBVType -> SBVType -> Bool
== :: SBVType -> SBVType -> Bool
$c/= :: SBVType -> SBVType -> Bool
/= :: SBVType -> SBVType -> Bool
Eq, Eq SBVType
Eq SBVType =>
(SBVType -> SBVType -> Ordering)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> Bool)
-> (SBVType -> SBVType -> SBVType)
-> (SBVType -> SBVType -> SBVType)
-> Ord SBVType
SBVType -> SBVType -> Bool
SBVType -> SBVType -> Ordering
SBVType -> SBVType -> SBVType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SBVType -> SBVType -> Ordering
compare :: SBVType -> SBVType -> Ordering
$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
>= :: SBVType -> SBVType -> Bool
$cmax :: SBVType -> SBVType -> SBVType
max :: SBVType -> SBVType -> SBVType
$cmin :: SBVType -> SBVType -> SBVType
min :: SBVType -> SBVType -> SBVType
Ord, Typeable SBVType
Typeable SBVType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SBVType -> c SBVType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SBVType)
-> (SBVType -> Constr)
-> (SBVType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SBVType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVType))
-> ((forall b. Data b => b -> b) -> SBVType -> SBVType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SBVType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SBVType -> r)
-> (forall u. (forall d. Data d => d -> u) -> SBVType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SBVType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SBVType -> m SBVType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVType -> m SBVType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVType -> m SBVType)
-> Data SBVType
SBVType -> Constr
SBVType -> DataType
(forall b. Data b => b -> b) -> SBVType -> SBVType
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) -> SBVType -> u
forall u. (forall d. Data d => d -> u) -> SBVType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVType -> c SBVType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVType -> c SBVType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVType -> c SBVType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVType
$ctoConstr :: SBVType -> Constr
toConstr :: SBVType -> Constr
$cdataTypeOf :: SBVType -> DataType
dataTypeOf :: SBVType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVType)
$cgmapT :: (forall b. Data b => b -> b) -> SBVType -> SBVType
gmapT :: (forall b. Data b => b -> b) -> SBVType -> SBVType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SBVType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SBVType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SBVType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVType -> m SBVType
G.Data)

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

-- | A symbolic expression
data SBVExpr = SBVApp !Op ![SV]
             deriving (SBVExpr -> SBVExpr -> Bool
(SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool) -> Eq SBVExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SBVExpr -> SBVExpr -> Bool
== :: SBVExpr -> SBVExpr -> Bool
$c/= :: SBVExpr -> SBVExpr -> Bool
/= :: SBVExpr -> SBVExpr -> Bool
Eq, Eq SBVExpr
Eq SBVExpr =>
(SBVExpr -> SBVExpr -> Ordering)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> Bool)
-> (SBVExpr -> SBVExpr -> SBVExpr)
-> (SBVExpr -> SBVExpr -> SBVExpr)
-> Ord SBVExpr
SBVExpr -> SBVExpr -> Bool
SBVExpr -> SBVExpr -> Ordering
SBVExpr -> SBVExpr -> SBVExpr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SBVExpr -> SBVExpr -> Ordering
compare :: SBVExpr -> SBVExpr -> Ordering
$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
>= :: SBVExpr -> SBVExpr -> Bool
$cmax :: SBVExpr -> SBVExpr -> SBVExpr
max :: SBVExpr -> SBVExpr -> SBVExpr
$cmin :: SBVExpr -> SBVExpr -> SBVExpr
min :: SBVExpr -> SBVExpr -> SBVExpr
Ord, Typeable SBVExpr
Typeable SBVExpr =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SBVExpr -> c SBVExpr)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SBVExpr)
-> (SBVExpr -> Constr)
-> (SBVExpr -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SBVExpr -> SBVExpr)
-> (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 u. (forall d. Data d => d -> u) -> SBVExpr -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SBVExpr -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr)
-> Data SBVExpr
SBVExpr -> Constr
SBVExpr -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVExpr -> c SBVExpr
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVExpr -> c SBVExpr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVExpr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVExpr
$ctoConstr :: SBVExpr -> Constr
toConstr :: SBVExpr -> Constr
$cdataTypeOf :: SBVExpr -> DataType
dataTypeOf :: SBVExpr -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVExpr)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVExpr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVExpr)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVExpr)
$cgmapT :: (forall b. Data b => b -> b) -> SBVExpr -> SBVExpr
gmapT :: (forall b. Data b => b -> b) -> SBVExpr -> SBVExpr
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SBVExpr -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SBVExpr -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SBVExpr -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVExpr -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVExpr -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m SBVExpr
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVExpr -> m 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 SV -> SV -> Bool
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 Op -> [Op] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Op
Plus, Op
Times, Op
Equal, Op
NotEqual, Op
And, Op
Or, Op
XOr]

-- 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", SV -> [Char]
forall a. Show a => a -> [Char]
show SV
t, [Char]
"then", SV -> [Char]
forall a. Show a => a -> [Char]
show SV
a, [Char]
"else", SV -> [Char]
forall a. Show a => a -> [Char]
show SV
b]
  show (SBVApp Op
Shl     [SV
a, SV
i])          = [[Char]] -> [Char]
unwords [SV -> [Char]
forall a. Show a => a -> [Char]
show SV
a, [Char]
"<<", SV -> [Char]
forall a. Show a => a -> [Char]
show SV
i]
  show (SBVApp Op
Shr     [SV
a, SV
i])          = [[Char]] -> [Char]
unwords [SV -> [Char]
forall a. Show a => a -> [Char]
show SV
a, [Char]
">>", SV -> [Char]
forall a. Show a => a -> [Char]
show SV
i]
  show (SBVApp (Rol Int
i) [SV
a])             = [[Char]] -> [Char]
unwords [SV -> [Char]
forall a. Show a => a -> [Char]
show SV
a, [Char]
"<<<", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i]
  show (SBVApp (Ror Int
i) [SV
a])             = [[Char]] -> [Char]
unwords [SV -> [Char]
forall a. Show a => a -> [Char]
show SV
a, [Char]
">>>", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i]
  show (SBVApp (PseudoBoolean PBOp
pb) [SV]
args) = [[Char]] -> [Char]
unwords (PBOp -> [Char]
forall a. Show a => a -> [Char]
show PBOp
pb [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (SV -> [Char]) -> [SV] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SV -> [Char]
forall a. Show a => a -> [Char]
show [SV]
args)
  show (SBVApp (OverflowOp OvOp
op)    [SV]
args) = [[Char]] -> [Char]
unwords (OvOp -> [Char]
forall a. Show a => a -> [Char]
show OvOp
op [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (SV -> [Char]) -> [SV] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SV -> [Char]
forall a. Show a => a -> [Char]
show [SV]
args)

  show (SBVApp Op
op [SV]
args) | Op -> Bool
showOpInfix Op
op, [SV] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SV]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = [[Char]] -> [Char]
unwords ((SV -> [Char]) -> [SV] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SV -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [SV] -> [SV]
forall a. Int -> [a] -> [a]
take Int
1 [SV]
args) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Op -> [Char]
forall a. Show a => a -> [Char]
show Op
op [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (SV -> [Char]) -> [SV] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SV -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [SV] -> [SV]
forall a. Int -> [a] -> [a]
drop Int
1 [SV]
args))
                        | Bool
True                             = [[Char]] -> [Char]
unwords (Op -> [Char]
forall a. Show a => a -> [Char]
show Op
op [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (SV -> [Char]) -> [SV] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SV -> [Char]
forall a. Show a => a -> [Char]
show [SV]
args)

-- | Should we display this Op infix?
showOpInfix :: Op -> Bool
showOpInfix :: Op -> Bool
showOpInfix = (Op -> [Op] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Op]
infixOps)
  where infixOps :: [Op]
infixOps = [ Op
Plus, Op
Times, Op
Minus, Op
Quot, Op
Rem, Op
Implies
                   , Op
Equal, Op
NotEqual, Op
LessThan, Op
GreaterThan, Op
LessEq, Op
GreaterEq
                   , Op
And, Op
Or, Op
XOr, Op
Join
                   ]

-- | A program is a sequence of assignments
newtype SBVPgm = SBVPgm {SBVPgm -> Seq (SV, SBVExpr)
pgmAssignments :: S.Seq (SV, SBVExpr)}
               deriving Typeable SBVPgm
Typeable SBVPgm =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SBVPgm -> c SBVPgm)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SBVPgm)
-> (SBVPgm -> Constr)
-> (SBVPgm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SBVPgm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVPgm))
-> ((forall b. Data b => b -> b) -> SBVPgm -> SBVPgm)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r)
-> (forall u. (forall d. Data d => d -> u) -> SBVPgm -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SBVPgm -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm)
-> Data SBVPgm
SBVPgm -> Constr
SBVPgm -> DataType
(forall b. Data b => b -> b) -> SBVPgm -> SBVPgm
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) -> SBVPgm -> u
forall u. (forall d. Data d => d -> u) -> SBVPgm -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVPgm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVPgm -> c SBVPgm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVPgm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVPgm)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVPgm -> c SBVPgm
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SBVPgm -> c SBVPgm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVPgm
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SBVPgm
$ctoConstr :: SBVPgm -> Constr
toConstr :: SBVPgm -> Constr
$cdataTypeOf :: SBVPgm -> DataType
dataTypeOf :: SBVPgm -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVPgm)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SBVPgm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVPgm)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SBVPgm)
$cgmapT :: (forall b. Data b => b -> b) -> SBVPgm -> SBVPgm
gmapT :: (forall b. Data b => b -> b) -> SBVPgm -> SBVPgm
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SBVPgm -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SBVPgm -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SBVPgm -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVPgm -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SBVPgm -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SBVPgm -> m SBVPgm
G.Data

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

-- | t'NamedSymVar' pairs symbolic values and user given/automatically generated names
data NamedSymVar = NamedSymVar !SV !Name
                 deriving (Int -> NamedSymVar -> ShowS
[NamedSymVar] -> ShowS
NamedSymVar -> [Char]
(Int -> NamedSymVar -> ShowS)
-> (NamedSymVar -> [Char])
-> ([NamedSymVar] -> ShowS)
-> Show NamedSymVar
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedSymVar -> ShowS
showsPrec :: Int -> NamedSymVar -> ShowS
$cshow :: NamedSymVar -> [Char]
show :: NamedSymVar -> [Char]
$cshowList :: [NamedSymVar] -> ShowS
showList :: [NamedSymVar] -> ShowS
Show, (forall x. NamedSymVar -> Rep NamedSymVar x)
-> (forall x. Rep NamedSymVar x -> NamedSymVar)
-> Generic NamedSymVar
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
$cfrom :: forall x. NamedSymVar -> Rep NamedSymVar x
from :: forall x. NamedSymVar -> Rep NamedSymVar x
$cto :: forall x. Rep NamedSymVar x -> NamedSymVar
to :: forall x. Rep NamedSymVar x -> NamedSymVar
Generic, Typeable NamedSymVar
Typeable NamedSymVar =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NamedSymVar -> c NamedSymVar)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NamedSymVar)
-> (NamedSymVar -> Constr)
-> (NamedSymVar -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NamedSymVar))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NamedSymVar))
-> ((forall b. Data b => b -> b) -> NamedSymVar -> NamedSymVar)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r)
-> (forall u. (forall d. Data d => d -> u) -> NamedSymVar -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NamedSymVar -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar)
-> Data NamedSymVar
NamedSymVar -> Constr
NamedSymVar -> DataType
(forall b. Data b => b -> b) -> NamedSymVar -> NamedSymVar
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) -> NamedSymVar -> u
forall u. (forall d. Data d => d -> u) -> NamedSymVar -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamedSymVar
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NamedSymVar -> c NamedSymVar
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamedSymVar)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NamedSymVar)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NamedSymVar -> c NamedSymVar
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NamedSymVar -> c NamedSymVar
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamedSymVar
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamedSymVar
$ctoConstr :: NamedSymVar -> Constr
toConstr :: NamedSymVar -> Constr
$cdataTypeOf :: NamedSymVar -> DataType
dataTypeOf :: NamedSymVar -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamedSymVar)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamedSymVar)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NamedSymVar)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NamedSymVar)
$cgmapT :: (forall b. Data b => b -> b) -> NamedSymVar -> NamedSymVar
gmapT :: (forall b. Data b => b -> b) -> NamedSymVar -> NamedSymVar
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamedSymVar -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NamedSymVar -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NamedSymVar -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NamedSymVar -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NamedSymVar -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedSymVar -> m NamedSymVar
G.Data)

-- | 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 SV -> SV -> Bool
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
_) = SV -> SV -> Ordering
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 (Name -> NamedSymVar) -> ([Char] -> Name) -> [Char] -> NamedSymVar
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 (SV -> NodeId) -> (NamedSymVar -> SV) -> NamedSymVar -> NodeId
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 (Name -> [Char]) -> (NamedSymVar -> Name) -> NamedSymVar -> [Char]
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
(OptimizeStyle -> OptimizeStyle -> Bool)
-> (OptimizeStyle -> OptimizeStyle -> Bool) -> Eq OptimizeStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimizeStyle -> OptimizeStyle -> Bool
== :: OptimizeStyle -> OptimizeStyle -> Bool
$c/= :: OptimizeStyle -> OptimizeStyle -> Bool
/= :: OptimizeStyle -> OptimizeStyle -> Bool
Eq, Int -> OptimizeStyle -> ShowS
[OptimizeStyle] -> ShowS
OptimizeStyle -> [Char]
(Int -> OptimizeStyle -> ShowS)
-> (OptimizeStyle -> [Char])
-> ([OptimizeStyle] -> ShowS)
-> Show OptimizeStyle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptimizeStyle -> ShowS
showsPrec :: Int -> OptimizeStyle -> ShowS
$cshow :: OptimizeStyle -> [Char]
show :: OptimizeStyle -> [Char]
$cshowList :: [OptimizeStyle] -> ShowS
showList :: [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 v'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]
(Int -> Penalty -> ShowS)
-> (Penalty -> [Char]) -> ([Penalty] -> ShowS) -> Show Penalty
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Penalty -> ShowS
showsPrec :: Int -> Penalty -> ShowS
$cshow :: Penalty -> [Char]
show :: Penalty -> [Char]
$cshowList :: [Penalty] -> ShowS
showList :: [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
[Objective a] -> ShowS
Objective a -> [Char]
(Int -> Objective a -> ShowS)
-> (Objective a -> [Char])
-> ([Objective a] -> ShowS)
-> Show (Objective a)
forall a. Show a => Int -> Objective a -> ShowS
forall a. Show a => [Objective a] -> ShowS
forall a. Show a => Objective a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Objective a -> ShowS
showsPrec :: Int -> Objective a -> ShowS
$cshow :: forall a. Show a => Objective a -> [Char]
show :: Objective a -> [Char]
$cshowList :: forall a. Show a => [Objective a] -> ShowS
showList :: [Objective a] -> ShowS
Show, (forall a b. (a -> b) -> Objective a -> Objective b)
-> (forall a b. a -> Objective b -> Objective a)
-> Functor Objective
forall a b. a -> Objective b -> Objective a
forall a b. (a -> b) -> Objective a -> Objective b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Objective a -> Objective b
fmap :: forall a b. (a -> b) -> Objective a -> Objective b
$c<$ :: forall a b. a -> Objective b -> Objective a
<$ :: forall a b. a -> Objective b -> Objective a
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 -> Maybe SomeException -> IO ()
queryTerminate           :: Maybe C.SomeException -> 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 = m' State -> t m' State
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' State
forall (m :: * -> *). MonadQuery m => m State
queryState

instance MonadQuery m             => MonadQuery (ExceptT e m)
instance MonadQuery m             => MonadQuery (MaybeT m)
instance MonadQuery m             => MonadQuery (ReaderT r m)
instance MonadQuery m             => MonadQuery (SS.StateT s m)
instance MonadQuery m             => MonadQuery (LS.StateT s m)
instance (MonadQuery m, Monoid w) => MonadQuery (SW.WriterT w m)
instance (MonadQuery m, Monoid w) => MonadQuery (LW.WriterT w m)

-- | 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 newtype (Functor (QueryT m)
Functor (QueryT m) =>
(forall a. a -> QueryT m a)
-> (forall a b. QueryT m (a -> b) -> QueryT m a -> QueryT m b)
-> (forall a b c.
    (a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c)
-> (forall a b. QueryT m a -> QueryT m b -> QueryT m b)
-> (forall a b. QueryT m a -> QueryT m b -> QueryT m a)
-> Applicative (QueryT m)
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
$cpure :: forall (m :: * -> *) a. Applicative m => a -> QueryT m a
pure :: forall a. a -> QueryT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
QueryT m (a -> b) -> QueryT m a -> QueryT m b
<*> :: forall a b. QueryT m (a -> b) -> QueryT m a -> QueryT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
liftA2 :: forall a b c.
(a -> b -> c) -> QueryT m a -> QueryT m b -> QueryT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
QueryT m a -> QueryT m b -> QueryT m b
*> :: 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 a
<* :: forall a b. QueryT m a -> QueryT m b -> QueryT m a
Applicative, (forall a b. (a -> b) -> QueryT m a -> QueryT m b)
-> (forall a b. a -> QueryT m b -> QueryT m a)
-> Functor (QueryT m)
forall a b. a -> QueryT m b -> QueryT m a
forall a b. (a -> b) -> QueryT m a -> QueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> QueryT m b -> QueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT m a -> QueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT m a -> QueryT m b
fmap :: forall a b. (a -> b) -> QueryT m a -> QueryT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> QueryT m b -> QueryT m a
<$ :: forall a b. a -> QueryT m b -> QueryT m a
Functor, Applicative (QueryT m)
Applicative (QueryT m) =>
(forall a b. QueryT m a -> (a -> QueryT m b) -> QueryT m b)
-> (forall a b. QueryT m a -> QueryT m b -> QueryT m b)
-> (forall a. a -> QueryT m a)
-> Monad (QueryT m)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
QueryT m a -> (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 -> QueryT m b -> QueryT m b
>> :: forall a b. QueryT m a -> QueryT m b -> QueryT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> QueryT m a
return :: forall a. a -> QueryT m a
Monad, Monad (QueryT m)
Monad (QueryT m) =>
(forall a. IO a -> QueryT m a) -> MonadIO (QueryT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> QueryT m a
liftIO :: forall a. IO a -> QueryT m a
MonadIO, (forall (m :: * -> *). Monad m => Monad (QueryT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> QueryT m a)
-> MonadTrans QueryT
forall (m :: * -> *). Monad m => Monad (QueryT m)
forall (m :: * -> *) a. Monad m => m a -> QueryT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> QueryT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> QueryT m a
MonadTrans,
              MonadError e, MonadState s, MonadWriter w)

instance Monad m => MonadQuery (QueryT m) where
  queryState :: QueryT m State
queryState = ReaderT State m State -> QueryT m State
forall (m :: * -> *) a. ReaderT State m a -> QueryT m a
QueryT ReaderT State m State
forall r (m :: * -> *). MonadReader r m => m r
ask

mapQueryT :: (ReaderT State m a -> ReaderT State n b) -> QueryT m a -> QueryT n b
mapQueryT :: 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 = ReaderT State n b -> QueryT n b
forall (m :: * -> *) a. ReaderT State m a -> QueryT m a
QueryT (ReaderT State n b -> QueryT n b)
-> (QueryT m a -> ReaderT State n b) -> QueryT m a -> QueryT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT State m a -> ReaderT State n b
f (ReaderT State m a -> ReaderT State n b)
-> (QueryT m a -> ReaderT State m a)
-> QueryT m a
-> ReaderT State n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryT m a -> ReaderT State m a
forall (m :: * -> *) a. QueryT m a -> ReaderT State m a
runQueryT
{-# INLINE mapQueryT #-}

-- 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 = m r -> QueryT m r
forall (m :: * -> *) a. Monad m => m a -> QueryT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> QueryT m a -> QueryT m a
local r -> r
f = (ReaderT State m a -> ReaderT State m a)
-> QueryT m a -> QueryT m a
forall (m :: * -> *) a (n :: * -> *) b.
(ReaderT State m a -> ReaderT State n b)
-> QueryT m a -> QueryT n b
mapQueryT ((ReaderT State m a -> ReaderT State m a)
 -> QueryT m a -> QueryT m a)
-> (ReaderT State m a -> ReaderT State m a)
-> QueryT m a
-> QueryT m a
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m a -> m a) -> ReaderT State m a -> ReaderT State m a)
-> (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
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 = Query State
forall (m :: * -> *). MonadQuery m => m State
queryState

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

instance NFData Penalty where
   rnf :: Penalty -> ()
rnf Penalty
DefaultPenalty  = ()
   rnf (Penalty Rational
p Maybe [Char]
mbs) = Rational -> ()
forall a. NFData a => a -> ()
rnf Rational
p () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe [Char] -> ()
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)   = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a
   rnf (Maximize          [Char]
s a
a)   = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a
   rnf (AssertWithPenalty [Char]
s a
a Penalty
p) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` Penalty -> ()
forall a. NFData a => a -> ()
rnf Penalty
p

-- | A result can either produce something at the top or as a lambda/constraint. Distinguish by inputs
data ResultInp = ResultTopInps ([NamedSymVar], [NamedSymVar])  -- user inputs -- trackers
               | ResultLamInps [(Quantifier, NamedSymVar)]     -- for constraints, we can have quantifiers
               deriving Typeable ResultInp
Typeable ResultInp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ResultInp -> c ResultInp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ResultInp)
-> (ResultInp -> Constr)
-> (ResultInp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ResultInp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResultInp))
-> ((forall b. Data b => b -> b) -> ResultInp -> ResultInp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ResultInp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ResultInp -> r)
-> (forall u. (forall d. Data d => d -> u) -> ResultInp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ResultInp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ResultInp -> m ResultInp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResultInp -> m ResultInp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResultInp -> m ResultInp)
-> Data ResultInp
ResultInp -> Constr
ResultInp -> DataType
(forall b. Data b => b -> b) -> ResultInp -> ResultInp
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) -> ResultInp -> u
forall u. (forall d. Data d => d -> u) -> ResultInp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResultInp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResultInp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResultInp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResultInp -> c ResultInp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResultInp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResultInp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResultInp -> c ResultInp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResultInp -> c ResultInp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResultInp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResultInp
$ctoConstr :: ResultInp -> Constr
toConstr :: ResultInp -> Constr
$cdataTypeOf :: ResultInp -> DataType
dataTypeOf :: ResultInp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResultInp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResultInp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResultInp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResultInp)
$cgmapT :: (forall b. Data b => b -> b) -> ResultInp -> ResultInp
gmapT :: (forall b. Data b => b -> b) -> ResultInp -> ResultInp
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResultInp -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResultInp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResultInp -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResultInp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ResultInp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ResultInp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ResultInp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ResultInp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResultInp -> m ResultInp
G.Data

instance NFData ResultInp where
   rnf :: ResultInp -> ()
rnf (ResultTopInps ([NamedSymVar], [NamedSymVar])
xs) = ([NamedSymVar], [NamedSymVar]) -> ()
forall a. NFData a => a -> ()
rnf ([NamedSymVar], [NamedSymVar])
xs
   rnf (ResultLamInps [(Quantifier, NamedSymVar)]
xs) = [(Quantifier, NamedSymVar)] -> ()
forall a. NFData a => a -> ()
rnf [(Quantifier, NamedSymVar)]
xs

-- | Several data about the program
data ProgInfo = ProgInfo { ProgInfo -> Bool
hasQuants         :: Bool
                         , ProgInfo -> [SpecialRelOp]
progSpecialRels   :: [SpecialRelOp]
                         , ProgInfo -> [([Char], [Char])]
progTransClosures :: [(String, String)]
                         , ProgInfo -> [Op]
progSpecialFuncs  :: [Op]                -- functions that need to be generated, like list reverse/all/any/filter
                         }
                         deriving Typeable ProgInfo
Typeable ProgInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ProgInfo -> c ProgInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ProgInfo)
-> (ProgInfo -> Constr)
-> (ProgInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ProgInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProgInfo))
-> ((forall b. Data b => b -> b) -> ProgInfo -> ProgInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ProgInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ProgInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> ProgInfo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ProgInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo)
-> Data ProgInfo
ProgInfo -> Constr
ProgInfo -> DataType
(forall b. Data b => b -> b) -> ProgInfo -> ProgInfo
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) -> ProgInfo -> u
forall u. (forall d. Data d => d -> u) -> ProgInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProgInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProgInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProgInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProgInfo -> c ProgInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProgInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProgInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProgInfo -> c ProgInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProgInfo -> c ProgInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProgInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProgInfo
$ctoConstr :: ProgInfo -> Constr
toConstr :: ProgInfo -> Constr
$cdataTypeOf :: ProgInfo -> DataType
dataTypeOf :: ProgInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProgInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProgInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProgInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProgInfo)
$cgmapT :: (forall b. Data b => b -> b) -> ProgInfo -> ProgInfo
gmapT :: (forall b. Data b => b -> b) -> ProgInfo -> ProgInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProgInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProgInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProgInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProgInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ProgInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ProgInfo -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProgInfo -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProgInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProgInfo -> m ProgInfo
G.Data

instance NFData ProgInfo where
   rnf :: ProgInfo -> ()
rnf (ProgInfo Bool
a [SpecialRelOp]
b [([Char], [Char])]
c [Op]
d) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
a () -> () -> ()
forall a b. a -> b -> b
`seq` [SpecialRelOp] -> ()
forall a. NFData a => a -> ()
rnf [SpecialRelOp]
b () -> () -> ()
forall a b. a -> b -> b
`seq` [([Char], [Char])] -> ()
forall a. NFData a => a -> ()
rnf [([Char], [Char])]
c () -> () -> ()
forall a b. a -> b -> b
`seq` [Op] -> ()
forall a. NFData a => a -> ()
rnf [Op]
d

deriving instance G.Data CallStack
deriving instance G.Data SrcLoc

-- | Result of running a symbolic computation
data Result = Result { Result -> ProgInfo
progInfo       :: ProgInfo                                     -- ^ various info we collect about the program
                     , 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 -> ResultInp
resParams      :: ResultInp                                    -- ^ top-inputs or lambda params
                     , 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 -> [([Char], (Bool, Maybe [[Char]], SBVType))]
resUIConsts    :: [(String, (Bool, Maybe [String], SBVType))]  -- ^ uninterpreted constants
                     , Result -> [(SMTDef, SBVType)]
resDefinitions :: [(SMTDef, SBVType)]                          -- ^ definitions created via smtFunction or lambda
                     , 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
                     }
                     deriving Typeable Result
Typeable Result =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Result -> c Result)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Result)
-> (Result -> Constr)
-> (Result -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Result))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result))
-> ((forall b. Data b => b -> b) -> Result -> Result)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Result -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Result -> r)
-> (forall u. (forall d. Data d => d -> u) -> Result -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Result -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Result -> m Result)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Result -> m Result)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Result -> m Result)
-> Data Result
Result -> Constr
Result -> DataType
(forall b. Data b => b -> b) -> Result -> Result
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) -> Result -> u
forall u. (forall d. Data d => d -> u) -> Result -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result -> m Result
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Result)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
$ctoConstr :: Result -> Constr
toConstr :: Result -> Constr
$cdataTypeOf :: Result -> DataType
dataTypeOf :: Result -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Result)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Result)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result)
$cgmapT :: (forall b. Data b => b -> b) -> Result -> Result
gmapT :: (forall b. Data b => b -> b) -> Result -> Result
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Result -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Result -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Result -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Result -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result -> m Result
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result -> m Result
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
G.Data

-- 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 SV -> [(SV, CV)] -> Maybe CV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs
    = CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
  show (Result ProgInfo
_ Set Kind
kinds [([Char], CV)]
_ [([Char], CV -> Bool, SV)]
_ [([Char], [[Char]])]
cgs ResultInp
params (CnstMap
_, [(SV, CV)]
cs) [((Int, Kind, Kind), [SV])]
ts [([Char], (Bool, Maybe [[Char]], SBVType))]
uis [(SMTDef, SBVType)]
defns SBVPgm
xs Seq (Bool, [([Char], [Char])], SV)
cstrs [([Char], Maybe CallStack, SV)]
asserts [SV]
os) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
                   (if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
usorts then [] else [Char]
"SORTS" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) [[Char]]
usorts)
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (case ResultInp
params of
                      ResultTopInps ([NamedSymVar]
i, [NamedSymVar]
t) -> [Char]
"INPUTS" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (NamedSymVar -> [Char]) -> [NamedSymVar] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map NamedSymVar -> [Char]
shn [NamedSymVar]
i [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (if [NamedSymVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NamedSymVar]
t then [] else [Char]
"TRACKER VARS" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (NamedSymVar -> [Char]) -> [NamedSymVar] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map NamedSymVar -> [Char]
shn [NamedSymVar]
t)
                      ResultLamInps [(Quantifier, NamedSymVar)]
qs     -> [Char]
"LAMBDA-CONSTRAINT PARAMS" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ((Quantifier, NamedSymVar) -> [Char])
-> [(Quantifier, NamedSymVar)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Quantifier, NamedSymVar) -> [Char]
shq [(Quantifier, NamedSymVar)]
qs
                   )
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"CONSTANTS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ((SV, CV) -> [[Char]]) -> [(SV, CV)] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SV, CV) -> [[Char]]
forall {a}. Show a => (SV, a) -> [[Char]]
shc [(SV, CV)]
cs
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"TABLES"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (((Int, Kind, Kind), [SV]) -> [Char])
-> [((Int, Kind, Kind), [SV])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Kind, Kind), [SV]) -> [Char]
forall {a} {a} {a} {a}.
(Show a, Show a, Show a, Show a) =>
((a, a, a), a) -> [Char]
sht [((Int, Kind, Kind), [SV])]
ts
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"UNINTERPRETED CONSTANTS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (([Char], (Bool, Maybe [[Char]], SBVType)) -> [Char])
-> [([Char], (Bool, Maybe [[Char]], SBVType))] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], (Bool, Maybe [[Char]], SBVType)) -> [Char]
forall {a}. Show a => ([Char], a) -> [Char]
shui [([Char], (Bool, Maybe [[Char]], SBVType))]
uis
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"USER GIVEN CODE SEGMENTS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (([Char], [[Char]]) -> [[Char]])
-> [([Char], [[Char]])] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [[Char]]) -> [[Char]]
shcg [([Char], [[Char]])]
cgs
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"AXIOMS-DEFINITIONS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ((SMTDef, SBVType) -> [Char]) -> [(SMTDef, SBVType)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (SMTDef, SBVType) -> [Char]
forall a. Show a => a -> [Char]
show [(SMTDef, SBVType)]
defns
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"DEFINE"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ((SV, SBVExpr) -> [Char]) -> [(SV, SBVExpr)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(SV
s, SBVExpr
e) -> [Char]
"  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> [Char]
shs SV
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVExpr -> [Char]
forall a. Show a => a -> [Char]
show SBVExpr
e) (Seq (SV, SBVExpr) -> [(SV, SBVExpr)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (SBVPgm -> Seq (SV, SBVExpr)
pgmAssignments SBVPgm
xs))
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"CONSTRAINTS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ((Bool, [([Char], [Char])], SV) -> [Char])
-> [(Bool, [([Char], [Char])], SV)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> ((Bool, [([Char], [Char])], SV) -> [Char])
-> (Bool, [([Char], [Char])], SV)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, [([Char], [Char])], SV) -> [Char]
forall {a} {a}.
(Eq a, IsString a, Show a, Show a) =>
(Bool, [(a, [Char])], a) -> [Char]
shCstr) (Seq (Bool, [([Char], [Char])], SV)
-> [(Bool, [([Char], [Char])], SV)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Bool, [([Char], [Char])], SV)
cstrs)
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"ASSERTIONS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (([Char], Maybe CallStack, SV) -> [Char])
-> [([Char], Maybe CallStack, SV)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"  "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (([Char], Maybe CallStack, SV) -> [Char])
-> ([Char], Maybe CallStack, SV)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Maybe CallStack, SV) -> [Char]
forall {a}. Show a => ([Char], Maybe CallStack, a) -> [Char]
shAssert) [([Char], Maybe CallStack, SV)]
asserts
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"OUTPUTS"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [SV] -> [[Char]]
forall a. Show a => [a] -> [[Char]]
sh2 [SV]
os
    where sh2 :: Show a => [a] -> [String]
          sh2 :: forall a. Show a => [a] -> [[Char]]
sh2 = (a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"  "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
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 <- Set Kind -> [Kind]
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 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
es [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

          shs :: SV -> [Char]
shs SV
sv = SV -> [Char]
forall a. Show a => a -> [Char]
show SV
sv [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" :: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
at [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"->" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
rt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
es

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

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

          shn :: NamedSymVar -> [Char]
shn (NamedSymVar SV
sv Name
nm) = [Char]
"  " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
ni [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" :: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (SV -> Kind
swKind SV
sv) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
alias
            where ni :: [Char]
ni = SV -> [Char]
forall a. Show a => a -> [Char]
show SV
sv

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

          shq :: (Quantifier, NamedSymVar) -> [Char]
shq (Quantifier
q, NamedSymVar
v) = NamedSymVar -> [Char]
shn NamedSymVar
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Quantifier
q Quantifier -> Quantifier -> Bool
forall a. Eq a => a -> a -> Bool
== Quantifier
ALL then [Char]
"universal" else [Char]
"existential"

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

          shCstr :: (Bool, [(a, [Char])], a) -> [Char]
shCstr (Bool
isSoft, [], a
c)               = Bool -> [Char]
forall {a}. IsString a => Bool -> a
soft Bool
isSoft [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
c
          shCstr (Bool
isSoft, [(a
":named", [Char]
nm)], a
c) = Bool -> [Char]
forall {a}. IsString a => Bool -> a
soft Bool
isSoft [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
c
          shCstr (Bool
isSoft, [(a, [Char])]
attrs, a
c)            = Bool -> [Char]
forall {a}. IsString a => Bool -> a
soft Bool
isSoft [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
c [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (attributes: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [(a, [Char])] -> [Char]
forall a. Show a => a -> [Char]
show [(a, [Char])]
attrs [Char] -> ShowS
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: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> (CallStack -> [Char]) -> Maybe CallStack -> [Char]
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 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
p

-- | 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

-- | Uninterpreted-constants generated during a symbolic run
type UIMap = Map.Map String (Bool, Maybe [String], SBVType)   -- If Bool is true, then this is a curried function

-- | 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.
                | LambdaGen (Maybe Int)                        -- ^ Inside a lambda-expression at level. If Nothing, then closed lambda.
                | Concrete (Maybe (Bool, [(NamedSymVar, 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 (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> [Char]
forall a. Show a => a -> [Char]
show QueryContext
qc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
ISafe  Bool
True  SMTConfig
_)  = [Char]
"Safety setup (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> [Char]
forall a. Show a => a -> [Char]
show QueryContext
qc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
IRun   Bool
True  SMTConfig
_)  = [Char]
"Satisfiability (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> [Char]
forall a. Show a => a -> [Char]
show QueryContext
qc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
ISetup Bool
False SMTConfig
_)  = [Char]
"Proof setup (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> [Char]
forall a. Show a => a -> [Char]
show QueryContext
qc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
ISafe  Bool
False SMTConfig
_)  = ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"ISafe-False is not an expected/supported combination for SBVRunMode! (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> [Char]
forall a. Show a => a -> [Char]
show QueryContext
qc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SMTMode QueryContext
qc IStage
IRun   Bool
False SMTConfig
_)  = [Char]
"Proof (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ QueryContext -> [Char]
forall a. Show a => a -> [Char]
show QueryContext
qc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show SBVRunMode
CodeGen                      = [Char]
"Code generation"
   show LambdaGen{}                  = [Char]
"Lambda generation"
   show (Concrete Maybe (Bool, [(NamedSymVar, CV)])
Nothing)           = [Char]
"Concrete evaluation with random values"
   show (Concrete (Just (Bool
True, [(NamedSymVar, CV)]
_)))  = [Char]
"Concrete evaluation during model validation for sat"
   show (Concrete (Just (Bool
False, [(NamedSymVar, 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 :: IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode} = do rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
                                  return $ case rm of
                                             Concrete{}  -> Bool
False
                                             SMTMode{}   -> Bool
False
                                             LambdaGen{} -> 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 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
        is    <- [NamedSymVar] -> IO (IORef [NamedSymVar])
forall a. a -> IO (IORef a)
newIORef []
        ks    <- newIORef Set.empty
        nc    <- newIORef Map.empty
        tm    <- newIORef Map.empty
        ui    <- newIORef Map.empty
        pgm   <- newIORef (SBVPgm S.empty)
        cstrs <- newIORef S.empty
        return IncState { rNewInps        = is
                        , rNewKinds       = ks
                        , rNewConsts      = nc
                        , rNewTbls        = tm
                        , rNewUIs         = ui
                        , rNewAsgns       = pgm
                        , rNewConstraints = 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
        is <- IO IncState
newIncState
        R.modifyIORef' (rIncState st) (const is)
        r  <- cont st
        finalIncState <- readIORef (rIncState st)
        return (finalIncState, r)

-- | User defined inputs
type UserInputs = S.Seq NamedSymVar

-- | Internally declared
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 -> UserInputs
internInputs :: !InternInps
                     , Inputs -> Set Name
allInputs    :: !AllInps
                     } deriving (Inputs -> Inputs -> Bool
(Inputs -> Inputs -> Bool)
-> (Inputs -> Inputs -> Bool) -> Eq Inputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inputs -> Inputs -> Bool
== :: Inputs -> Inputs -> Bool
$c/= :: Inputs -> Inputs -> Bool
/= :: Inputs -> Inputs -> Bool
Eq,Int -> Inputs -> ShowS
[Inputs] -> ShowS
Inputs -> [Char]
(Int -> Inputs -> ShowS)
-> (Inputs -> [Char]) -> ([Inputs] -> ShowS) -> Show Inputs
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inputs -> ShowS
showsPrec :: Int -> Inputs -> ShowS
$cshow :: Inputs -> [Char]
show :: Inputs -> [Char]
$cshowList :: [Inputs] -> ShowS
showList :: [Inputs] -> ShowS
Show)

-- | Inputs to a lambda-abstraction. These are quantified to handle constraints
type LambdaInputs = S.Seq (Quantifier, NamedSymVar)

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

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

-- | 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 :: Inputs -> UserInputs
userInputs :: UserInputs
userInputs} = Inputs
inp{userInputs = f userInputs}

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

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

-- | Add a new internal input
addInternInput :: SV -> Name -> Inputs -> Inputs
addInternInput :: SV -> Name -> Inputs -> Inputs
addInternInput SV
sv Name
nm = Inputs -> Inputs
goAll (Inputs -> Inputs) -> (Inputs -> Inputs) -> Inputs -> Inputs
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 = (UserInputs -> UserInputs) -> Inputs -> Inputs
onInternInputs (UserInputs -> NamedSymVar -> UserInputs
forall a. Seq a -> a -> Seq a
S.|> NamedSymVar
new)
        goAll :: Inputs -> Inputs
goAll    = (Set Name -> Set Name) -> Inputs -> Inputs
onAllInputs    (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
nm)

-- | Add a new user input
addUserInput :: SV -> Name -> Inputs -> Inputs
addUserInput :: SV -> Name -> Inputs -> Inputs
addUserInput SV
sv Name
nm = Inputs -> Inputs
goAll (Inputs -> Inputs) -> (Inputs -> Inputs) -> Inputs -> Inputs
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 (UserInputs -> NamedSymVar -> UserInputs
forall a. Seq a -> a -> Seq a
S.|> NamedSymVar
new)        -- add to the end of the sequence
        goAll :: Inputs -> Inputs
goAll  = (Set Name -> Set Name) -> Inputs -> Inputs
onAllInputs  (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
nm)

-- | Find a user-input from its SV. Note that only level-0 vars
-- can be found this way.
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 Int
l Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 = Maybe a
res
   | Bool
True        = Maybe a
forall a. Maybe a
Nothing  -- l != Just 0, a lambda var, whether top-level or in a scope, so we ignore
  where
    (SBVContext
_, Maybe Int
l, Int
i) = NodeId -> (SBVContext, Maybe Int, Int)
getId (SV -> NodeId
swNodeId SV
sv)
    svs :: Seq SV
svs       = (a -> SV) -> Seq a -> Seq SV
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> SV
f Seq a
ns
    res :: Maybe a
res       = case Int -> Seq a -> Maybe a
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 SV -> SV -> Bool
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 = SV -> Seq SV -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
S.elemIndexL SV
sv Seq SV
svs Maybe Int -> (Int -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Seq a -> Maybe a) -> Seq a -> Int -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
S.lookup Seq a
ns

-- | A defined function/value
data SMTDef = SMTDef String           -- ^ Defined functions -- name
                     Kind             -- ^ Final kind of the definition (resulting kind, not the params)
                     [String]         -- ^ other definitions it refers to
                     (Maybe String)   -- ^ parameter string
                     (Int -> String)  -- ^ Body, in SMTLib syntax, given the tab amount
            | SMTLam Kind             -- ^ Final kind of the definition (resulting kind, not the params)
                     [String]         -- ^ Anonymous function -- other definitions it refers to
                     (Maybe String)   -- ^ parameter string
                     (Int -> String)  -- ^ Body, in SMTLib syntax, given the tab amount
            deriving Typeable SMTDef
Typeable SMTDef =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SMTDef -> c SMTDef)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SMTDef)
-> (SMTDef -> Constr)
-> (SMTDef -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SMTDef))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTDef))
-> ((forall b. Data b => b -> b) -> SMTDef -> SMTDef)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SMTDef -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SMTDef -> r)
-> (forall u. (forall d. Data d => d -> u) -> SMTDef -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SMTDef -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SMTDef -> m SMTDef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SMTDef -> m SMTDef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SMTDef -> m SMTDef)
-> Data SMTDef
SMTDef -> Constr
SMTDef -> DataType
(forall b. Data b => b -> b) -> SMTDef -> SMTDef
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) -> SMTDef -> u
forall u. (forall d. Data d => d -> u) -> SMTDef -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SMTDef -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SMTDef -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SMTDef
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SMTDef -> c SMTDef
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SMTDef)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTDef)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SMTDef -> c SMTDef
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SMTDef -> c SMTDef
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SMTDef
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SMTDef
$ctoConstr :: SMTDef -> Constr
toConstr :: SMTDef -> Constr
$cdataTypeOf :: SMTDef -> DataType
dataTypeOf :: SMTDef -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SMTDef)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SMTDef)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTDef)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SMTDef)
$cgmapT :: (forall b. Data b => b -> b) -> SMTDef -> SMTDef
gmapT :: (forall b. Data b => b -> b) -> SMTDef -> SMTDef
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SMTDef -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SMTDef -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SMTDef -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SMTDef -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SMTDef -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SMTDef -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SMTDef -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SMTDef -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SMTDef -> m SMTDef
G.Data

-- | For debug purposes
instance Show SMTDef where
  show :: SMTDef -> [Char]
show SMTDef
d = case SMTDef
d of
             SMTDef [Char]
nm Kind
fk [[Char]]
frees Maybe [Char]
p Int -> [Char]
body -> Maybe [Char]
-> Kind -> [[Char]] -> Maybe [Char] -> (Int -> [Char]) -> [Char]
forall {a} {t}.
(Show a, Num t) =>
Maybe [Char]
-> a -> [[Char]] -> Maybe [Char] -> (t -> [Char]) -> [Char]
shDef ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
nm) Kind
fk [[Char]]
frees Maybe [Char]
p Int -> [Char]
body
             SMTLam    Kind
fk [[Char]]
frees Maybe [Char]
p Int -> [Char]
body -> Maybe [Char]
-> Kind -> [[Char]] -> Maybe [Char] -> (Int -> [Char]) -> [Char]
forall {a} {t}.
(Show a, Num t) =>
Maybe [Char]
-> a -> [[Char]] -> Maybe [Char] -> (t -> [Char]) -> [Char]
shDef Maybe [Char]
forall a. Maybe a
Nothing   Kind
fk [[Char]]
frees Maybe [Char]
p Int -> [Char]
body
    where shDef :: Maybe [Char]
-> a -> [[Char]] -> Maybe [Char] -> (t -> [Char]) -> [Char]
shDef Maybe [Char]
mbNm a
fk [[Char]]
frees Maybe [Char]
p t -> [Char]
body = [[Char]] -> [Char]
unlines [ [Char]
"-- User defined function: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"Anonymous" Maybe [Char]
mbNm
                                               , [Char]
"-- Final return type    : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
fk
                                               , [Char]
"-- Refers to            : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
frees
                                               , [Char]
"-- Parameters           : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"NONE" Maybe [Char]
p
                                               , [Char]
"-- Body                 : "
                                               , t -> [Char]
body t
2
                                               ]

-- The name of this definition
smtDefGivenName :: SMTDef -> Maybe String
smtDefGivenName :: SMTDef -> Maybe [Char]
smtDefGivenName (SMTDef [Char]
n Kind
_ [[Char]]
_ Maybe [Char]
_ Int -> [Char]
_) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
n
smtDefGivenName SMTLam{}           = Maybe [Char]
forall a. Maybe a
Nothing

-- | NFData instance for SMTDef
instance NFData SMTDef where
  rnf :: SMTDef -> ()
rnf (SMTDef [Char]
n Kind
fk [[Char]]
frees Maybe [Char]
params Int -> [Char]
body) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
n () -> () -> ()
forall a b. a -> b -> b
`seq` Kind -> ()
forall a. NFData a => a -> ()
rnf Kind
fk () -> () -> ()
forall a b. a -> b -> b
`seq` [[Char]] -> ()
forall a. NFData a => a -> ()
rnf [[Char]]
frees () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe [Char] -> ()
forall a. NFData a => a -> ()
rnf Maybe [Char]
params () -> () -> ()
forall a b. a -> b -> b
`seq` (Int -> [Char]) -> ()
forall a. NFData a => a -> ()
rnf Int -> [Char]
body
  rnf (SMTLam   Kind
fk [[Char]]
frees Maybe [Char]
params Int -> [Char]
body) =             Kind -> ()
forall a. NFData a => a -> ()
rnf Kind
fk () -> () -> ()
forall a b. a -> b -> b
`seq` [[Char]] -> ()
forall a. NFData a => a -> ()
rnf [[Char]]
frees () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe [Char] -> ()
forall a. NFData a => a -> ()
rnf Maybe [Char]
params () -> () -> ()
forall a b. a -> b -> b
`seq` (Int -> [Char]) -> ()
forall a. NFData a => a -> ()
rnf Int -> [Char]
body

-- | The state of the symbolic interpreter
data State  = State { State -> SBVContext
sbvContext          :: SBVContext
                    , State -> SVal
pathCond            :: SVal                             -- ^ kind KBool
                    , State -> SMTConfig
stCfg               :: SMTConfig
                    , State -> UTCTime
startTime           :: UTCTime
                    , State -> IORef ProgInfo
rProgInfo           :: IORef ProgInfo
                    , 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 (Maybe Int)
rLambdaLevel        :: IORef (Maybe Int)     -- If Nothing, then top-level lambda
                    , State -> IORef (Set Kind)
rUsedKinds          :: IORef KindSet
                    , State -> IORef (Set [Char])
rUsedLbls           :: IORef (Set.Set String)
                    , State -> IORef Inputs
rinps               :: IORef Inputs
                    , State -> IORef LambdaInputs
rlambdaInps         :: IORef LambdaInputs
                    , State -> IORef (Seq (Bool, [([Char], [Char])], SV))
rConstraints        :: IORef (S.Seq (Bool, [(String, String)], SV))
                    , State -> IORef [[Char]]
rPartitionVars      :: IORef [String]
                    , 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 UIMap
rUIMap              :: IORef UIMap
                    , State -> IORef (Set [Char])
rUserFuncs          :: IORef (Set.Set String) -- Functions that the user wanted explicit code generation for
                    , State -> IORef CgMap
rCgMap              :: IORef CgMap
                    , State -> IORef [(SMTDef, SBVType)]
rDefns              :: IORef [(SMTDef, SBVType)]
                    , 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 Bool
rOutstandingAsserts :: IORef Bool            -- Did we send an assert after the last check-sat call?
                    , State -> IORef (Cache SV)
rSVCache            :: IORef (Cache SV)
                    , State -> IORef (Maybe QueryState)
rQueryState         :: IORef (Maybe QueryState)
                    , State -> Maybe State
parentState         :: Maybe State  -- Pointer to our parent if we're in a sublevel
                    }

-- | Chase to the root state. No infinite chains!
getRootState :: State -> State
getRootState :: State -> State
getRootState State
st = State -> (State -> State) -> Maybe State -> State
forall b a. b -> (a -> b) -> Maybe a -> b
maybe State
st State -> State
getRootState (State -> Maybe State
parentState State
st)

-- 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 = f (pathCond st)}

-- | Are we running in proof mode?
inSMTMode :: State -> IO Bool
inSMTMode :: State -> IO Bool
inSMTMode State{IORef SBVRunMode
runMode :: State -> IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode} = do rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
                              return $ case rm of
                                         SBVRunMode
CodeGen     -> Bool
False
                                         LambdaGen{} -> 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 t'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 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" :: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
  show (SVal Kind
k     (Right Cached SV
_)) =         [Char]
"<symbolic> :: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
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.SBV' or t'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 = [Char] -> [Char] -> ([Char], [Char]) -> Bool
forall a. [Char] -> [Char] -> ([Char], [Char]) -> a
noEquals [Char]
"==" [Char]
".==" (SVal -> [Char]
forall a. Show a => a -> [Char]
show SVal
a, SVal -> [Char]
forall a. Show a => a -> [Char]
show SVal
b)
  SVal
a /= :: SVal -> SVal -> Bool
/= SVal
b = [Char] -> [Char] -> ([Char], [Char]) -> Bool
forall a. [Char] -> [Char] -> ([Char], [Char]) -> a
noEquals [Char]
"/=" [Char]
"./=" (SVal -> [Char]
forall a. Show a => a -> [Char]
show SVal
a, SVal -> [Char]
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) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
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:    " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
o [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
r
                                      , [Char]
"*** Instead use: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" "  [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$  [Char]
""
                                   [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:  [Char]
"*** Data.SBV: Unsupported interactive/query mode feature."
                                   [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:  ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"***  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) [[Char]]
ss
                                   [[Char]] -> [[Char]] -> [[Char]]
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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$  [Char]
""
                                       [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:  [Char]
"*** Data.SBV: Unsupported interactive/query mode feature."
                                       [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:  ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"***  " [Char] -> ShowS
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 :: State -> IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode} State -> IORef a
field a -> a
update IO ()
interactiveUpdate = do
        IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
R.modifyIORef' (State -> IORef a
field State
st) a -> a
update
        rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef IORef SBVRunMode
runMode
        case rm of
          SMTMode QueryContext
_ IStage
IRun Bool
_ SMTConfig
_ -> IO ()
interactiveUpdate
          SBVRunMode
_                  -> () -> IO ()
forall a. a -> IO a
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 :: State -> IORef IncState
rIncState :: IORef IncState
rIncState} IncState -> IORef a
field a -> a
update = do
        incState <- IORef IncState -> IO IncState
forall a. IORef a -> IO a
readIORef IORef IncState
rIncState
        R.modifyIORef' (field incState) 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 = State
-> (State -> IORef (Seq (Name, CV -> Bool, SV)))
-> (Seq (Name, CV -> Bool, SV) -> Seq (Name, CV -> Bool, SV))
-> IO ()
-> IO ()
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) (Name, CV -> Bool, SV)
-> Seq (Name, CV -> Bool, SV) -> Seq (Name, CV -> Bool, SV)
forall a. a -> Seq a -> Seq a
S.<|) (() -> IO ()
forall a. a -> IO a
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 ctr <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (State -> IORef Int
rctr State
st)
                                 modifyState st rctr (+1) (return ())
                                 return ctr
{-# INLINE incrementInternalCounter #-}

-- | Kind of code we have for uninterpretation
data UICodeKind = UINone Bool     -- no code. If bool is true, then curried.
                | UISMT  SMTDef   -- SMTLib, first argument are the free-variables in it
                | UICgC  [String] -- Code-gen, currently only C

-- | Is the name given by the user for the uninterpreted constant a prefix or a full name?
data UIName = UIGiven  String  -- ^ Full name
            | UIPrefix String  -- ^ Prefix

-- | 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 -> UIName -> UICodeKind -> [SVal] -> SVal
svUninterpreted :: Kind -> UIName -> UICodeKind -> [SVal] -> SVal
svUninterpreted Kind
k UIName
nm UICodeKind
code [SVal]
args = Kind -> UIName -> UICodeKind -> [SVal] -> Maybe [[Char]] -> SVal
svUninterpretedGen Kind
k UIName
nm UICodeKind
code [SVal]
args Maybe [[Char]]
forall a. Maybe a
Nothing

svUninterpretedNamedArgs :: Kind -> UIName -> UICodeKind -> [(SVal, String)] -> SVal
svUninterpretedNamedArgs :: Kind -> UIName -> UICodeKind -> [(SVal, [Char])] -> SVal
svUninterpretedNamedArgs Kind
k UIName
nm UICodeKind
code [(SVal, [Char])]
args = Kind -> UIName -> UICodeKind -> [SVal] -> Maybe [[Char]] -> SVal
svUninterpretedGen Kind
k UIName
nm UICodeKind
code (((SVal, [Char]) -> SVal) -> [(SVal, [Char])] -> [SVal]
forall a b. (a -> b) -> [a] -> [b]
map (SVal, [Char]) -> SVal
forall a b. (a, b) -> a
fst [(SVal, [Char])]
args) ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just (((SVal, [Char]) -> [Char]) -> [(SVal, [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (SVal, [Char]) -> [Char]
forall a b. (a, b) -> b
snd [(SVal, [Char])]
args))

svUninterpretedGen :: Kind -> UIName -> UICodeKind -> [SVal] -> Maybe [String] -> SVal
svUninterpretedGen :: Kind -> UIName -> UICodeKind -> [SVal] -> Maybe [[Char]] -> SVal
svUninterpretedGen Kind
k UIName
nm UICodeKind
code [SVal]
args Maybe [[Char]]
mbArgNames = Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
  where result :: State -> IO SV
result State
st = do let ty :: SBVType
ty = [Kind] -> SBVType
SBVType ((SVal -> Kind) -> [SVal] -> [Kind]
forall a b. (a -> b) -> [a] -> [b]
map SVal -> Kind
forall a. HasKind a => a -> Kind
kindOf [SVal]
args [Kind] -> [Kind] -> [Kind]
forall a. [a] -> [a] -> [a]
++ [Kind
k])
                       nm' <- State
-> UIName -> Maybe [[Char]] -> SBVType -> UICodeKind -> IO [Char]
newUninterpreted State
st UIName
nm Maybe [[Char]]
mbArgNames SBVType
ty UICodeKind
code
                       sws <- mapM (svToSV st) args
                       mapM_ forceSVArg sws
                       newExpr st k $ SBVApp (Uninterpreted nm') sws

-- | Create a new uninterpreted symbol, possibly with user given code. This function might change
-- the name given, putting bars around it if needed. That's the name returned.
newUninterpreted :: State -> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted :: State
-> UIName -> Maybe [[Char]] -> SBVType -> UICodeKind -> IO [Char]
newUninterpreted State
st UIName
uiName Maybe [[Char]]
mbArgNames SBVType
t UICodeKind
uiCode = do

  uiMap <- IORef UIMap -> IO UIMap
forall a. IORef a -> IO a
readIORef (State -> IORef UIMap
rUIMap State
st)

  let candName = case UIName
uiName of
                   UIGiven  [Char]
n   -> [Char]
n
                   UIPrefix [Char]
pre -> let suffix :: Int -> [Char]
suffix Int
0 = [Char]
pre
                                       suffix Int
i = [Char]
pre [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
                                   in case [[Char]
cand | Int
i <- [Int
0::Int ..], let cand :: [Char]
cand = Int -> [Char]
suffix Int
i, [Char]
cand [Char] -> UIMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` UIMap
uiMap] of
                                        ([Char]
n:[[Char]]
_) -> [Char]
n
                                        []    -> ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"newUninterpreted: Can't generate a unique name for prefix: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pre   -- can't happen

      -- determine the final name
      nm = case () of
             () | [Char]
"__internal_sbv_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
candName -> [Char]
candName                -- internal names go thru
             () | [Char] -> Bool
needsBars [Char]
candName                      -> Char
'|' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
candName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"|"   -- surround with bars if not legitimate in SMTLib
             ()                                           -> [Char]
candName

      extraComment = case UIName
uiName of
                      UIGiven  [Char]
n | [Char]
nm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
n                 -> [Char]
" (Given: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
                      UIPrefix [Char]
n | Bool -> Bool
not ([Char]
nm [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
n) -> [Char]
" (Given prefix: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
                      UIName
_                                    -> [Char]
""

  -- Check if reserved:
  when (isReserved nm) $
      error $ unlines [ ""
                      , "*** Data.SBV: User given name " ++ show nm ++ " is a reserved name in SMTLib."
                      , "***"
                      , "*** Please use a different name to avoid collisions."
                      ]

  isCurried <- case uiCode of
                 UINone Bool
c -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c
                 UISMT SMTDef
d  -> do State
-> (State -> IORef [(SMTDef, SBVType)])
-> ([(SMTDef, SBVType)] -> [(SMTDef, SBVType)])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [(SMTDef, SBVType)]
rDefns (\[(SMTDef, SBVType)]
defs -> (SMTDef
d, SBVType
t) (SMTDef, SBVType) -> [(SMTDef, SBVType)] -> [(SMTDef, SBVType)]
forall a. a -> [a] -> [a]
: ((SMTDef, SBVType) -> Bool)
-> [(SMTDef, SBVType)] -> [(SMTDef, SBVType)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(SMTDef
o, SBVType
_) -> SMTDef -> Maybe [Char]
smtDefGivenName SMTDef
o Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
nm) [(SMTDef, SBVType)]
defs)
                                  (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> IO ()
forall a. [[Char]] -> a
noInteractive [ [Char]
"Defined functions (smtFunction):"
                                                  , [Char]
"  Name: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
extraComment
                                                  , [Char]
"  Type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVType -> [Char]
forall a. Show a => a -> [Char]
show SBVType
t
                                                  , [Char]
""
                                                  , [Char]
"You should explicitly register these functions by calling"
                                                  , [Char]
"the function 'registerFunction' on them before starting the query section."
                                                  ]
                                Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                 UICgC [[Char]]
c  -> -- No need to record the code in interactive mode: CodeGen doesn't use interactive
                             do State
-> (State -> IORef CgMap) -> (CgMap -> CgMap) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef CgMap
rCgMap ([Char] -> [[Char]] -> CgMap -> CgMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
nm [[Char]]
c) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

  let checkType :: SBVType -> r -> r
      checkType SBVType
t' r
cont
        | SBVType
t SBVType -> SBVType -> Bool
forall a. Eq a => a -> a -> Bool
/= SBVType
t' = [Char] -> r
forall a. HasCallStack => [Char] -> a
error ([Char] -> r) -> [Char] -> r
forall a b. (a -> b) -> a -> b
$  [Char]
"Uninterpreted constant " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
nm [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
extraComment [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" used at incompatible types\n"
                          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"      Current type      : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVType -> [Char]
forall a. Show a => a -> [Char]
show SBVType
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
                          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"      Previously used at: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVType -> [Char]
forall a. Show a => a -> [Char]
show SBVType
t'
        | Bool
True    = r
cont

  case nm `Map.lookup` uiMap of
    Just (Bool
_, Maybe [[Char]]
_, SBVType
t') -> SBVType -> IO () -> IO ()
forall r. SBVType -> r -> r
checkType SBVType
t' (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Maybe (Bool, Maybe [[Char]], SBVType)
Nothing         -> State
-> (State -> IORef UIMap) -> (UIMap -> UIMap) -> IO () -> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef UIMap
rUIMap ([Char] -> (Bool, Maybe [[Char]], SBVType) -> UIMap -> UIMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
nm (Bool
isCurried, Maybe [[Char]]
mbArgNames, SBVType
t))
                         (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> (IncState -> IORef UIMap) -> (UIMap -> UIMap) -> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef UIMap
rNewUIs
                                            (\UIMap
newUIs -> case [Char]
nm [Char] -> UIMap -> Maybe (Bool, Maybe [[Char]], SBVType)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` UIMap
newUIs of
                                                          Just (Bool
_, Maybe [[Char]]
_, SBVType
t') -> SBVType -> UIMap -> UIMap
forall r. SBVType -> r -> r
checkType SBVType
t' UIMap
newUIs
                                                          Maybe (Bool, Maybe [[Char]], SBVType)
Nothing         -> [Char] -> (Bool, Maybe [[Char]], SBVType) -> UIMap -> UIMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
nm (Bool
isCurried, Maybe [[Char]]
mbArgNames, SBVType
t) UIMap
newUIs)

  pure 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 = State
-> (State -> IORef [([Char], Maybe CallStack, SV)])
-> ([([Char], Maybe CallStack, SV)]
    -> [([Char], Maybe CallStack, SV)])
-> IO ()
-> IO ()
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)([Char], Maybe CallStack, SV)
-> [([Char], Maybe CallStack, SV)]
-> [([Char], Maybe CallStack, SV)]
forall a. a -> [a] -> [a]
:)
                                        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> IO ()
forall a. [[Char]] -> a
noInteractive [ [Char]
"Named assertions (sAssert):"
                                                        , [Char]
"  Tag: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg
                                                        , [Char]
"  Loc: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> (CallStack -> [Char]) -> Maybe CallStack -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Unknown" CallStack -> [Char]
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.
newInternalVariable :: State -> Kind -> IO SV
newInternalVariable :: State -> Kind -> IO SV
newInternalVariable State
st Kind
k = do NamedSymVar sv nm <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
                              let n = Name
"__internal_sbv_" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
nm
                                  v = SV -> Name -> NamedSymVar
NamedSymVar SV
sv Name
n
                              modifyState st rinps (addUserInput sv n) $ modifyIncState st rNewInps (v :)
                              return sv
{-# INLINE newInternalVariable #-}

-- | Create a variable to be used in a constraint-expression
quantVar :: Quantifier -> State -> Kind -> IO SV
quantVar :: Quantifier -> State -> Kind -> IO SV
quantVar Quantifier
q State
st Kind
k = do v@(NamedSymVar sv _) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
                     modifyState st rlambdaInps (S.|> (q, v)) (return ())
                     return sv
{-# INLINE quantVar #-}

-- | Create a variable to be used in a lambda-expression
lambdaVar :: State -> Kind -> IO SV
lambdaVar :: State -> Kind -> IO SV
lambdaVar = Quantifier -> State -> Kind -> IO SV
quantVar Quantifier
ALL
{-# INLINE lambdaVar #-}

-- | Create a new SV
newSV :: State -> Kind -> IO NamedSymVar
newSV :: State -> Kind -> IO NamedSymVar
newSV State
st Kind
k = do ctr <- State -> IO Int
incrementInternalCounter State
st
                ll  <- readIORef (rLambdaLevel st)
                let sv = Kind -> NodeId -> SV
SV Kind
k ((SBVContext, Maybe Int, Int) -> NodeId
NodeId (State -> SBVContext
sbvContext State
st, Maybe Int
ll, Int
ctr))
                registerKind st k
                return $ NamedSymVar sv $ T.pack (show sv)
{-# 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, [Char] -> Bool
isReserved [Char]
sortName
  = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
sortName [Char] -> ShowS
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)

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

       modifyState st rUsedKinds (Set.insert k) $ 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 = case Kind
k of
                                              KUserSort{} -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              KList{}     -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              KTuple [Kind]
nks  -> [Kind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
nks Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Kind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
oks | KTuple [Kind]
oks <- Set Kind -> [Kind]
forall a. Set a -> [a]
Set.toList Set Kind
existingKinds]
                                              KMaybe{}    -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              KEither{}   -> Kind
k Kind -> Set Kind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Kind
existingKinds
                                              Kind
_           -> Bool
False

                          when needsAdding $ modifyIncState st rNewKinds (Set.insert k)

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

-- | 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
  | [Char] -> Bool
isReserved [Char]
nm
  = [Char] -> IO ()
err [Char]
"is a reserved string; please use a different name."
  | Char
'|' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
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
'\\' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 old <- IORef (Set [Char]) -> IO (Set [Char])
forall a. IORef a -> IO a
readIORef (IORef (Set [Char]) -> IO (Set [Char]))
-> IORef (Set [Char]) -> IO (Set [Char])
forall a b. (a -> b) -> a -> b
$ State -> IORef (Set [Char])
rUsedLbls State
st
       if nm `Set.member` old
          then err "is used multiple times. Please do not use duplicate names!"
          else modifyState st rUsedLbls (Set.insert nm) (return ())

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

-- We need to auto-generate certain functions, so keep track of them here
registerSpecialFunction :: State -> Op -> IO ()
registerSpecialFunction :: State -> Op -> IO ()
registerSpecialFunction State
st Op
o =
  do progInfo <- IORef ProgInfo -> IO ProgInfo
forall a. IORef a -> IO a
readIORef (State -> IORef ProgInfo
rProgInfo (State -> State
getRootState State
st))
     let upd p :: ProgInfo
p@ProgInfo{[Op]
progSpecialFuncs :: ProgInfo -> [Op]
progSpecialFuncs :: [Op]
progSpecialFuncs} = ProgInfo
p{progSpecialFuncs = o : progSpecialFuncs}
     unless (o `elem` progSpecialFuncs progInfo) $ modifyState st rProgInfo upd (pure ())

-- | Create a new constant; hash-cons as necessary
newConst :: State -> CV -> IO SV
newConst :: State -> CV -> IO SV
newConst State
st CV
c = do
  constMap <- IORef CnstMap -> IO CnstMap
forall a. IORef a -> IO a
readIORef (State -> IORef CnstMap
rconstMap State
st)
  case c `Map.lookup` 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 -> SV -> IO SV
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
    Maybe SV
Nothing -> do (NamedSymVar sv _) <- State -> Kind -> IO NamedSymVar
newSV State
st (CV -> Kind
forall a. HasKind a => a -> Kind
kindOf CV
c)
                  let ins = CV -> SV -> CnstMap -> CnstMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CV
c SV
sv
                  modifyState st rconstMap ins $ modifyIncState st rNewConsts ins
                  return 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)
  tblMap <- IORef TableMap -> IO TableMap
forall a. IORef a -> IO a
readIORef (State -> IORef TableMap
rtblMap State
st)
  case key `Map.lookup` tblMap of
    Just Int
i -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
    Maybe Int
_      -> do let i :: Int
i   = TableMap -> Int
forall k a. Map k a -> Int
Map.size TableMap
tblMap
                     upd :: TableMap -> TableMap
upd = (Kind, Kind, [SV]) -> Int -> TableMap -> TableMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Kind, Kind, [SV])
key Int
i
                 State
-> (State -> IORef TableMap)
-> (TableMap -> TableMap)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef TableMap
rtblMap TableMap -> TableMap
upd (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ State
-> (IncState -> IORef TableMap) -> (TableMap -> TableMap) -> IO ()
forall a. State -> (IncState -> IORef a) -> (a -> a) -> IO ()
modifyIncState State
st IncState -> IORef TableMap
rNewTbls TableMap -> TableMap
upd
                 Int -> IO Int
forall a. a -> IO a
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 <- IORef ExprMap -> IO ExprMap
forall a. IORef a -> IO a
readIORef (State -> IORef ExprMap
rexprMap State
st)
   case e `Map.lookup` 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 | SV -> Kind
forall a. HasKind a => a -> Kind
kindOf SV
sv Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
k -> SV -> IO SV
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SV
sv
     Maybe SV
_                        -> do (NamedSymVar sv _) <- State -> Kind -> IO NamedSymVar
newSV State
st Kind
k
                                    checkConsistent sv e
                                    let append (SBVPgm Seq (SV, SBVExpr)
xs) = Seq (SV, SBVExpr) -> SBVPgm
SBVPgm (Seq (SV, SBVExpr)
xs Seq (SV, SBVExpr) -> (SV, SBVExpr) -> Seq (SV, SBVExpr)
forall a. Seq a -> a -> Seq a
S.|> (SV
sv, SBVExpr
e))
                                    modifyState st spgm append $ modifyIncState st rNewAsgns append
                                    modifyState st rexprMap (Map.insert e sv) (return ())
                                    return sv
{-# INLINE newExpr #-}

-- | In rare cases, we can get a context mismatch; so make sure the expression is well-formed.
-- This isn't a full solution, but handles the common case (hopefully!)
checkConsistent :: SV -> SBVExpr -> IO ()
checkConsistent :: SV -> SBVExpr -> IO ()
checkConsistent SV
lhs (SBVApp Op
_ [SV]
args) = (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
check [SV]
args
   where SV Kind
_ (NodeId (SBVContext
lhsContext, Maybe Int
mbLambdaLevel, Int
lhsId)) = SV
lhs
         check :: SV -> IO ()
check (SV Kind
_ (NodeId (SBVContext
rhsContext, Maybe Int
mbLL, Int
ni)))
           | SBVContext
lhsContext SBVContext -> SBVContext -> Bool
`compatibleContext` SBVContext
rhsContext Bool -> Bool -> Bool
&& Int
lambdaLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ll Bool -> Bool -> Bool
&& (Int
lambdaLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ll Bool -> Bool -> Bool
|| Int
lhsId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ni)
           = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
           | Bool
True
           = SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> IO ()
forall a.
SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> a
contextMismatchError SBVContext
lhsContext SBVContext
rhsContext ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
lambdaLevel, Int
lhsId)) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
ll, Int
ni))
           where lambdaLevel :: Int
lambdaLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mbLambdaLevel
                 ll :: Int
ll          = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mbLL
{-# INLINE checkConsistent #-}

-- | Are these compatible contexts? Either the same, or one of them is global
compatibleContext :: SBVContext -> SBVContext -> Bool
compatibleContext :: SBVContext -> SBVContext -> Bool
compatibleContext SBVContext
c1 SBVContext
c2 = SBVContext
c1 SBVContext -> SBVContext -> Bool
forall a. Eq a => a -> a -> Bool
== SBVContext
c2 Bool -> Bool -> Bool
|| SBVContext
c1 SBVContext -> SBVContext -> Bool
forall a. Eq a => a -> a -> Bool
== SBVContext
globalSBVContext Bool -> Bool -> Bool
|| SBVContext
c2 SBVContext -> SBVContext -> Bool
forall a. Eq a => a -> a -> Bool
== SBVContext
globalSBVContext
{-# INLINE compatibleContext #-}

-- | Same as checkConsistent above, except in an array context
checkCompatibleContext :: SBVContext -> SBVContext -> IO ()
checkCompatibleContext :: SBVContext -> SBVContext -> IO ()
checkCompatibleContext SBVContext
ctx1 SBVContext
ctx2
   | SBVContext
ctx1 SBVContext -> SBVContext -> Bool
`compatibleContext` SBVContext
ctx2
   = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
   | Bool
True
   = SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> IO ()
forall a.
SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> a
contextMismatchError SBVContext
ctx1 SBVContext
ctx2 Maybe (Int, Int)
forall a. Maybe a
Nothing Maybe (Int, Int)
forall a. Maybe a
Nothing
{-# INLINE checkCompatibleContext #-}

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

instance MonadSymbolic m             => MonadSymbolic (ExceptT e m)
instance MonadSymbolic m             => MonadSymbolic (MaybeT m)
instance MonadSymbolic m             => MonadSymbolic (ReaderT r m)
instance MonadSymbolic m             => MonadSymbolic (SS.StateT s m)
instance MonadSymbolic m             => MonadSymbolic (LS.StateT s m)
instance (MonadSymbolic m, Monoid w) => MonadSymbolic (SW.WriterT w m)
instance (MonadSymbolic m, Monoid w) => MonadSymbolic (LW.WriterT w m)

-- | 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 newtype ( Functor (SymbolicT m)
Functor (SymbolicT m) =>
(forall a. a -> SymbolicT m a)
-> (forall a b.
    SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b)
-> (forall a b c.
    (a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c)
-> (forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b)
-> (forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m a)
-> Applicative (SymbolicT m)
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
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SymbolicT m a
pure :: forall a. a -> SymbolicT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
<*> :: forall a b. SymbolicT m (a -> b) -> SymbolicT m a -> SymbolicT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
liftA2 :: forall a b c.
(a -> b -> c) -> SymbolicT m a -> SymbolicT m b -> SymbolicT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SymbolicT m a -> SymbolicT m b -> SymbolicT m b
*> :: 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 a
<* :: forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m a
Applicative, (forall a b. (a -> b) -> SymbolicT m a -> SymbolicT m b)
-> (forall a b. a -> SymbolicT m b -> SymbolicT m a)
-> Functor (SymbolicT m)
forall a b. a -> SymbolicT m b -> SymbolicT m a
forall a b. (a -> b) -> SymbolicT m a -> SymbolicT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SymbolicT m b -> SymbolicT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SymbolicT m a -> SymbolicT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SymbolicT m a -> SymbolicT m b
fmap :: forall a b. (a -> b) -> SymbolicT m a -> SymbolicT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SymbolicT m b -> SymbolicT m a
<$ :: forall a b. a -> SymbolicT m b -> SymbolicT m a
Functor, Applicative (SymbolicT m)
Applicative (SymbolicT m) =>
(forall a b.
 SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b)
-> (forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b)
-> (forall a. a -> SymbolicT m a)
-> Monad (SymbolicT m)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SymbolicT m a -> (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 -> SymbolicT m b -> SymbolicT m b
>> :: forall a b. SymbolicT m a -> SymbolicT m b -> SymbolicT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> SymbolicT m a
return :: forall a. a -> SymbolicT m a
Monad, Monad (SymbolicT m)
Monad (SymbolicT m) =>
(forall a. IO a -> SymbolicT m a) -> MonadIO (SymbolicT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SymbolicT m a
liftIO :: forall a. IO a -> SymbolicT m a
MonadIO, (forall (m :: * -> *). Monad m => Monad (SymbolicT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a)
-> MonadTrans SymbolicT
forall (m :: * -> *). Monad m => Monad (SymbolicT m)
forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
MonadTrans
                            , MonadError e, MonadState s, MonadWriter w
#if MIN_VERSION_base(4,11,0)
                            , Monad (SymbolicT m)
Monad (SymbolicT m) =>
(forall a. [Char] -> SymbolicT m a) -> MonadFail (SymbolicT m)
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
$cfail :: forall (m :: * -> *) a. MonadFail m => [Char] -> SymbolicT m a
fail :: forall a. [Char] -> SymbolicT m a
Fail.MonadFail
#endif
                            )

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

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

-- 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 = m r -> SymbolicT m r
forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> SymbolicT m a -> SymbolicT m a
local r -> r
f = (ReaderT State m a -> ReaderT State m a)
-> SymbolicT m a -> SymbolicT m a
forall (m :: * -> *) a (n :: * -> *) b.
(ReaderT State m a -> ReaderT State n b)
-> SymbolicT m a -> SymbolicT n b
mapSymbolicT ((ReaderT State m a -> ReaderT State m a)
 -> SymbolicT m a -> SymbolicT m a)
-> (ReaderT State m a -> ReaderT State m a)
-> SymbolicT m a
-> SymbolicT m a
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m a -> m a) -> ReaderT State m a -> ReaderT State m a)
-> (m a -> m a) -> ReaderT State m a -> ReaderT State m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f

-- | 'Symbolic' is specialization of t'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 (Quantifier -> Maybe Quantifier
forall a. a -> Maybe a
Just Quantifier
EX)) Kind
k ([Char] -> Maybe [Char]
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 = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar Maybe Quantifier
forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
False Int
w) ([Char] -> Maybe [Char]
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 = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar Maybe Quantifier
forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
False Int
w) Maybe [Char]
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 = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar Maybe Quantifier
forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
True Int
w) ([Char] -> Maybe [Char]
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 = m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv m State -> (State -> m SVal) -> m SVal
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO SVal -> m SVal
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SVal -> m SVal) -> (State -> IO SVal) -> State -> m SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
svMkSymVar (Maybe Quantifier -> VarContext
NonQueryVar Maybe Quantifier
forall a. Maybe a
Nothing) (Bool -> Int -> Kind
KBounded Bool
True Int
w) Maybe [Char]
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
        rm <- IORef SBVRunMode -> IO SBVRunMode
forall a. IORef a -> IO a
readIORef (State -> IORef SBVRunMode
runMode State
st)

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

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

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

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

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

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

        case (mbQ, 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 (IO SVal -> IO SVal) -> IO SVal -> IO SVal
forall a b. (a -> b) -> a -> b
$ Quantifier -> IO SVal
mkS Quantifier
ALL  -- code generation, pick universal

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

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

          -- Model validation:
          (Maybe Quantifier
_      , Concrete (Just (Bool
_isSat, [(NamedSymVar, CV)]
env))) -> do
                        let bad :: [Char] -> [Char] -> b
bad [Char]
why [Char]
conc = [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
                                                           , [Char]
"*** Data.SBV: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
why
                                                           , [Char]
"***"
                                                           , [Char]
"***   To turn validation off, use `cfg{validateModel = False}`"
                                                           , [Char]
"***"
                                                           , [Char]
"*** " [Char] -> ShowS
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
                          () | Kind -> Bool
forall a. HasKind a => a -> Bool
isUserSort Kind
k -> [Char] -> [Char] -> IO SVal
forall {b}. [Char] -> [Char] -> b
bad ([Char]
"Cannot validate models in the presence of user defined kinds, saw: "             [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k) [Char]
cant

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

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

                                       -- Ignore the context equivalence check here. When validating, we are in a different
                                       -- context; so they won't match
                                       same (NamedSymVar (SV Kind
_ (NodeId (SBVContext
_, Maybe Int
ll1, Int
li1))) Name
_)
                                            (NamedSymVar (SV Kind
_ (NodeId (SBVContext
_, Maybe Int
ll2, Int
li2))) Name
_) = (Maybe Int
ll1, Int
li1) (Maybe Int, Int) -> (Maybe Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Int
ll2, Int
li2)

                                       cv = case [CV
v | (NamedSymVar
nsv', CV
v) <- [(NamedSymVar, CV)]
env, NamedSymVar
nsv NamedSymVar -> NamedSymVar -> Bool
`same` 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.
                                                             Kind -> Integer -> CV
forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k (Integer
0::Integer)
                                                       else [Char] -> [Char] -> CV
forall {b}. [Char] -> [Char] -> b
bad ([Char]
"Cannot locate variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (NamedSymVar, Kind) -> [Char]
forall a. Show a => a -> [Char]
show (NamedSymVar
nsv, Kind
k)) [Char]
report
                                              [CV
c]  -> CV
c
                                              [CV]
r    -> [Char] -> [Char] -> CV
forall {b}. [Char] -> [Char] -> b
bad (   [Char]
"Found multiple matching values for variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NamedSymVar -> [Char]
forall a. Show a => a -> [Char]
show NamedSymVar
nsv
                                                           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n*** " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [CV] -> [Char]
forall a. Show a => a -> [Char]
show [CV]
r) [Char]
report

                                   mkC 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 :: State -> IORef SBVRunMode
runMode :: IORef SBVRunMode
runMode} (Bool
isQueryVar, Bool
isTracker) [Char]
nmOrig Kind
k Quantifier
q SV
sv = do
        old <- Inputs -> Set Name
allInputs (Inputs -> Set Name) -> IO Inputs -> IO (Set Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Inputs -> IO Inputs
forall a. IORef a -> IO a
readIORef (State -> IORef Inputs
rinps State
st)

        let nm  = Name -> Set Name -> Name
mkUnique ([Char] -> Name
T.pack [Char]
nmOrig) Set Name
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.
        rm <- readIORef runMode
        case rm of
          SMTMode QueryContext
_ IStage
IRun Bool
_ SMTConfig
_ | Bool -> Bool
not Bool
isQueryVar -> [[Char]] -> IO ()
forall a. [[Char]] -> a
noInteractiveEver [ [Char]
"Adding a new input variable in query mode: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
forall a. Show a => a -> [Char]
show Name
nm
                                                                   , [Char]
""
                                                                   , [Char]
"Hint: Use freshVar/freshVar_ for introducing new inputs in query mode."
                                                                   ]
          SBVRunMode
_                                   -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        if isTracker && q == ALL
           then error $ "SBV: Impossible happened! A universally quantified tracker variable is being introduced: " ++ show nm
           else do let newInp [NamedSymVar]
olds = case Quantifier
q of
                                      Quantifier
EX  -> SV -> Name -> NamedSymVar
toNamedSV SV
sv Name
nm NamedSymVar -> [NamedSymVar] -> [NamedSymVar]
forall a. a -> [a] -> [a]
: [NamedSymVar]
olds
                                      Quantifier
ALL -> [[Char]] -> [NamedSymVar]
forall a. [[Char]] -> a
noInteractive [ [Char]
"Adding a new universally quantified variable: "
                                                           , [Char]
"  Name      : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
forall a. Show a => a -> [Char]
show Name
nm
                                                           , [Char]
"  Kind      : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
                                                           , [Char]
"  Quantifier: Universal"
                                                           , [Char]
"  Node      : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SV -> [Char]
forall a. Show a => a -> [Char]
show SV
sv
                                                           , [Char]
"Only existential variables are supported in query mode."
                                                           ]
                   if isTracker
                      then modifyState st rinps (addInternInput sv nm)
                                     $ noInteractive ["Adding a new tracker variable in interactive mode: " ++ show nm]
                      else modifyState st rinps (addUserInput sv nm)
                                     $ modifyIncState st rNewInps newInp
                   return $ SVal k $ Right $ cache (const (return 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 -> Set Name -> Name
mkUnique Name
prefix Set Name
names = case (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
names) (Name
prefix Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name
prefix Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> [Char] -> Name
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i) | Int
i <- [(Int
0::Int)..]]) of
                                   Name
h:[Name]
_ -> Name
h
                                   [Name]
_   -> [Char] -> Name
forall a. HasCallStack => [Char] -> a
error ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ [Char]
"mkUnique: Impossible happened! Couldn't get a unique name for " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Name, Set Name) -> [Char]
forall a. Show a => a -> [Char]
show (Name
prefix, Set Name
names)

-- | Create a new state
mkNewState :: MonadIO m => SMTConfig -> SBVRunMode -> m State
mkNewState :: forall (m :: * -> *).
MonadIO m =>
SMTConfig -> SBVRunMode -> m State
mkNewState SMTConfig
cfg SBVRunMode
currentRunMode = IO State -> m State
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ do
     currTime           <- IO UTCTime
getCurrentTime
     progInfo           <- newIORef ProgInfo { hasQuants         = False
                                             , progSpecialRels   = []
                                             , progTransClosures = []
                                             , progSpecialFuncs  = []
                                             }
     rm                 <- newIORef currentRunMode
     ctr                <- newIORef (-2) -- start from -2; False and True will always occupy the first two elements
     lambda             <- newIORef $ case currentRunMode of
                                        SMTMode{}     -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
                                        CodeGen{}     -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
                                        Concrete{}    -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
                                        LambdaGen Maybe Int
mbi -> Maybe Int
mbi
     cInfo              <- newIORef []
     observes           <- newIORef mempty
     pgm                <- newIORef (SBVPgm S.empty)
     emap               <- newIORef Map.empty
     cmap               <- newIORef Map.empty
     inps               <- newIORef mempty
     lambdaInps         <- newIORef mempty
     outs               <- newIORef []
     tables             <- newIORef Map.empty
     userFuncs          <- newIORef Set.empty
     uis                <- newIORef Map.empty
     cgs                <- newIORef Map.empty
     defns              <- newIORef []
     swCache            <- newIORef IMap.empty
     usedKinds          <- newIORef Set.empty
     usedLbls           <- newIORef Set.empty
     cstrs              <- newIORef S.empty
     pvs                <- newIORef []
     smtOpts            <- newIORef []
     optGoals           <- newIORef []
     asserts            <- newIORef []
     outstandingAsserts <- newIORef False
     istate             <- newIORef =<< newIncState
     qstate             <- newIORef Nothing
     ctx                <- genSBVContext
     pure $ State { sbvContext          = ctx
                  , runMode             = rm
                  , stCfg               = cfg
                  , startTime           = currTime
                  , rProgInfo           = progInfo
                  , pathCond            = SVal KBool (Left trueCV)
                  , rIncState           = istate
                  , rCInfo              = cInfo
                  , rObservables        = observes
                  , rctr                = ctr
                  , rLambdaLevel        = lambda
                  , rUsedKinds          = usedKinds
                  , rUsedLbls           = usedLbls
                  , rinps               = inps
                  , rlambdaInps         = lambdaInps
                  , routs               = outs
                  , rtblMap             = tables
                  , spgm                = pgm
                  , rconstMap           = cmap
                  , rexprMap            = emap
                  , rUserFuncs          = userFuncs
                  , rUIMap              = uis
                  , rCgMap              = cgs
                  , rDefns              = defns
                  , rSVCache            = swCache
                  , rConstraints        = cstrs
                  , rPartitionVars      = pvs
                  , rSMTOptions         = smtOpts
                  , rOptGoals           = optGoals
                  , rAsserts            = asserts
                  , rOutstandingAsserts = outstandingAsserts
                  , rQueryState         = qstate
                  , parentState         = Nothing
                  }

-- | Generalization of 'Data.SBV.runSymbolic'
runSymbolic :: MonadIO m => SMTConfig -> SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic :: forall (m :: * -> *) a.
MonadIO m =>
SMTConfig -> SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic SMTConfig
cfg SBVRunMode
currentRunMode SymbolicT m a
comp = do
   st <- SMTConfig -> SBVRunMode -> m State
forall (m :: * -> *).
MonadIO m =>
SMTConfig -> SBVRunMode -> m State
mkNewState SMTConfig
cfg SBVRunMode
currentRunMode
   runSymbolicInState st comp

-- | Catch the catastrophic case of context mismatch
contextMismatchError :: SBVContext -> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> a
contextMismatchError :: forall a.
SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> a
contextMismatchError SBVContext
ctx1 SBVContext
ctx2 Maybe (Int, Int)
level1 Maybe (Int, Int)
level2 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
prefix [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
rest
  where prefix :: [[Char]]
prefix | SBVContext
ctx1 SBVContext -> SBVContext -> Bool
forall a. Eq a => a -> a -> Bool
/= SBVContext
ctx2 = [ [Char]
"Data.SBV: Mismatched contexts detected."
                                , [Char]
"***"
                                , [Char]
"*** Current context: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVContext -> [Char]
forall a. Show a => a -> [Char]
show SBVContext
ctx1
                                , [Char]
"*** Mixed with     : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SBVContext -> [Char]
forall a. Show a => a -> [Char]
show SBVContext
ctx2
                                ]
               | Bool
True         = [ [Char]
"Data.SBV: Mismatched levels detected in the same context."
                                , [Char]
"***"
                                , [Char]
"*** Refers to: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show Maybe (Int, Int)
level1
                                , [Char]
"*** And also : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show Maybe (Int, Int)
level2
                                ]

        rest :: [[Char]]
rest = [ [Char]
"***"
               , [Char]
"*** This happens if you call a proof-function (prove/sat/runSMT/isSatisfiable) etc."
               , [Char]
"*** while another one is in execution, or use results from one such call in another."
               , [Char]
"*** Please avoid such nested calls, all interactions should be from the same context."
               , [Char]
"*** See https://github.com/LeventErkok/sbv/issues/71 for several examples."
               ]

-- | Run a symbolic computation in a given state
runSymbolicInState :: MonadIO m => State -> SymbolicT m a -> m (a, Result)
runSymbolicInState :: forall (m :: * -> *) a.
MonadIO m =>
State -> SymbolicT m a -> m (a, Result)
runSymbolicInState State
st (SymbolicT ReaderT State m a
c) = do
   _ <- IO SV -> m SV
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> m SV) -> IO SV -> m SV
forall a b. (a -> b) -> a -> b
$ State -> CV -> IO SV
newConst State
st CV
falseCV -- s(-2) == falseSV
   _ <- liftIO $ newConst st trueCV  -- s(-1) == trueSV
   r <- runReaderT c st
   res <- liftIO $ extractSymbolicSimulationState st

   -- Check that the state wasn't clobbered in any way
   let check SBVContext
ctx | SBVContext
ctx SBVContext -> SBVContext -> Bool
forall a. Eq a => a -> a -> Bool
== State -> SBVContext
sbvContext State
st Bool -> Bool -> Bool
|| SBVContext
ctx SBVContext -> SBVContext -> Bool
forall a. Eq a => a -> a -> Bool
== SBVContext
globalSBVContext
                 = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                 | Bool
True
                 = SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> m ()
forall a.
SBVContext
-> SBVContext -> Maybe (Int, Int) -> Maybe (Int, Int) -> a
contextMismatchError (State -> SBVContext
sbvContext State
st) SBVContext
ctx Maybe (Int, Int)
forall a. Maybe a
Nothing Maybe (Int, Int)
forall a. Maybe a
Nothing

   mapM_ check $ nubOrd $ G.universeBi res

   return (r, res)

-- | Grab the program from a running symbolic simulation state.
extractSymbolicSimulationState :: State -> IO Result
extractSymbolicSimulationState :: State -> IO Result
extractSymbolicSimulationState st :: State
st@State{ runMode :: State -> IORef SBVRunMode
runMode=IORef SBVRunMode
rrm
                                       , spgm :: State -> IORef SBVPgm
spgm=IORef SBVPgm
pgm, rinps :: State -> IORef Inputs
rinps=IORef Inputs
inps, rlambdaInps :: State -> IORef LambdaInputs
rlambdaInps=IORef LambdaInputs
linps, routs :: State -> IORef [SV]
routs=IORef [SV]
outs, rtblMap :: State -> IORef TableMap
rtblMap=IORef TableMap
tables
                                       , rUIMap :: State -> IORef UIMap
rUIMap=IORef UIMap
uis, rDefns :: State -> IORef [(SMTDef, SBVType)]
rDefns=IORef [(SMTDef, SBVType)]
defns
                                       , 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, rProgInfo :: State -> IORef ProgInfo
rProgInfo=IORef ProgInfo
progInfo
                                       } = do
   SBVPgm rpgm  <- IORef SBVPgm -> IO SBVPgm
forall a. IORef a -> IO a
readIORef IORef SBVPgm
pgm

   rm <- readIORef rrm

   inpsO <- do Inputs{userInputs, internInputs} <- readIORef inps
               ls <- readIORef linps

               let lambdaOnly = case SBVRunMode
rm of
                                  SMTMode{}   -> Bool
False
                                  CodeGen{}   -> Bool
False
                                  Concrete{}  -> Bool
False
                                  LambdaGen{} -> Bool
True
                   topInps = (UserInputs -> [NamedSymVar]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList UserInputs
userInputs, UserInputs -> [NamedSymVar]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList UserInputs
internInputs)
                   lamInps = LambdaInputs -> [(Quantifier, NamedSymVar)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList LambdaInputs
ls

               if lambdaOnly
                  then case topInps of
                          ([], []) -> ResultInp -> IO ResultInp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultInp -> IO ResultInp) -> ResultInp -> IO ResultInp
forall a b. (a -> b) -> a -> b
$ [(Quantifier, NamedSymVar)] -> ResultInp
ResultLamInps (LambdaInputs -> [(Quantifier, NamedSymVar)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList LambdaInputs
ls)
                          ([NamedSymVar]
xs, [NamedSymVar]
ys) -> [Char] -> IO ResultInp
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ResultInp) -> [Char] -> IO ResultInp
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
                                                      , [Char]
"*** Data.SBV: Impossible happened; saw inputs in lambda mode."
                                                      , [Char]
"***"
                                                      , [Char]
"***   Inps    : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [NamedSymVar] -> [Char]
forall a. Show a => a -> [Char]
show [NamedSymVar]
xs
                                                      , [Char]
"***   Trackers: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [NamedSymVar] -> [Char]
forall a. Show a => a -> [Char]
show [NamedSymVar]
ys
                                                      ]
                  else case lamInps of
                          [] -> ResultInp -> IO ResultInp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultInp -> IO ResultInp) -> ResultInp -> IO ResultInp
forall a b. (a -> b) -> a -> b
$ ([NamedSymVar], [NamedSymVar]) -> ResultInp
ResultTopInps ([NamedSymVar], [NamedSymVar])
topInps
                          [(Quantifier, NamedSymVar)]
_  -> [Char] -> IO ResultInp
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ResultInp) -> [Char] -> IO ResultInp
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
                                                , [Char]
"*** Data.SBV: Impossible happened; saw lambda inputs in regular mode."
                                                , [Char]
"***"
                                                , [Char]
"***   Params: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Quantifier, NamedSymVar)] -> [Char]
forall a. Show a => a -> [Char]
show [(Quantifier, NamedSymVar)]
lamInps
                                                ]

   outsO <- reverse <$> readIORef outs

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

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

   tbls  <- map arrange . sortBy cmp . map swap . Map.toList <$> readIORef tables
   ds    <- reverse <$> readIORef defns
   unint <- do unints <- Map.toList <$> readIORef uis
               -- drop those that has a definition associated with it
               let defineds = ((SMTDef, SBVType) -> Maybe [Char])
-> [(SMTDef, SBVType)] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SMTDef -> Maybe [Char]
smtDefGivenName (SMTDef -> Maybe [Char])
-> ((SMTDef, SBVType) -> SMTDef)
-> (SMTDef, SBVType)
-> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SMTDef, SBVType) -> SMTDef
forall a b. (a, b) -> a
fst) [(SMTDef, SBVType)]
ds
               pure [ui | ui@(nm, _) <- unints, nm `notElem` defineds]
   knds  <- readIORef usedKinds
   cgMap <- Map.toList <$> readIORef cgs

   traceVals   <- reverse <$> readIORef cInfo
   observables <- reverse . fmap (\(Name
n,CV -> Bool
f,SV
sv) -> (Name -> [Char]
T.unpack Name
n, CV -> Bool
f, SV
sv)) . F.toList
                  <$> readIORef observes
   extraCstrs  <- readIORef cstrs
   assertions  <- reverse <$> readIORef asserts

   pinfo <- readIORef progInfo

   return $ Result pinfo knds traceVals observables cgMap inpsO (constMap, cnsts) tbls unint ds (SBVPgm rpgm) extraCstrs assertions outsO

-- | Generalization of 'Data.SBV.addNewSMTOption'
addNewSMTOption :: MonadSymbolic m => SMTOption -> m ()
addNewSMTOption :: forall (m :: * -> *). MonadSymbolic m => SMTOption -> m ()
addNewSMTOption SMTOption
o = do st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
                       liftIO $ modifyState st rSMTOptions (o:) (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 st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
                                     rm <- liftIO $ readIORef (runMode st)

                                     case rm of
                                       SBVRunMode
CodeGen -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"SBV: constraints are not allowed in code-generation"
                                       SBVRunMode
_       -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do ([Char] -> IO ()) -> [[Char]] -> IO ()
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 v <- State -> SVal -> IO SV
svToSV State
st SVal
b

                                          rm <- liftIO $ readIORef (runMode st)

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

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

                                          when (isValidating || interesting) $
                                               modifyState st rConstraints (S.|> c)
                                                            $ modifyIncState st rNewConstraints (S.|> 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 st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv

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

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

                        !obj' <- walk obj
                        liftIO $ modifyState st rOptGoals (obj' :)
                                           $ noInteractive [ "Adding an optimization objective:"
                                                           , "  Objective: " ++ show obj
                                                           ]

-- | Generalization of 'Data.SBV.sObserve'
sObserve :: MonadSymbolic m => String -> SVal -> m ()
sObserve :: forall (m :: * -> *). MonadSymbolic m => [Char] -> SVal -> m ()
sObserve [Char]
m SVal
x
  | Just [Char]
bad <- [Char] -> Maybe [Char]
checkObservableName [Char]
m
  = [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
bad
  | Bool
True
  = do st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
       liftIO $ do xsv <- svToSV st x
                   recordObservable st m (const True) xsv

-- | Generalization of 'Data.SBV.outputSVal'
outputSVal :: MonadSymbolic m => SVal -> m ()
outputSVal :: forall (m :: * -> *). MonadSymbolic m => SVal -> m ()
outputSVal (SVal Kind
_ (Left CV
c)) = do
  st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
  sv <- liftIO $ newConst st c
  liftIO $ modifyState st routs (sv:) (return ())
outputSVal (SVal Kind
_ (Right Cached SV
f)) = do
  st <- m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
  sv <- liftIO $ uncache f st
  liftIO $ modifyState st routs (sv:) (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 = (State -> IO a) -> Cached a
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 = (State -> IORef (Cache SV)) -> Cached SV -> State -> IO SV
forall a. (State -> IORef (Cache a)) -> Cached a -> State -> IO a
uncacheGen State -> IORef (Cache SV)
rSVCache

-- | 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
        stored <- IORef (Cache a) -> IO (Cache a)
forall a. IORef a -> IO a
readIORef IORef (Cache a)
rCache
        sn <- f `seq` makeStableName f
        let h = StableName (State -> IO a) -> Int
forall a. StableName a -> Int
hashStableName StableName (State -> IO a)
sn
        case (h `IMap.lookup` stored) >>= (sn `lookup`) of
          Just a
r  -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
          Maybe a
Nothing -> do r <- State -> IO a
f State
st
                        r `seq` R.modifyIORef' rCache (IMap.insertWith (++) h [(sn, r)])
                        return 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
SMTLibVersion -> SMTLibVersion -> Bounded SMTLibVersion
forall a. a -> a -> Bounded a
$cminBound :: SMTLibVersion
minBound :: SMTLibVersion
$cmaxBound :: SMTLibVersion
maxBound :: SMTLibVersion
Bounded, Int -> SMTLibVersion
SMTLibVersion -> Int
SMTLibVersion -> [SMTLibVersion]
SMTLibVersion -> SMTLibVersion
SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
SMTLibVersion -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
(SMTLibVersion -> SMTLibVersion)
-> (SMTLibVersion -> SMTLibVersion)
-> (Int -> SMTLibVersion)
-> (SMTLibVersion -> Int)
-> (SMTLibVersion -> [SMTLibVersion])
-> (SMTLibVersion -> SMTLibVersion -> [SMTLibVersion])
-> (SMTLibVersion -> SMTLibVersion -> [SMTLibVersion])
-> (SMTLibVersion
    -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion])
-> Enum SMTLibVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SMTLibVersion -> SMTLibVersion
succ :: SMTLibVersion -> SMTLibVersion
$cpred :: SMTLibVersion -> SMTLibVersion
pred :: SMTLibVersion -> SMTLibVersion
$ctoEnum :: Int -> SMTLibVersion
toEnum :: Int -> SMTLibVersion
$cfromEnum :: SMTLibVersion -> Int
fromEnum :: SMTLibVersion -> Int
$cenumFrom :: SMTLibVersion -> [SMTLibVersion]
enumFrom :: SMTLibVersion -> [SMTLibVersion]
$cenumFromThen :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
enumFromThen :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
$cenumFromTo :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
enumFromTo :: SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
$cenumFromThenTo :: SMTLibVersion -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
enumFromThenTo :: SMTLibVersion -> SMTLibVersion -> SMTLibVersion -> [SMTLibVersion]
Enum, SMTLibVersion -> SMTLibVersion -> Bool
(SMTLibVersion -> SMTLibVersion -> Bool)
-> (SMTLibVersion -> SMTLibVersion -> Bool) -> Eq SMTLibVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SMTLibVersion -> SMTLibVersion -> Bool
== :: SMTLibVersion -> SMTLibVersion -> Bool
$c/= :: SMTLibVersion -> SMTLibVersion -> Bool
/= :: SMTLibVersion -> SMTLibVersion -> Bool
Eq, Int -> SMTLibVersion -> ShowS
[SMTLibVersion] -> ShowS
SMTLibVersion -> [Char]
(Int -> SMTLibVersion -> ShowS)
-> (SMTLibVersion -> [Char])
-> ([SMTLibVersion] -> ShowS)
-> Show SMTLibVersion
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMTLibVersion -> ShowS
showsPrec :: Int -> SMTLibVersion -> ShowS
$cshow :: SMTLibVersion -> [Char]
show :: SMTLibVersion -> [Char]
$cshowList :: [SMTLibVersion] -> ShowS
showList :: [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. The second [String] are the function definitions,
-- which is *replicated* in the first one. There are cases where that we need the second part on its own.
data SMTLibPgm = SMTLibPgm SMTLibVersion [String] [String]

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

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

-- Other Technicalities..
instance NFData GeneralizedCV where
  rnf :: GeneralizedCV -> ()
rnf (ExtendedCV ExtCV
e) = ExtCV
e ExtCV -> () -> ()
forall a b. a -> b -> b
`seq` ()
  rnf (RegularCV  CV
c) = CV
c CV -> () -> ()
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) = SV -> ()
forall a. NFData a => a -> ()
rnf SV
s () -> () -> ()
forall a b. a -> b -> b
`seq` Name -> ()
forall a. NFData a => a -> ()
rnf Name
n

instance NFData Result where
  rnf :: Result -> ()
rnf (Result ProgInfo
hasQuants Set Kind
kindInfo [([Char], CV)]
qcInfo [([Char], CV -> Bool, SV)]
obs [([Char], [[Char]])]
cgs ResultInp
inps (CnstMap, [(SV, CV)])
consts [((Int, Kind, Kind), [SV])]
tbls [([Char], (Bool, Maybe [[Char]], SBVType))]
uis [(SMTDef, SBVType)]
axs SBVPgm
pgm Seq (Bool, [([Char], [Char])], SV)
cstr [([Char], Maybe CallStack, SV)]
asserts [SV]
outs)
        = ProgInfo -> ()
forall a. NFData a => a -> ()
rnf ProgInfo
hasQuants () -> () -> ()
forall a b. a -> b -> b
`seq` Set Kind -> ()
forall a. NFData a => a -> ()
rnf Set Kind
kindInfo () -> () -> ()
forall a b. a -> b -> b
`seq` [([Char], CV)] -> ()
forall a. NFData a => a -> ()
rnf [([Char], CV)]
qcInfo  () -> () -> ()
forall a b. a -> b -> b
`seq` [([Char], CV -> Bool, SV)] -> ()
forall a. NFData a => a -> ()
rnf [([Char], CV -> Bool, SV)]
obs    () -> () -> ()
forall a b. a -> b -> b
`seq` [([Char], [[Char]])] -> ()
forall a. NFData a => a -> ()
rnf [([Char], [[Char]])]
cgs
                        () -> () -> ()
forall a b. a -> b -> b
`seq` ResultInp -> ()
forall a. NFData a => a -> ()
rnf ResultInp
inps     () -> () -> ()
forall a b. a -> b -> b
`seq` (CnstMap, [(SV, CV)]) -> ()
forall a. NFData a => a -> ()
rnf (CnstMap, [(SV, CV)])
consts  () -> () -> ()
forall a b. a -> b -> b
`seq` [((Int, Kind, Kind), [SV])] -> ()
forall a. NFData a => a -> ()
rnf [((Int, Kind, Kind), [SV])]
tbls
                        () -> () -> ()
forall a b. a -> b -> b
`seq` [([Char], (Bool, Maybe [[Char]], SBVType))] -> ()
forall a. NFData a => a -> ()
rnf [([Char], (Bool, Maybe [[Char]], SBVType))]
uis      () -> () -> ()
forall a b. a -> b -> b
`seq` [(SMTDef, SBVType)] -> ()
forall a. NFData a => a -> ()
rnf [(SMTDef, SBVType)]
axs     () -> () -> ()
forall a b. a -> b -> b
`seq` SBVPgm -> ()
forall a. NFData a => a -> ()
rnf SBVPgm
pgm
                        () -> () -> ()
forall a b. a -> b -> b
`seq` Seq (Bool, [([Char], [Char])], SV) -> ()
forall a. NFData a => a -> ()
rnf Seq (Bool, [([Char], [Char])], SV)
cstr     () -> () -> ()
forall a b. a -> b -> b
`seq` [([Char], Maybe CallStack, SV)] -> ()
forall a. NFData a => a -> ()
rnf [([Char], Maybe CallStack, SV)]
asserts () -> () -> ()
forall a b. a -> b -> b
`seq` [SV] -> ()
forall a. NFData a => a -> ()
rnf [SV]
outs
instance NFData SV           where rnf :: SV -> ()
rnf SV
a          = SV -> () -> ()
forall a b. a -> b -> b
seq SV
a ()
instance NFData SBVExpr      where rnf :: SBVExpr -> ()
rnf SBVExpr
a          = SBVExpr -> () -> ()
forall a b. a -> b -> b
seq SBVExpr
a ()
instance NFData Quantifier   where rnf :: Quantifier -> ()
rnf Quantifier
a          = Quantifier -> () -> ()
forall a b. a -> b -> b
seq Quantifier
a ()
instance NFData SBVType      where rnf :: SBVType -> ()
rnf SBVType
a          = SBVType -> () -> ()
forall a b. a -> b -> b
seq SBVType
a ()
instance NFData SBVPgm       where rnf :: SBVPgm -> ()
rnf SBVPgm
a          = SBVPgm -> () -> ()
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 (State -> IO a) -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance NFData SVal         where rnf :: SVal -> ()
rnf (SVal Kind
x Either CV (Cached SV)
y) = Kind -> ()
forall a. NFData a => a -> ()
rnf Kind
x () -> () -> ()
forall a b. a -> b -> b
`seq` Either CV (Cached SV) -> ()
forall a. NFData a => a -> ()
rnf Either CV (Cached SV)
y

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

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

instance NFData SMTScript where
  rnf :: SMTScript -> ()
rnf (SMTScript [Char]
b [[Char]]
m) = [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
b () -> () -> ()
forall a b. a -> b -> b
`seq` [[Char]] -> ()
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
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
supportsLambdas            :: Bool           -- ^ Does it support lambdas?
       , SolverCapabilities -> Bool
supportsSpecialRels        :: Bool           -- ^ Does it support special relations (orders, transitive closure etc.)
       , 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 end 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], Integer)]
crackNumSurfaceVals         :: [(String, Integer)] -- ^ For crackNum: The surface representation of variables, if available
       , 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
allSatTrackUFs              :: Bool                -- ^ In a 'Data.SBV.allSat' 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 -> 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.
       , SMTConfig -> Bool
generateHOEquivs            :: Bool                -- ^ Should SBV generate function-level equivalences for firstified functions?
                                                            --   The default is False, but in certain cases this can lead the solver to loop-forever,
                                                            --   especially in KnuckleDragger proofs. In such cases, set this to True to see if it helps.
       , SMTConfig -> KDOptions
kdOptions                   :: KDOptions           -- ^ KnuckleDragger specific options
       }

-- | Configuration for KnuckleDragger
data KDOptions = KDOptions {
         KDOptions -> Int
ribbonLength      :: Int  -- ^ Line length for KD proofs
       , KDOptions -> Int
firstifyUniqueLen :: Int  -- ^ Unique length used for firstified names.
       , KDOptions -> Bool
quiet             :: Bool -- ^ No messages what-so-ever
       , KDOptions -> Bool
measureTime       :: Bool -- ^ Print time/statistics. If quiet is True, then measureTime is ignored.
       }

-- | Ignore internal names and those the user told us to
mustIgnoreVar :: SMTConfig -> String -> Bool
mustIgnoreVar :: SMTConfig -> [Char] -> Bool
mustIgnoreVar SMTConfig
cfg [Char]
s = [Char]
"__internal_sbv" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s Bool -> Bool -> Bool
|| SMTConfig -> [Char] -> Bool
isNonModelVar SMTConfig
cfg [Char]
s

-- | 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 = Solver -> [Char]
forall a. Show a => a -> [Char]
show (Solver -> [Char]) -> (SMTConfig -> Solver) -> SMTConfig -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMTSolver -> Solver
name (SMTSolver -> Solver)
-> (SMTConfig -> SMTSolver) -> SMTConfig -> Solver
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 :: SMTConfig -> Bool
validateModel :: Bool
validateModel, Bool
optimizeValidateConstraints :: SMTConfig -> Bool
optimizeValidateConstraints :: 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 [(NamedSymVar, CV)]
modelBindings   :: Maybe [(NamedSymVar, 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], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
modelUIFuns     :: [(String, (Bool, SBVType, Either String ([([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. Left is used when the function returned is too
                                                                                        -- difficult for SBV to figure out what it means
     }
     deriving Int -> SMTModel -> ShowS
[SMTModel] -> ShowS
SMTModel -> [Char]
(Int -> SMTModel -> ShowS)
-> (SMTModel -> [Char]) -> ([SMTModel] -> ShowS) -> Show SMTModel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMTModel -> ShowS
showsPrec :: Int -> SMTModel -> ShowS
$cshow :: SMTModel -> [Char]
show :: SMTModel -> [Char]
$cshowList :: [SMTModel] -> ShowS
showList :: [SMTModel] -> ShowS
Show

-- | Is it the case that the model is really uninteresting? This is the case when there are no assocs nor ui's
isEmptyModel :: SMTModel -> Bool
isEmptyModel :: SMTModel -> Bool
isEmptyModel SMTModel{[([Char], CV)]
modelAssocs :: SMTModel -> [([Char], CV)]
modelAssocs :: [([Char], CV)]
modelAssocs, [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
modelUIFuns :: SMTModel
-> [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
modelUIFuns :: [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
modelUIFuns} = [([Char], CV)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], CV)]
modelAssocs Bool -> Bool -> Bool
&& [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
modelUIFuns

-- | The result of an SMT solver call. Each constructor is tagged with
-- the t'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
            | OpenSMT
            deriving (Int -> Solver -> ShowS
[Solver] -> ShowS
Solver -> [Char]
(Int -> Solver -> ShowS)
-> (Solver -> [Char]) -> ([Solver] -> ShowS) -> Show Solver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Solver -> ShowS
showsPrec :: Int -> Solver -> ShowS
$cshow :: Solver -> [Char]
show :: Solver -> [Char]
$cshowList :: [Solver] -> ShowS
showList :: [Solver] -> ShowS
Show, Int -> Solver
Solver -> Int
Solver -> [Solver]
Solver -> Solver
Solver -> Solver -> [Solver]
Solver -> Solver -> Solver -> [Solver]
(Solver -> Solver)
-> (Solver -> Solver)
-> (Int -> Solver)
-> (Solver -> Int)
-> (Solver -> [Solver])
-> (Solver -> Solver -> [Solver])
-> (Solver -> Solver -> [Solver])
-> (Solver -> Solver -> Solver -> [Solver])
-> Enum Solver
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Solver -> Solver
succ :: Solver -> Solver
$cpred :: Solver -> Solver
pred :: Solver -> Solver
$ctoEnum :: Int -> Solver
toEnum :: Int -> Solver
$cfromEnum :: Solver -> Int
fromEnum :: Solver -> Int
$cenumFrom :: Solver -> [Solver]
enumFrom :: Solver -> [Solver]
$cenumFromThen :: Solver -> Solver -> [Solver]
enumFromThen :: Solver -> Solver -> [Solver]
$cenumFromTo :: Solver -> Solver -> [Solver]
enumFromTo :: Solver -> Solver -> [Solver]
$cenumFromThenTo :: Solver -> Solver -> Solver -> [Solver]
enumFromThenTo :: Solver -> Solver -> Solver -> [Solver]
Enum, Solver
Solver -> Solver -> Bounded Solver
forall a. a -> a -> Bounded a
$cminBound :: Solver
minBound :: Solver
$cmaxBound :: Solver
maxBound :: 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"

{- HLint ignore type FPOp "Use camelCase" -}
{- HLint ignore type PBOp "Use camelCase" -}
{- HLint ignore type OvOp "Use camelCase" -}
{- HLint ignore type NROp "Use camelCase" -}