    {- |
    Module      : What4.Protocol.SMTWriter
    Description : Infrastructure for rendering What4 expressions in the language of SMT solvers
    Copyright   : (c) Galois, Inc 2014-2020.
    License     : BSD3
    Maintainer  : Joe Hendrix <jhendrix@galois.com>

    This defines common definitions used in writing SMTLIB (2.0 and later), and
    yices outputs from 'Expr' values.

    The writer is designed to support solvers with arithmetic, propositional
    logic, bitvector, tuples (aka. structs), and arrays.

    It maps complex Expr values to either structs or arrays depending
    on what the solver supports (structs are preferred if both are supported).

    It maps multi-dimensional arrays to either arrays with structs as indices
    if structs are supported or nested arrays if they are not.

    The solver should detect when something is not supported and give an
    error rather than sending invalid output to a file.
    -}

    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DoAndIfThenElse #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}

    module What4.Protocol.SMTWriter
      ( -- * Type classes
        SupportTermOps(..)
      , ArrayConstantFn
      , SMTWriter(..)
      , SMTReadWriter (..)
      , SMTEvalBVArrayFn
      , SMTEvalBVArrayWrapper(..)
        -- * Terms
      , Term
      , app
      , app_list
      , builder_list
        -- * SMTWriter
      , WriterConn( supportFunctionDefs
                  , supportFunctionArguments
                  , supportQuantifiers
                  , supportedFeatures
                  , strictParsing
                  , connHandle
                  , connInputHandle
                  , smtWriterName
                  )
      , connState
      , newWriterConn
      , resetEntryStack
      , popEntryStackToTop
      , entryStackHeight
      , pushEntryStack
      , popEntryStack
      , cacheLookupFnNameBimap
      , Command
      , addCommand
      , addCommandNoAck
      , addCommands
      , mkFreeVar
      , bindVarAsFree
      , TypeMap(..)
      , typeMap
      , freshBoundVarName
      , assumeFormula
      , assumeFormulaWithName
      , assumeFormulaWithFreshName
      , DefineStyle(..)
      , AcknowledgementAction(..)
      , ResponseStrictness(..)
      , parserStrictness
      , nullAcknowledgementAction
        -- * SyGuS
      , addSynthFun
      , addDeclareVar
      , addConstraint
        -- * SMTWriter operations
      , assume
      , mkSMTTerm
      , mkFormula
      , mkAtomicFormula
      , SMTEvalFunctions(..)
      , smtExprGroundEvalFn
      , CollectorResults(..)
      , mkBaseExpr
      , runInSandbox
        -- * Reexports
      , What4.Interface.RoundingMode(..)
      ) where

    #if !MIN_VERSION_base(4,13,0)
    import           Control.Monad.Fail ( MonadFail )
    #endif

    import           Control.Exception
    import           Control.Lens hiding ((.>), Strict)
    import           Control.Monad (forM_, unless, when)
    import           Control.Monad.IO.Class
    import           Control.Monad.Reader (ReaderT(..), asks)
    import           Control.Monad.ST
    import           Control.Monad.State.Strict (State, runState)
    import           Control.Monad.Trans (MonadTrans(..))
    import           Control.Monad.Trans.Maybe (MaybeT(..))
    import           Data.Bimap (Bimap)
    import qualified Data.Bimap as Bimap
    import qualified Data.BitVector.Sized as BV
    import qualified Data.Bits as Bits
    import           Data.IORef
    import           Data.Kind
    import           Data.List.NonEmpty (NonEmpty(..))
    import           Data.Maybe
    import           Data.Parameterized.Classes (ShowF(..))
    import qualified Data.Parameterized.Context as Ctx
    import qualified Data.Parameterized.HashTable as PH
    import           Data.Parameterized.Nonce (Nonce)
    import           Data.Parameterized.Some
    import           Data.Parameterized.TraversableFC
    import           Data.Ratio
    import           Data.Text (Text)
    import qualified Data.Text as Text
    import qualified Data.Text.Lazy as Lazy
    import           Data.Text.Lazy.Builder (Builder)
    import qualified Data.Text.Lazy.Builder as Builder
    import qualified Data.Text.Lazy.Builder.Int as Builder (decimal)
    import           Data.Word
    import           LibBF (BigFloat, bfFromBits)

    import           Numeric.Natural
    import           Prettyprinter hiding (Unbounded)
    import           System.IO.Streams (OutputStream, InputStream)
    import qualified System.IO.Streams as Streams

    import           What4.BaseTypes
    import qualified What4.Config as CFG
    import qualified What4.Expr.ArrayUpdateMap as AUM
    import qualified What4.Expr.BoolMap as BM
    import           What4.Expr.Builder
    import           What4.Expr.GroundEval
    import qualified What4.Expr.StringSeq as SSeq
    import qualified What4.Expr.UnaryBV as UnaryBV
    import qualified What4.Expr.WeightedSum as WSum
    import           What4.Interface (RoundingMode(..), stringInfo)
    import           What4.ProblemFeatures
    import           What4.ProgramLoc
    import           What4.SatResult
    import qualified What4.SemiRing as SR
    import qualified What4.SpecialFunctions as SFn
    import           What4.Symbol
    import           What4.Utils.AbstractDomains
    import qualified What4.Utils.BVDomain as BVD
    import           What4.Utils.Complex
    import           What4.Utils.FloatHelpers
    import           What4.Utils.StringLiteral

    ------------------------------------------------------------------------
    -- Term construction typeclasses

    -- | 'TypeMap' defines how a given 'BaseType' maps to an SMTLIB type.
    --
    -- It is necessary as there may be several ways in which a base type can
    -- be encoded.
    data TypeMap (tp::BaseType) where
      BoolTypeMap    :: TypeMap BaseBoolType
      IntegerTypeMap :: TypeMap BaseIntegerType
      RealTypeMap    :: TypeMap BaseRealType
      BVTypeMap      :: (1 <= w) => !(NatRepr w) -> TypeMap (BaseBVType w)
      FloatTypeMap   :: !(FloatPrecisionRepr fpp) -> TypeMap (BaseFloatType fpp)
      UnicodeTypeMap :: TypeMap (BaseStringType Unicode)

      -- A complex number mapped to an SMTLIB struct.
      ComplexToStructTypeMap:: TypeMap BaseComplexType
      -- A complex number mapped to an SMTLIB array from boolean to real.
      ComplexToArrayTypeMap  :: TypeMap BaseComplexType

      -- An array that is encoded using a builtin SMT theory of arrays.
      --
      -- This theory typically restricts the set of arrays that can be encoded,
      -- but have a decidable equality.
      PrimArrayTypeMap :: !(Ctx.Assignment TypeMap (idxl Ctx.::> idx))
                       -> !(TypeMap tp)
                       -> TypeMap (BaseArrayType (idxl Ctx.::> idx) tp)

      -- An array that is encoded as an SMTLIB function.
      --
      -- The element type must not be an array encoded as a function.
      FnArrayTypeMap :: !(Ctx.Assignment TypeMap (idxl Ctx.::> idx))
                     -> TypeMap tp
                     -> TypeMap (BaseArrayType (idxl Ctx.::> idx) tp)

      -- A struct encoded as an SMTLIB struct/ yices tuple.
      --
      -- None of the fields should be arrays encoded as functions.
      StructTypeMap :: !(Ctx.Assignment TypeMap idx)
                    -> TypeMap (BaseStructType idx)

    instance ShowF TypeMap

    instance Show (TypeMap a) where
      show :: TypeMap a -> String
    show TypeMap a
    BoolTypeMap              = String
    "BoolTypeMap"
      show TypeMap a
    IntegerTypeMap           = String
    "IntegerTypeMap"
      show TypeMap a
    RealTypeMap              = String
    "RealTypeMap"
      show (BVTypeMap NatRepr w
    n)            = String
    "BVTypeMap " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NatRepr w -> String
    forall a. Show a => a -> String
    show NatRepr w
    n
      show (FloatTypeMap FloatPrecisionRepr fpp
    x)         = String
    "FloatTypeMap " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ FloatPrecisionRepr fpp -> String
    forall a. Show a => a -> String
    show FloatPrecisionRepr fpp
    x
      show TypeMap a
    UnicodeTypeMap           = String
    "UnicodeTypeMap"
      show (TypeMap a
    ComplexToStructTypeMap) = String
    "ComplexToStructTypeMap"
      show TypeMap a
    ComplexToArrayTypeMap    = String
    "ComplexToArrayTypeMap"
      show (PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    ctx TypeMap tp
    a) = String
    "PrimArrayTypeMap " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Assignment TypeMap (idxl ::> idx) -> String
    forall k (f :: k -> Type) (tp :: k). ShowF f => f tp -> String
    forall (tp :: Ctx BaseType). Assignment TypeMap tp -> String
    showF Assignment TypeMap (idxl ::> idx)
    ctx String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TypeMap tp -> String
    forall k (f :: k -> Type) (tp :: k). ShowF f => f tp -> String
    forall (tp :: BaseType). TypeMap tp -> String
    showF TypeMap tp
    a
      show (FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    ctx TypeMap tp
    a)   = String
    "FnArrayTypeMap " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Assignment TypeMap (idxl ::> idx) -> String
    forall k (f :: k -> Type) (tp :: k). ShowF f => f tp -> String
    forall (tp :: Ctx BaseType). Assignment TypeMap tp -> String
    showF Assignment TypeMap (idxl ::> idx)
    ctx String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TypeMap tp -> String
    forall k (f :: k -> Type) (tp :: k). ShowF f => f tp -> String
    forall (tp :: BaseType). TypeMap tp -> String
    showF TypeMap tp
    a
      show (StructTypeMap Assignment TypeMap idx
    ctx)      = String
    "StructTypeMap " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Assignment TypeMap idx -> String
    forall k (f :: k -> Type) (tp :: k). ShowF f => f tp -> String
    forall (tp :: Ctx BaseType). Assignment TypeMap tp -> String
    showF Assignment TypeMap idx
    ctx

    instance Eq (TypeMap tp) where
      TypeMap tp
    x == :: TypeMap tp -> TypeMap tp -> Bool
    == TypeMap tp
    y = Maybe (tp :~: tp) -> Bool
    forall a. Maybe a -> Bool
    isJust (TypeMap tp -> TypeMap tp -> Maybe (tp :~: tp)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    TypeMap a -> TypeMap b -> Maybe (a :~: b)
    testEquality TypeMap tp
    x TypeMap tp
    y)

    instance TestEquality TypeMap where
      testEquality :: forall (a :: BaseType) (b :: BaseType).
    TypeMap a -> TypeMap b -> Maybe (a :~: b)
    testEquality TypeMap a
    BoolTypeMap TypeMap b
    BoolTypeMap = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      testEquality TypeMap a
    IntegerTypeMap TypeMap b
    IntegerTypeMap = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      testEquality TypeMap a
    RealTypeMap TypeMap b
    RealTypeMap = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      testEquality TypeMap a
    UnicodeTypeMap TypeMap b
    UnicodeTypeMap = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      testEquality (FloatTypeMap FloatPrecisionRepr fpp
    x) (FloatTypeMap FloatPrecisionRepr fpp
    y) = do
        Refl <- FloatPrecisionRepr fpp
    -> FloatPrecisionRepr fpp -> Maybe (fpp :~: fpp)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: FloatPrecision) (b :: FloatPrecision).
    FloatPrecisionRepr a -> FloatPrecisionRepr b -> Maybe (a :~: b)
    testEquality FloatPrecisionRepr fpp
    x FloatPrecisionRepr fpp
    y
        return Refl
      testEquality (BVTypeMap NatRepr w
    x) (BVTypeMap NatRepr w
    y) = do
        Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
    forall (a :: Natural) (b :: Natural).
    NatRepr a -> NatRepr b -> Maybe (a :~: b)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    testEquality NatRepr w
    x NatRepr w
    y
        return Refl
      testEquality TypeMap a
    ComplexToStructTypeMap TypeMap b
    ComplexToStructTypeMap =
        (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      testEquality TypeMap a
    ComplexToArrayTypeMap TypeMap b
    ComplexToArrayTypeMap =
        (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      testEquality (PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    xa TypeMap tp
    xr) (PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    ya TypeMap tp
    yr) = do
        Refl <- Assignment TypeMap (idxl ::> idx)
    -> Assignment TypeMap (idxl ::> idx)
    -> Maybe ((idxl ::> idx) :~: (idxl ::> idx))
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: Ctx BaseType) (b :: Ctx BaseType).
    Assignment TypeMap a -> Assignment TypeMap b -> Maybe (a :~: b)
    testEquality Assignment TypeMap (idxl ::> idx)
    xa Assignment TypeMap (idxl ::> idx)
    ya
        Refl <- testEquality xr yr
        Just Refl
      testEquality (FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    xa TypeMap tp
    xr) (FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    ya TypeMap tp
    yr) = do
        Refl <- Assignment TypeMap (idxl ::> idx)
    -> Assignment TypeMap (idxl ::> idx)
    -> Maybe ((idxl ::> idx) :~: (idxl ::> idx))
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: Ctx BaseType) (b :: Ctx BaseType).
    Assignment TypeMap a -> Assignment TypeMap b -> Maybe (a :~: b)
    testEquality Assignment TypeMap (idxl ::> idx)
    xa Assignment TypeMap (idxl ::> idx)
    ya
        Refl <- testEquality xr yr
        Just Refl
      testEquality (StructTypeMap Assignment TypeMap idx
    x) (StructTypeMap Assignment TypeMap idx
    y) = do
        Refl <- Assignment TypeMap idx
    -> Assignment TypeMap idx -> Maybe (idx :~: idx)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: Ctx BaseType) (b :: Ctx BaseType).
    Assignment TypeMap a -> Assignment TypeMap b -> Maybe (a :~: b)
    testEquality Assignment TypeMap idx
    x Assignment TypeMap idx
    y
        Just Refl
      testEquality TypeMap a
    _ TypeMap b
    _ = Maybe (a :~: b)
    forall a. Maybe a
    Nothing

    semiRingTypeMap :: SR.SemiRingRepr sr -> TypeMap (SR.SemiRingBase sr)
    semiRingTypeMap :: forall (sr :: SemiRing).
    SemiRingRepr sr -> TypeMap (SemiRingBase sr)
    semiRingTypeMap SemiRingRepr sr
    SR.SemiRingIntegerRepr     = TypeMap 'BaseIntegerType
    TypeMap (SemiRingBase sr)
    IntegerTypeMap
    semiRingTypeMap SemiRingRepr sr
    SR.SemiRingRealRepr        = TypeMap 'BaseRealType
    TypeMap (SemiRingBase sr)
    RealTypeMap
    semiRingTypeMap (SR.SemiRingBVRepr BVFlavorRepr fv
    _flv NatRepr w
    w) = NatRepr w -> TypeMap (BaseBVType w)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr w
    w

    type ArrayConstantFn v
       = [Some TypeMap]
         -- ^ Type for indices
         -> Some TypeMap
         -- ^ Type for value.
         -> v
         -- ^ Constant to assign all values.
         -> v

    -- TODO, I'm not convinced it is valuable to have `SupportTermOps`
    -- be a separate class from `SMTWriter`, and I'm really not sold
    -- on the `Num` superclass constraint.

    -- | A class of values containing rational and operations.
    class Num v => SupportTermOps v where
      boolExpr :: Bool -> v

      notExpr  :: v -> v

      andAll :: [v] -> v
      orAll :: [v] -> v

      (.&&)    :: v -> v -> v
      v
    x .&& v
    y = [v] -> v
    forall v. SupportTermOps v => [v] -> v
    andAll [v
    x, v
    y]

      (.||)    :: v -> v -> v
      v
    x .|| v
    y = [v] -> v
    forall v. SupportTermOps v => [v] -> v
    orAll [v
    x, v
    y]

      -- | Compare two elements for equality.
      (.==)  :: v -> v -> v

      -- | Compare two elements for in-equality.
      (./=) :: v -> v -> v
      v
    x ./= v
    y = v -> v
    forall v. SupportTermOps v => v -> v
    notExpr (v
    x v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    .== v
    y)

      impliesExpr :: v -> v -> v
      impliesExpr v
    x v
    y = v -> v
    forall v. SupportTermOps v => v -> v
    notExpr v
    x v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    .|| v
    y

      -- | Create a let expression.  This is a "sequential" let,
      --   which is syntactic sugar for a nested series of single
      --   let bindings.  As a consequence, bound variables are in
      --   scope for the right-hand-sides of subsequent bindings.
      letExpr :: [(Text, v)] -> v -> v

      -- | Create an if-then-else expression.
      ite :: v -> v -> v -> v

      -- | Add a list of values together.
      sumExpr :: [v] -> v
      sumExpr [] = v
    0
      sumExpr (v
    h:[v]
    r) = (v -> v -> v) -> v -> [v] -> v
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl v -> v -> v
    forall a. Num a => a -> a -> a
    (+) v
    h [v]
    r

      -- | Convert an integer expression to a real.
      termIntegerToReal :: v -> v

      -- | Convert a real expression to an integer.
      termRealToInteger :: v -> v

      -- | Convert an integer to a term.
      integerTerm :: Integer -> v

      -- | Convert a rational to a term.
      rationalTerm :: Rational -> v

      -- | Less-then-or-equal
      (.<=) :: v -> v -> v

      -- | Less-then
      (.<)  :: v -> v -> v
      v
    x .< v
    y = v -> v
    forall v. SupportTermOps v => v -> v
    notExpr (v
    y v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    .<= v
    x)

      -- | Greater then
      (.>)  :: v -> v -> v
      v
    x .> v
    y = v
    y v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    .< v
    x

      -- | Greater then or equal
      (.>=) :: v -> v -> v
      v
    x .>= v
    y = v
    y v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    .<= v
    x

      -- | Integer theory terms
      intAbs :: v -> v
      intDiv :: v -> v -> v
      intMod :: v -> v -> v
      intDivisible :: v -> Natural -> v

      -- | Create expression from bitvector.
      bvTerm :: NatRepr w -> BV.BV w -> v
      bvNeg :: v -> v
      bvAdd :: v -> v -> v
      bvSub :: v -> v -> v
      bvMul :: v -> v -> v

      bvSLe :: v -> v -> v
      bvULe :: v -> v -> v

      bvSLt :: v -> v -> v
      bvULt :: v -> v -> v

      bvUDiv :: v -> v -> v
      bvURem :: v -> v -> v
      bvSDiv :: v -> v -> v
      bvSRem :: v -> v -> v

      bvAnd :: v -> v -> v
      bvOr  :: v -> v -> v
      bvXor :: v -> v -> v
      bvNot :: v -> v

      bvShl  :: v -> v -> v
      bvLshr :: v -> v -> v
      bvAshr :: v -> v -> v

      -- | Concatenate two bitvectors together.
      bvConcat :: v -> v -> v

      -- | @bvExtract w i n v@ extracts bits [i..i+n) from @v@ as a new
      -- bitvector.   @v@ must contain at least @w@ elements, and @i+n@
      -- must be less than or equal to @w@.  The result has @n@ elements.
      -- The least significant bit of @v@ should have index @0@.
      bvExtract :: NatRepr w -> Natural -> Natural -> v -> v

      -- | @bvTestBit w i x@ returns predicate that holds if bit @i@
      -- in @x@ is set to true.  @w@ should be the number of bits in @x@.
      bvTestBit :: NatRepr w -> Natural -> v -> v
      bvTestBit NatRepr w
    w Natural
    i v
    x = (NatRepr w -> Natural -> Natural -> v -> v
    forall (w :: Natural). NatRepr w -> Natural -> Natural -> v -> v
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> Natural -> v -> v
    bvExtract NatRepr w
    w Natural
    i Natural
    1 v
    x v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    .== NatRepr 1 -> BV 1 -> v
    forall (w :: Natural). NatRepr w -> BV w -> v
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr 1
    w1 (NatRepr 1 -> BV 1
    forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
    BV.one NatRepr 1
    w1))
        where w1 :: NatRepr 1
              w1 :: NatRepr 1
    w1 = NatRepr 1
    forall (n :: Natural). KnownNat n => NatRepr n
    knownNat

      bvSumExpr :: NatRepr w -> [v] -> v
      bvSumExpr NatRepr w
    w [] = NatRepr w -> BV w -> v
    forall (w :: Natural). NatRepr w -> BV w -> v
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr w
    w)
      bvSumExpr NatRepr w
    _ (v
    h:[v]
    r) = (v -> v -> v) -> v -> [v] -> v
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl v -> v -> v
    forall v. SupportTermOps v => v -> v -> v
    bvAdd v
    h [v]
    r

      floatTerm  :: FloatPrecisionRepr fpp -> BigFloat -> v

      floatNeg  :: v -> v
      floatAbs  :: v -> v
      floatSqrt :: RoundingMode -> v -> v

      floatAdd :: RoundingMode -> v -> v -> v
      floatSub :: RoundingMode -> v -> v -> v
      floatMul :: RoundingMode -> v -> v -> v
      floatDiv :: RoundingMode -> v -> v -> v
      floatRem :: v -> v -> v
      floatFMA :: RoundingMode -> v -> v -> v -> v

      floatEq   :: v -> v -> v
      floatFpEq :: v -> v -> v
      floatLe   :: v -> v -> v
      floatLt   :: v -> v -> v

      floatIsNaN      :: v -> v
      floatIsInf      :: v -> v
      floatIsZero     :: v -> v
      floatIsPos      :: v -> v
      floatIsNeg      :: v -> v
      floatIsSubnorm  :: v -> v
      floatIsNorm     :: v -> v

      floatCast       :: FloatPrecisionRepr fpp -> RoundingMode -> v -> v
      floatRound      :: RoundingMode -> v -> v
      floatFromBinary :: FloatPrecisionRepr fpp -> v -> v
      bvToFloat       :: FloatPrecisionRepr fpp -> RoundingMode -> v -> v
      sbvToFloat      :: FloatPrecisionRepr fpp -> RoundingMode -> v -> v
      realToFloat     :: FloatPrecisionRepr fpp -> RoundingMode -> v -> v
      floatToBV       :: Natural -> RoundingMode -> v -> v
      floatToSBV      :: Natural -> RoundingMode -> v -> v
      floatToReal     :: v -> v

      -- | Predicate that holds if a real number is an integer.
      realIsInteger :: v -> v

      realDiv :: v -> v -> v

      realSin :: v -> v
      realCos :: v -> v
      realTan :: v -> v

      realATan2 :: v -> v -> v

      realSinh :: v -> v
      realCosh :: v -> v
      realTanh :: v -> v

      realExp  :: v -> v
      realLog  :: v -> v

      -- | Apply the arguments to the given function.
      smtFnApp :: v -> [v] -> v

      -- | Update a function value to return a new value at the given point.
      --
      -- This may be Nothing if solver has no builtin function for update.
      smtFnUpdate :: Maybe (v -> [v] -> v -> v)
      smtFnUpdate = Maybe (v -> [v] -> v -> v)
    forall a. Maybe a
    Nothing

      -- | Function for creating a lambda term if output supports it.
      --
      -- Yices support lambda expressions, but SMTLIB2 does not.
      -- The function takes arguments and the expression.
      lambdaTerm :: Maybe ([(Text, Some TypeMap)] -> v -> v)
      lambdaTerm = Maybe ([(Text, Some TypeMap)] -> v -> v)
    forall a. Maybe a
    Nothing

      fromText :: Text -> v

    infixr 3 .&&
    infixr 2 .||
    infix 4 .==
    infix 4 ./=
    infix 4 .>
    infix 4 .>=
    infix 4 .<
    infix 4 .<=

    ------------------------------------------------------------------------
    -- Term

    structComplexRealPart :: forall h. SMTWriter h => Term h -> Term h
    structComplexRealPart :: forall h. SMTWriter h => Term h -> Term h
    structComplexRealPart Term h
    c = forall h (args :: Ctx BaseType) (tp :: BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> Index args tp -> Term h -> Term h
    structProj @h (Assignment TypeMap EmptyCtx
    forall {k} (ctx :: Ctx k) (f :: k -> Type).
    (ctx ~ EmptyCtx) =>
    Assignment f ctx
    Ctx.Empty Assignment TypeMap EmptyCtx
    -> TypeMap 'BaseRealType
    -> Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    -> TypeMap 'BaseRealType
    -> Assignment
         TypeMap ((EmptyCtx ::> 'BaseRealType) ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap) (forall (n :: Natural) (ctx :: Ctx BaseType) (r :: BaseType).
    Idx n ctx r =>
    Index ctx r
    forall {k} (n :: Natural) (ctx :: Ctx k) (r :: k).
    Idx n ctx r =>
    Index ctx r
    Ctx.natIndex @0) Term h
    c

    structComplexImagPart :: forall h. SMTWriter h => Term h -> Term h
    structComplexImagPart :: forall h. SMTWriter h => Term h -> Term h
    structComplexImagPart Term h
    c = forall h (args :: Ctx BaseType) (tp :: BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> Index args tp -> Term h -> Term h
    structProj @h (Assignment TypeMap EmptyCtx
    forall {k} (ctx :: Ctx k) (f :: k -> Type).
    (ctx ~ EmptyCtx) =>
    Assignment f ctx
    Ctx.Empty Assignment TypeMap EmptyCtx
    -> TypeMap 'BaseRealType
    -> Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    -> TypeMap 'BaseRealType
    -> Assignment
         TypeMap ((EmptyCtx ::> 'BaseRealType) ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap) (forall (n :: Natural) (ctx :: Ctx BaseType) (r :: BaseType).
    Idx n ctx r =>
    Index ctx r
    forall {k} (n :: Natural) (ctx :: Ctx k) (r :: k).
    Idx n ctx r =>
    Index ctx r
    Ctx.natIndex @1) Term h
    c

    arrayComplexRealPart :: forall h . SMTWriter h => Term h -> Term h
    arrayComplexRealPart :: forall h. SMTWriter h => Term h -> Term h
    arrayComplexRealPart Term h
    c = forall h. SMTWriter h => Term h -> [Term h] -> Term h
    arraySelect @h Term h
    c [Bool -> Term h
    forall v. SupportTermOps v => Bool -> v
    boolExpr Bool
    False]

    arrayComplexImagPart :: forall h . SMTWriter h => Term h -> Term h
    arrayComplexImagPart :: forall h. SMTWriter h => Term h -> Term h
    arrayComplexImagPart Term h
    c = forall h. SMTWriter h => Term h -> [Term h] -> Term h
    arraySelect @h Term h
    c [Bool -> Term h
    forall v. SupportTermOps v => Bool -> v
    boolExpr Bool
    True]

    app :: Builder -> [Builder] -> Builder
    app :: Builder -> [Builder] -> Builder
    app Builder
    o [] = Builder
    o
    app Builder
    o [Builder]
    args = Builder -> [Builder] -> Builder
    app_list Builder
    o [Builder]
    args

    app_list :: Builder -> [Builder] -> Builder
    app_list :: Builder -> [Builder] -> Builder
    app_list Builder
    o [Builder]
    args = Builder
    "(" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    o Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Builder] -> Builder
    forall {t}. (IsString t, Semigroup t) => [t] -> t
    go [Builder]
    args
      where go :: [t] -> t
    go [] = t
    ")"
            go (t
    f:[t]
    r) = t
    " " t -> t -> t
    forall a. Semigroup a => a -> a -> a
    <> t
    f t -> t -> t
    forall a. Semigroup a => a -> a -> a
    <> [t] -> t
    go [t]
    r

    builder_list :: [Builder] -> Builder
    builder_list :: [Builder] -> Builder
    builder_list [] = Builder
    "()"
    builder_list (Builder
    h:[Builder]
    l) = Builder -> [Builder] -> Builder
    app_list Builder
    h [Builder]
    l

    ------------------------------------------------------------------------
    -- Term

    -- | A term in the output language.
    type family Term (h :: Type) :: Type

    ------------------------------------------------------------------------
    -- SMTExpr

    -- | An expresion for the SMT solver together with information about its type.
    data SMTExpr h (tp :: BaseType) where
      SMTName :: !(TypeMap tp) -> !Text -> SMTExpr h tp
      SMTExpr :: !(TypeMap tp) -> !(Term h) -> SMTExpr h tp

    -- | Converts an SMT to a base expression.
    asBase :: SupportTermOps (Term h)
           => SMTExpr h tp
           -> Term h
    asBase :: forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase (SMTName TypeMap tp
    _ Text
    n) = Text -> Term h
    forall v. SupportTermOps v => Text -> v
    fromText Text
    n
    asBase (SMTExpr TypeMap tp
    _ Term h
    e) = Term h
    e

    smtExprType :: SMTExpr h tp -> TypeMap tp
    smtExprType :: forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType (SMTName TypeMap tp
    tp Text
    _) = TypeMap tp
    tp
    smtExprType (SMTExpr TypeMap tp
    tp Term h
    _) = TypeMap tp
    tp

    ------------------------------------------------------------------------
    -- WriterState

    -- | State for writer.
    data WriterState = WriterState { WriterState -> Word64
    _nextTermIdx :: !Word64
                                   , WriterState -> Position
    _lastPosition :: !Position
                                   , WriterState -> Position
    _position     :: !Position
                                   }

    -- | The next index to use in dynamically generating a variable name.
    nextTermIdx :: Lens' WriterState Word64
    nextTermIdx :: Lens' WriterState Word64
    nextTermIdx = (WriterState -> Word64)
    -> (WriterState -> Word64 -> WriterState)
    -> Lens' WriterState Word64
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens WriterState -> Word64
    _nextTermIdx (\WriterState
    s Word64
    v -> WriterState
    s { _nextTermIdx = v })

    -- | Last position written to file.
    lastPosition :: Lens' WriterState Position
    lastPosition :: Lens' WriterState Position
    lastPosition = (WriterState -> Position)
    -> (WriterState -> Position -> WriterState)
    -> Lens' WriterState Position
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens WriterState -> Position
    _lastPosition (\WriterState
    s Position
    v -> WriterState
    s { _lastPosition = v })

    -- | Position written to file.
    position :: Lens' WriterState Position
    position :: Lens' WriterState Position
    position = (WriterState -> Position)
    -> (WriterState -> Position -> WriterState)
    -> Lens' WriterState Position
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens WriterState -> Position
    _position (\WriterState
    s Position
    v -> WriterState
    s { _position = v })

    emptyState :: WriterState
    emptyState :: WriterState
    emptyState = WriterState { _nextTermIdx :: Word64
    _nextTermIdx     = Word64
    0
                             , _lastPosition :: Position
    _lastPosition = Position
    InternalPos
                             , _position :: Position
    _position     = Position
    InternalPos
                             }

    -- | Create a new variable
    --
    -- Variable names have a prefix, an exclamation mark and a unique number.
    -- The MSS system ensures that no
    freshVarName :: State WriterState Text
    freshVarName :: State WriterState Text
    freshVarName = Builder -> State WriterState Text
    freshVarName' Builder
    "x!"

    -- | Create a new variable
    --
    -- Variable names have a prefix, an exclamation mark and a unique number.
    -- The MSS system ensures that no
    freshVarName' :: Builder -> State WriterState Text
    freshVarName' :: Builder -> State WriterState Text
    freshVarName' Builder
    prefix = do
      n <- Getting Word64 WriterState Word64
    -> StateT WriterState Identity Word64
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    use Getting Word64 WriterState Word64
    Lens' WriterState Word64
    nextTermIdx
      nextTermIdx += 1
      return $! (Lazy.toStrict $ Builder.toLazyText $ prefix <> Builder.decimal n)

    ------------------------------------------------------------------------
    -- SMTWriter

    data SMTSymFn ctx where
      SMTSymFn :: !Text
               -> !(Ctx.Assignment TypeMap args)
               -> !(TypeMap ret)
               -> SMTSymFn (args Ctx.::> ret)

    data StackEntry t (h :: Type) = StackEntry
      { forall t h. StackEntry t h -> IdxCache t (SMTExpr h)
    symExprCache :: !(IdxCache t (SMTExpr h))
      , forall t h.
    StackEntry t h -> HashTable RealWorld (Nonce t) SMTSymFn
    symFnCache :: !(PH.HashTable PH.RealWorld (Nonce t) SMTSymFn)
      }

    -- The writer connection maintains a connection to the SMT solver.
    --
    -- It is responsible for knowing the capabilities of the solver; generating
    -- fresh names when needed; maintaining the stack of pushes and pops, and
    -- sending queries to the solver.
    --
    -- A WriterConn should be used in a single-threaded manner or using external
    -- synchronization to ensure that only one thread is accessing this connection
    -- at a time, otherwise race conditions and unpredictable results may occur.
    data WriterConn t (h :: Type) =
      WriterConn { forall t h. WriterConn t h -> String
    smtWriterName :: !String
                   -- ^ Name of writer for error reporting purposes.

                 , forall t h. WriterConn t h -> OutputStream Text
    connHandle :: !(OutputStream Text)
                   -- ^ Handle to write to

                 , forall t h. WriterConn t h -> InputStream Text
    connInputHandle :: !(InputStream Text)
                   -- ^ Handle to read responses from.  In some contexts, there
                   --   are no responses expected (e.g., if we are writing a problem
                   --   directly to a file); in these cases, the input stream might
                   --   be the trivial stream @nullInput@, which just immediately
                   --   returns EOF.

                 , forall t h. WriterConn t h -> Bool
    supportFunctionDefs :: !Bool
                   -- ^ Indicates if the writer can define constants or functions in terms
                   -- of an expression.
                   --
                   -- If this is not supported, we can only declare free variables, and
                   -- assert that they are equal.
                 , forall t h. WriterConn t h -> Bool
    supportFunctionArguments :: !Bool
                   -- ^ Functions may be passed as arguments to other functions.
                   --
                   -- We currently never allow SMT_FnType to appear in structs or array
                   -- indices.
                 , forall t h. WriterConn t h -> Bool
    supportQuantifiers :: !Bool
                   -- ^ Allow the SMT writer to generate problems with quantifiers.
                 , forall t h. WriterConn t h -> ResponseStrictness
    strictParsing :: !ResponseStrictness
                   -- ^ Be strict in parsing SMTLib2 responses; no
                   -- verbosity or variants allowed
                 , forall t h. WriterConn t h -> ProblemFeatures
    supportedFeatures :: !ProblemFeatures
                   -- ^ Indicates features supported by the solver.
                 , forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack :: !(IORef [StackEntry t h])
                   -- ^ A stack of pairs of hash tables, each stack entry corresponding to
                   --   a lexical scope induced by frame push/pops. The entire stack is searched
                   --   top-down when looking up element nonce values. Elements that are to
                   --   persist across pops are written through the entire stack.
                 , forall t h. WriterConn t h -> IORef WriterState
    stateRef :: !(IORef WriterState)
                   -- ^ Reference to current state
                 , forall t h. WriterConn t h -> SymbolVarBimap t
    varBindings :: !(SymbolVarBimap t)
                   -- ^ Symbol variables.
                 , forall t h. WriterConn t h -> h
    connState :: !h
                   -- ^ The specific connection information.
                 , forall t h. WriterConn t h -> AcknowledgementAction t h
    consumeAcknowledgement :: AcknowledgementAction t h
                   -- ^ Consume an acknowledgement notifications the solver, if
                   --   it produces one
                 }

    -- | An action for consuming an acknowledgement message from the solver,
    --   if it is configured to produce ack messages.
    newtype AcknowledgementAction t h =
      AckAction { forall t h.
    AcknowledgementAction t h -> WriterConn t h -> Command h -> IO ()
    runAckAction :: WriterConn t h -> Command h -> IO () }

    -- | An acknowledgement action that does nothing
    nullAcknowledgementAction :: AcknowledgementAction t h
    nullAcknowledgementAction :: forall t h. AcknowledgementAction t h
    nullAcknowledgementAction = (WriterConn t h -> Command h -> IO ()) -> AcknowledgementAction t h
    forall t h.
    (WriterConn t h -> Command h -> IO ()) -> AcknowledgementAction t h
    AckAction (\WriterConn t h
    _ Command h
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ())

    newStackEntry :: IO (StackEntry t h)
    newStackEntry :: forall t h. IO (StackEntry t h)
    newStackEntry = do
      exprCache <- IO (IdxCache t (SMTExpr h))
    forall (m :: Type -> Type) t (f :: BaseType -> Type).
    MonadIO m =>
    m (IdxCache t f)
    newIdxCache
      fnCache   <- stToIO $ PH.new
      return StackEntry
        { symExprCache = exprCache
        , symFnCache   = fnCache
        }

    -- | Clear the entry stack, and start with a fresh one.
    resetEntryStack :: WriterConn t h -> IO ()
    resetEntryStack :: forall t h. WriterConn t h -> IO ()
    resetEntryStack WriterConn t h
    c = do
      entry <- IO (StackEntry t h)
    forall t h. IO (StackEntry t h)
    newStackEntry
      writeIORef (entryStack c) [entry]

    -- | Pop all but the topmost stack entry.
    --   Return the number of entries on the stack prior
    --   to popping.
    popEntryStackToTop :: WriterConn t h -> IO Int
    popEntryStackToTop :: forall t h. WriterConn t h -> IO Int
    popEntryStackToTop WriterConn t h
    c = do
      stk <- IORef [StackEntry t h] -> IO [StackEntry t h]
    forall a. IORef a -> IO a
    readIORef (WriterConn t h -> IORef [StackEntry t h]
    forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack WriterConn t h
    c)
      if null stk then
        do entry <- newStackEntry
           writeIORef (entryStack c) [entry]
           return 0
      else
        do writeIORef (entryStack c) [last stk]
           return (length stk)

    -- | Return the number of pushed stack frames.  Note, this is one
    --   fewer than the number of entries in the stack beacuse the
    --   base entry is the top-level context that is not in the scope
    --   of any push.
    entryStackHeight :: WriterConn t h -> IO Int
    entryStackHeight :: forall t h. WriterConn t h -> IO Int
    entryStackHeight WriterConn t h
    c =
      do es <- IORef [StackEntry t h] -> IO [StackEntry t h]
    forall a. IORef a -> IO a
    readIORef (WriterConn t h -> IORef [StackEntry t h]
    forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack WriterConn t h
    c)
         return (length es - 1)

    -- | Push a new frame to the stack for maintaining the writer cache.
    pushEntryStack :: WriterConn t h -> IO ()
    pushEntryStack :: forall t h. WriterConn t h -> IO ()
    pushEntryStack WriterConn t h
    c = do
      entry <- IO (StackEntry t h)
    forall t h. IO (StackEntry t h)
    newStackEntry
      modifyIORef' (entryStack c) $ (entry:)

    popEntryStack :: WriterConn t h -> IO ()
    popEntryStack :: forall t h. WriterConn t h -> IO ()
    popEntryStack WriterConn t h
    c = do
      stk <- IORef [StackEntry t h] -> IO [StackEntry t h]
    forall a. IORef a -> IO a
    readIORef (WriterConn t h -> IORef [StackEntry t h]
    forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack WriterConn t h
    c)
      case stk of
       []  -> String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "Could not pop from empty entry stack."
       [StackEntry t h
    _] -> String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "Could not pop from empty entry stack."
       (StackEntry t h
    _:[StackEntry t h]
    r) -> IORef [StackEntry t h] -> [StackEntry t h] -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (WriterConn t h -> IORef [StackEntry t h]
    forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack WriterConn t h
    c) [StackEntry t h]
    r

    newWriterConn :: OutputStream Text
                  -- ^ Stream to write queries onto
                  -> InputStream Text
                  -- ^ Input stream to read responses from
                  --   (may be the @nullInput@ stream if no responses are expected)
                  -> AcknowledgementAction t cs
                  -- ^ An action to consume solver acknowledgement responses
                  -> String
                  -- ^ Name of solver for reporting purposes.
                  -> ResponseStrictness
                  -- ^ Be strict in parsing responses?
                  -> ProblemFeatures
                  -- ^ Indicates what features are supported by the solver.
                  -> SymbolVarBimap t
                  -- ^ A bijective mapping between variables and their
                  -- canonical name (if any).
                  -> cs -- ^ State information specific to the type of connection
                  -> IO (WriterConn t cs)
    newWriterConn :: forall t cs.
    OutputStream Text
    -> InputStream Text
    -> AcknowledgementAction t cs
    -> String
    -> ResponseStrictness
    -> ProblemFeatures
    -> SymbolVarBimap t
    -> cs
    -> IO (WriterConn t cs)
    newWriterConn OutputStream Text
    h InputStream Text
    in_h AcknowledgementAction t cs
    ack String
    solver_name ResponseStrictness
    beStrict ProblemFeatures
    features SymbolVarBimap t
    bindings cs
    cs = do
      entry <- IO (StackEntry t cs)
    forall t h. IO (StackEntry t h)
    newStackEntry
      stk_ref <- newIORef [entry]
      r <- newIORef emptyState
      return $! WriterConn { smtWriterName = solver_name
                           , connHandle    = h
                           , connInputHandle = in_h
                           , supportFunctionDefs      = False
                           , supportFunctionArguments = False
                           , supportQuantifiers       = False
                           , strictParsing            = beStrict
                           , supportedFeatures        = features
                           , entryStack   = stk_ref
                           , stateRef     = r
                           , varBindings  = bindings
                           , connState    = cs
                           , consumeAcknowledgement = ack
                           }

    -- | Strictness level for parsing solver responses.
    data ResponseStrictness
      = Lenient  -- ^ allows other output preceeding recognized solver responses
      | Strict   -- ^ parse _only_ recognized solver responses; fail on anything else
      deriving (ResponseStrictness -> ResponseStrictness -> Bool
    (ResponseStrictness -> ResponseStrictness -> Bool)
    -> (ResponseStrictness -> ResponseStrictness -> Bool)
    -> Eq ResponseStrictness
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ResponseStrictness -> ResponseStrictness -> Bool
    == :: ResponseStrictness -> ResponseStrictness -> Bool
    $c/= :: ResponseStrictness -> ResponseStrictness -> Bool
    /= :: ResponseStrictness -> ResponseStrictness -> Bool
    Eq, Int -> ResponseStrictness -> String -> String
    [ResponseStrictness] -> String -> String
    ResponseStrictness -> String
    (Int -> ResponseStrictness -> String -> String)
    -> (ResponseStrictness -> String)
    -> ([ResponseStrictness] -> String -> String)
    -> Show ResponseStrictness
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ResponseStrictness -> String -> String
    showsPrec :: Int -> ResponseStrictness -> String -> String
    $cshow :: ResponseStrictness -> String
    show :: ResponseStrictness -> String
    $cshowList :: [ResponseStrictness] -> String -> String
    showList :: [ResponseStrictness] -> String -> String
    Show)

    -- | Given an optional override configuration option, return the SMT
    -- response parsing strictness that should be applied based on the
    -- override or thedefault strictSMTParsing configuration.
    parserStrictness :: Maybe (CFG.ConfigOption BaseBoolType)
                     -> CFG.ConfigOption BaseBoolType
                     -> CFG.Config
                     -> IO ResponseStrictness
    parserStrictness :: Maybe (ConfigOption BaseBoolType)
    -> ConfigOption BaseBoolType -> Config -> IO ResponseStrictness
    parserStrictness Maybe (ConfigOption BaseBoolType)
    overrideOpt ConfigOption BaseBoolType
    strictOpt Config
    cfg = do
      ovr <- case Maybe (ConfigOption BaseBoolType)
    overrideOpt of
               Maybe (ConfigOption BaseBoolType)
    Nothing -> Maybe Bool -> IO (Maybe Bool)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe Bool
    forall a. Maybe a
    Nothing
               Just ConfigOption BaseBoolType
    o -> OptionSetting BaseBoolType -> IO (Maybe Bool)
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> IO (Maybe a)
    CFG.getMaybeOpt (OptionSetting BaseBoolType -> IO (Maybe Bool))
    -> IO (OptionSetting BaseBoolType) -> IO (Maybe Bool)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ConfigOption BaseBoolType
    -> Config -> IO (OptionSetting BaseBoolType)
    forall (tp :: BaseType).
    ConfigOption tp -> Config -> IO (OptionSetting tp)
    CFG.getOptionSetting ConfigOption BaseBoolType
    o Config
    cfg
      optval <- case ovr of
                  Just Bool
    v -> Maybe Bool -> IO (Maybe Bool)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    v
                  Maybe Bool
    Nothing -> OptionSetting BaseBoolType -> IO (Maybe Bool)
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> IO (Maybe a)
    CFG.getMaybeOpt (OptionSetting BaseBoolType -> IO (Maybe Bool))
    -> IO (OptionSetting BaseBoolType) -> IO (Maybe Bool)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ConfigOption BaseBoolType
    -> Config -> IO (OptionSetting BaseBoolType)
    forall (tp :: BaseType).
    ConfigOption tp -> Config -> IO (OptionSetting tp)
    CFG.getOptionSetting ConfigOption BaseBoolType
    strictOpt Config
    cfg
      return $ maybe Strict (\Bool
    c -> if Bool
    c then ResponseStrictness
    Strict else ResponseStrictness
    Lenient) optval

    -- | Status to indicate when term value will be uncached.
    data TermLifetime
       = DeleteNever
         -- ^ Never delete the term
       | DeleteOnPop
         -- ^ Delete the term when the current frame is popped.
      deriving (TermLifetime -> TermLifetime -> Bool
    (TermLifetime -> TermLifetime -> Bool)
    -> (TermLifetime -> TermLifetime -> Bool) -> Eq TermLifetime
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TermLifetime -> TermLifetime -> Bool
    == :: TermLifetime -> TermLifetime -> Bool
    $c/= :: TermLifetime -> TermLifetime -> Bool
    /= :: TermLifetime -> TermLifetime -> Bool
    Eq)

    cacheValue
      :: WriterConn t h
      -> TermLifetime
      -> (StackEntry t h -> IO ())
      -> IO ()
    cacheValue :: forall t h.
    WriterConn t h
    -> TermLifetime -> (StackEntry t h -> IO ()) -> IO ()
    cacheValue WriterConn t h
    conn TermLifetime
    lifetime StackEntry t h -> IO ()
    insert_action =
      IORef [StackEntry t h] -> IO [StackEntry t h]
    forall a. IORef a -> IO a
    readIORef (WriterConn t h -> IORef [StackEntry t h]
    forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack WriterConn t h
    conn) IO [StackEntry t h] -> ([StackEntry t h] -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        s :: [StackEntry t h]
    s@(StackEntry t h
    h:[StackEntry t h]
    _) -> case TermLifetime
    lifetime of
          TermLifetime
    DeleteOnPop -> StackEntry t h -> IO ()
    insert_action StackEntry t h
    h
          TermLifetime
    DeleteNever -> (StackEntry t h -> IO ()) -> [StackEntry t h] -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ StackEntry t h -> IO ()
    insert_action [StackEntry t h]
    s
        [] -> String -> IO ()
    forall a. HasCallStack => String -> a
    error String
    "cacheValue: empty cache stack!"

    cacheLookup
      :: WriterConn t h
      -> (StackEntry t h -> IO (Maybe a))
      -> IO (Maybe a)
    cacheLookup :: forall t h a.
    WriterConn t h -> (StackEntry t h -> IO (Maybe a)) -> IO (Maybe a)
    cacheLookup WriterConn t h
    conn StackEntry t h -> IO (Maybe a)
    lookup_action =
      IORef [StackEntry t h] -> IO [StackEntry t h]
    forall a. IORef a -> IO a
    readIORef (WriterConn t h -> IORef [StackEntry t h]
    forall t h. WriterConn t h -> IORef [StackEntry t h]
    entryStack WriterConn t h
    conn) IO [StackEntry t h]
    -> ([StackEntry t h] -> IO (Maybe a)) -> IO (Maybe a)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (StackEntry t h -> IO (Maybe a))
    -> [StackEntry t h] -> IO (Maybe a)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m (Maybe b)) -> [a] -> m (Maybe b)
    firstJustM StackEntry t h -> IO (Maybe a)
    lookup_action

    -- | Like 'findM', but also allows you to compute some additional information in the predicate.
    firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
    firstJustM :: forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m (Maybe b)) -> [a] -> m (Maybe b)
    firstJustM a -> m (Maybe b)
    _ [] = Maybe b -> m (Maybe b)
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe b
    forall a. Maybe a
    Nothing
    firstJustM a -> m (Maybe b)
    p (a
    x:[a]
    xs) = m (Maybe b) -> (b -> m (Maybe b)) -> m (Maybe b) -> m (Maybe b)
    forall (m :: Type -> Type) b a.
    Monad m =>
    m b -> (a -> m b) -> m (Maybe a) -> m b
    maybeM ((a -> m (Maybe b)) -> [a] -> m (Maybe b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m (Maybe b)) -> [a] -> m (Maybe b)
    firstJustM a -> m (Maybe b)
    p [a]
    xs) (Maybe b -> m (Maybe b)
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Maybe b -> m (Maybe b)) -> (b -> Maybe b) -> b -> m (Maybe b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> Maybe b
    forall a. a -> Maybe a
    Just) (a -> m (Maybe b)
    p a
    x)
    {-# INLINE firstJustM #-}

    -- | Monadic generalisation of 'maybe'.
    maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
    maybeM :: forall (m :: Type -> Type) b a.
    Monad m =>
    m b -> (a -> m b) -> m (Maybe a) -> m b
    maybeM m b
    n a -> m b
    j m (Maybe a)
    x = m b -> (a -> m b) -> Maybe a -> m b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m b
    n a -> m b
    j (Maybe a -> m b) -> m (Maybe a) -> m b
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< m (Maybe a)
    x
    {-# INLINE maybeM #-}

    -- | Like 'when', but where the test can be monadic.
    whenM :: Monad m => m Bool -> m () -> m ()
    whenM :: forall (m :: Type -> Type). Monad m => m Bool -> m () -> m ()
    whenM m Bool
    b m ()
    t = do b' <- m Bool
    b; when b' t
    {-# INLINE whenM #-}

    cacheLookupExpr :: WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    cacheLookupExpr :: forall t h (tp :: BaseType).
    WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    cacheLookupExpr WriterConn t h
    c Nonce t tp
    n = WriterConn t h
    -> (StackEntry t h -> IO (Maybe (SMTExpr h tp)))
    -> IO (Maybe (SMTExpr h tp))
    forall t h a.
    WriterConn t h -> (StackEntry t h -> IO (Maybe a)) -> IO (Maybe a)
    cacheLookup WriterConn t h
    c ((StackEntry t h -> IO (Maybe (SMTExpr h tp)))
     -> IO (Maybe (SMTExpr h tp)))
    -> (StackEntry t h -> IO (Maybe (SMTExpr h tp)))
    -> IO (Maybe (SMTExpr h tp))
    forall a b. (a -> b) -> a -> b
    $ \StackEntry t h
    entry ->
      IdxCache t (SMTExpr h) -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    forall (m :: Type -> Type) t (f :: BaseType -> Type)
           (tp :: BaseType).
    MonadIO m =>
    IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
    lookupIdx (StackEntry t h -> IdxCache t (SMTExpr h)
    forall t h. StackEntry t h -> IdxCache t (SMTExpr h)
    symExprCache StackEntry t h
    entry) Nonce t tp
    n

    cacheLookupFn :: WriterConn t h -> Nonce t ctx -> IO (Maybe (SMTSymFn ctx))
    cacheLookupFn :: forall t h (ctx :: Ctx BaseType).
    WriterConn t h -> Nonce t ctx -> IO (Maybe (SMTSymFn ctx))
    cacheLookupFn WriterConn t h
    c Nonce t ctx
    n = WriterConn t h
    -> (StackEntry t h -> IO (Maybe (SMTSymFn ctx)))
    -> IO (Maybe (SMTSymFn ctx))
    forall t h a.
    WriterConn t h -> (StackEntry t h -> IO (Maybe a)) -> IO (Maybe a)
    cacheLookup WriterConn t h
    c ((StackEntry t h -> IO (Maybe (SMTSymFn ctx)))
     -> IO (Maybe (SMTSymFn ctx)))
    -> (StackEntry t h -> IO (Maybe (SMTSymFn ctx)))
    -> IO (Maybe (SMTSymFn ctx))
    forall a b. (a -> b) -> a -> b
    $ \StackEntry t h
    entry ->
      ST RealWorld (Maybe (SMTSymFn ctx)) -> IO (Maybe (SMTSymFn ctx))
    forall a. ST RealWorld a -> IO a
    stToIO (ST RealWorld (Maybe (SMTSymFn ctx)) -> IO (Maybe (SMTSymFn ctx)))
    -> ST RealWorld (Maybe (SMTSymFn ctx)) -> IO (Maybe (SMTSymFn ctx))
    forall a b. (a -> b) -> a -> b
    $ HashTable RealWorld (Nonce t) SMTSymFn
    -> Nonce t ctx -> ST RealWorld (Maybe (SMTSymFn ctx))
    forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
    (HashableF key, TestEquality key) =>
    HashTable s key val -> key tp -> ST s (Maybe (val tp))
    PH.lookup (StackEntry t h -> HashTable RealWorld (Nonce t) SMTSymFn
    forall t h.
    StackEntry t h -> HashTable RealWorld (Nonce t) SMTSymFn
    symFnCache StackEntry t h
    entry) Nonce t ctx
    n

    cacheValueExpr
      :: WriterConn t h -> Nonce t tp -> TermLifetime -> SMTExpr h tp -> IO ()
    cacheValueExpr :: forall t h (tp :: BaseType).
    WriterConn t h
    -> Nonce t tp -> TermLifetime -> SMTExpr h tp -> IO ()
    cacheValueExpr WriterConn t h
    conn Nonce t tp
    n TermLifetime
    lifetime SMTExpr h tp
    value = WriterConn t h
    -> TermLifetime -> (StackEntry t h -> IO ()) -> IO ()
    forall t h.
    WriterConn t h
    -> TermLifetime -> (StackEntry t h -> IO ()) -> IO ()
    cacheValue WriterConn t h
    conn TermLifetime
    lifetime ((StackEntry t h -> IO ()) -> IO ())
    -> (StackEntry t h -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \StackEntry t h
    entry ->
      IdxCache t (SMTExpr h) -> Nonce t tp -> SMTExpr h tp -> IO ()
    forall (m :: Type -> Type) t (f :: BaseType -> Type)
           (tp :: BaseType).
    MonadIO m =>
    IdxCache t f -> Nonce t tp -> f tp -> m ()
    insertIdxValue (StackEntry t h -> IdxCache t (SMTExpr h)
    forall t h. StackEntry t h -> IdxCache t (SMTExpr h)
    symExprCache StackEntry t h
    entry) Nonce t tp
    n SMTExpr h tp
    value

    cacheValueFn
      :: WriterConn t h -> Nonce t ctx -> TermLifetime -> SMTSymFn ctx -> IO ()
    cacheValueFn :: forall t h (ctx :: Ctx BaseType).
    WriterConn t h
    -> Nonce t ctx -> TermLifetime -> SMTSymFn ctx -> IO ()
    cacheValueFn WriterConn t h
    conn Nonce t ctx
    n TermLifetime
    lifetime SMTSymFn ctx
    value = WriterConn t h
    -> TermLifetime -> (StackEntry t h -> IO ()) -> IO ()
    forall t h.
    WriterConn t h
    -> TermLifetime -> (StackEntry t h -> IO ()) -> IO ()
    cacheValue WriterConn t h
    conn TermLifetime
    lifetime ((StackEntry t h -> IO ()) -> IO ())
    -> (StackEntry t h -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \StackEntry t h
    entry ->
      ST RealWorld () -> IO ()
    forall a. ST RealWorld a -> IO a
    stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ HashTable RealWorld (Nonce t) SMTSymFn
    -> Nonce t ctx -> SMTSymFn ctx -> ST RealWorld ()
    forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
    (HashableF key, TestEquality key) =>
    HashTable s key val -> key tp -> val tp -> ST s ()
    PH.insert (StackEntry t h -> HashTable RealWorld (Nonce t) SMTSymFn
    forall t h.
    StackEntry t h -> HashTable RealWorld (Nonce t) SMTSymFn
    symFnCache StackEntry t h
    entry) Nonce t ctx
    n SMTSymFn ctx
    value

    -- | Construct a function/name bimap. Each function is associated with its
    -- cached name if there is one, otherwise with its original name.
    cacheLookupFnNameBimap :: WriterConn t h -> [SomeExprSymFn t] -> IO (Bimap (SomeExprSymFn t) Text)
    cacheLookupFnNameBimap :: forall t h.
    WriterConn t h
    -> [SomeExprSymFn t] -> IO (Bimap (SomeExprSymFn t) Text)
    cacheLookupFnNameBimap WriterConn t h
    conn [SomeExprSymFn t]
    fns = [(SomeExprSymFn t, Text)] -> Bimap (SomeExprSymFn t) Text
    forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
    Bimap.fromList ([(SomeExprSymFn t, Text)] -> Bimap (SomeExprSymFn t) Text)
    -> IO [(SomeExprSymFn t, Text)]
    -> IO (Bimap (SomeExprSymFn t) Text)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (SomeExprSymFn t -> IO (SomeExprSymFn t, Text))
    -> [SomeExprSymFn t] -> IO [(SomeExprSymFn t, Text)]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM
      (\some_fn :: SomeExprSymFn t
    some_fn@(SomeExprSymFn ExprSymFn t args ret
    fn) -> do
        maybe_smt_sym_fn <- WriterConn t h
    -> Nonce t (args ::> ret) -> IO (Maybe (SMTSymFn (args ::> ret)))
    forall t h (ctx :: Ctx BaseType).
    WriterConn t h -> Nonce t ctx -> IO (Maybe (SMTSymFn ctx))
    cacheLookupFn WriterConn t h
    conn (Nonce t (args ::> ret) -> IO (Maybe (SMTSymFn (args ::> ret))))
    -> Nonce t (args ::> ret) -> IO (Maybe (SMTSymFn (args ::> ret)))
    forall a b. (a -> b) -> a -> b
    $ ExprSymFn t args ret -> Nonce t (args ::> ret)
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> Nonce t (args ::> ret)
    symFnId ExprSymFn t args ret
    fn
        return $ case maybe_smt_sym_fn of
          Just (SMTSymFn Text
    nm Assignment TypeMap args
    _ TypeMap ret
    _) -> (SomeExprSymFn t
    some_fn, Text
    nm)
          Maybe (SMTSymFn (args ::> ret))
    Nothing -> (SomeExprSymFn t
    some_fn, SolverSymbol -> Text
    solverSymbolAsText (SolverSymbol -> Text) -> SolverSymbol -> Text
    forall a b. (a -> b) -> a -> b
    $ ExprSymFn t args ret -> SolverSymbol
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SolverSymbol
    symFnName ExprSymFn t args ret
    fn))
      [SomeExprSymFn t]
    fns

    -- | Run state with handle.
    withWriterState :: WriterConn t h -> State WriterState a -> IO a
    withWriterState :: forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    c State WriterState a
    m = do
      s0 <- IORef WriterState -> IO WriterState
    forall a. IORef a -> IO a
    readIORef (WriterConn t h -> IORef WriterState
    forall t h. WriterConn t h -> IORef WriterState
    stateRef WriterConn t h
    c)
      let (v,s) = runState m s0
      writeIORef (stateRef c) $! s
      return v

    -- | Update the current program location to the given one.
    updateProgramLoc :: WriterConn t h -> ProgramLoc -> IO ()
    updateProgramLoc :: forall t h. WriterConn t h -> ProgramLoc -> IO ()
    updateProgramLoc WriterConn t h
    c ProgramLoc
    l = WriterConn t h -> StateT WriterState Identity () -> IO ()
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    c (StateT WriterState Identity () -> IO ())
    -> StateT WriterState Identity () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Position -> Identity Position)
    -> WriterState -> Identity WriterState
    Lens' WriterState Position
    position ((Position -> Identity Position)
     -> WriterState -> Identity WriterState)
    -> Position -> StateT WriterState Identity ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= ProgramLoc -> Position
    plSourceLoc ProgramLoc
    l

    type family Command (h :: Type) :: Type

    -- | Typeclass need to generate SMTLIB commands.
    class (SupportTermOps (Term h)) => SMTWriter h where

      -- | Create a forall expression
      forallExpr :: [(Text, Some TypeMap)] -> Term h -> Term h

      -- | Create an exists expression
      existsExpr :: [(Text, Some TypeMap)] -> Term h -> Term h

      -- | Create a constant array
      --
      -- This may return Nothing if the solver does not support constant arrays.
      arrayConstant :: Maybe (ArrayConstantFn (Term h))
      arrayConstant = Maybe (ArrayConstantFn (Term h))
    forall a. Maybe a
    Nothing

      -- | Select an element from an array
      arraySelect :: Term h -> [Term h] -> Term h

      -- | 'arrayUpdate a i v' returns an array that contains value 'v' at
      -- index 'i', and the same value as in 'a' at every other index.
      arrayUpdate :: Term h -> [Term h] -> Term h -> Term h

      -- | Create a command that just defines a comment.
      commentCommand :: f h -> Builder -> Command h

      -- | Create a command that asserts a formula.
      assertCommand :: f h -> Term h -> Command h

      -- | Create a command that asserts a formula and attaches
      --   the given name to it (primarily for the purposes of
      --   later reporting unsatisfiable cores).
      assertNamedCommand :: f h -> Term h -> Text -> Command h

      -- | Generates command @(push 1)@ that opens the corresponding assertion frame
      pushCommand   :: f h -> Command h

      -- | Generates command @(pop 1)@ that closes the corresponding assertion frame
      popCommand    :: f h -> Command h

      -- | Generates command @(push 2)@ that opens the corresponding assertion frame
      push2Command   :: f h -> Command h

      -- | Generates command @(pop 2)@ that closes the corresponding assertion frame, used for abduction
      pop2Command    :: f h -> Command h

      -- | Pop several scopes.
      popManyCommands :: f h -> Int -> [Command h]
      popManyCommands f h
    w Int
    n = Int -> Command h -> [Command h]
    forall a. Int -> a -> [a]
    replicate Int
    n (f h -> Command h
    forall h (f :: Type -> Type). SMTWriter h => f h -> Command h
    forall (f :: Type -> Type). f h -> Command h
    popCommand f h
    w)

      -- | Reset the solver state, forgetting all pushed frames and assertions
      resetCommand  :: f h -> Command h

      -- | Check if the current set of assumption is satisfiable. May
      -- require multiple commands. The intial commands require an ack. The
      -- last one does not.
      checkCommands  :: f h -> [Command h]

      -- | Check if a collection of assumptions is satisfiable in the current context.
      --   The assumptions must be given as the names of literals already in scope.
      checkWithAssumptionsCommands :: f h -> [Text] -> [Command h]

      -- | Ask the solver to return an unsatisfiable core from among the assumptions
      --   passed into the previous "check with assumptions" command.
      getUnsatAssumptionsCommand :: f h -> Command h

      -- | Ask the solver to return an unsatisfiable core from among the named assumptions
      --   previously asserted using the `assertNamedCommand` after an unsatisfiable
      --   `checkCommand`.
      getUnsatCoreCommand :: f h -> Command h

      -- | Ask the solver to return an abduct
      getAbductCommand :: f h -> Text -> Term h -> Command h

      -- | Ask the solver for the next abduct, used after a get-abduct command
      getAbductNextCommand :: f h -> Command h

      -- | Set an option/parameter.
      setOptCommand :: f h -> Text -> Text -> Command h

      -- | Declare a new symbol with the given name, arguments types, and result type.
      declareCommand :: f h
                     -> Text
                     -> Ctx.Assignment TypeMap args
                     -> TypeMap rtp
                     -> Command h

      -- | Define a new symbol with the given name, arguments, result type, and
      -- associated expression.
      --
      -- The argument contains the variable name and the type of the variable.
      defineCommand :: f h
                    -> Text -- ^ Name of variable
                    -> [(Text, Some TypeMap)]
                    -> TypeMap rtp
                    -> Term h
                    -> Command h

      -- | Declare a new SyGuS function to synthesize with the given name,
      -- arguments, and result type.
      synthFunCommand :: f h
                      -> Text
                      -> [(Text, Some TypeMap)]
                      -> TypeMap tp
                      -> Command h

      -- | Declare a new SyGuS universal variables with the given name and type.
      declareVarCommand :: f h
                        -> Text
                        -> TypeMap tp
                        -> Command h

      -- | Add a SyGuS formula to the set of synthesis constraints.
      constraintCommand :: f h -> Term h -> Command h

      -- | Declare a struct datatype if is has not been already given the number of
      -- arguments in the struct.
      declareStructDatatype :: WriterConn t h -> Ctx.Assignment TypeMap args -> IO ()

      -- | Build a struct term with the given types and fields
      structCtor :: Ctx.Assignment TypeMap args -> [Term h] -> Term h

      -- | Project a field from a struct with the given types
      structProj :: Ctx.Assignment TypeMap args -> Ctx.Index args tp -> Term h -> Term h

      -- | Produce a term representing a string literal
      stringTerm :: Text -> Term h

      -- | Compute the length of a term
      stringLength :: Term h -> Term h

      -- | @stringIndexOf s t i@ computes the first index following or at i
      --   where @t@ appears within @s@ as a substring, or -1 if no such
      --   index exists
      stringIndexOf :: Term h -> Term h -> Term h -> Term h

      -- | Test if the first string contains the second string
      stringContains :: Term h -> Term h -> Term h

      -- | Test if the first string is a prefix of the second string
      stringIsPrefixOf :: Term h -> Term h -> Term h

      -- | Test if the first string is a suffix of the second string
      stringIsSuffixOf :: Term h -> Term h -> Term h

      -- | @stringSubstring s off len@ extracts the substring of @s@ starting at index @off@ and
      --   having length @len@.  The result of this operation is undefined if @off@ and @len@
      --   to not specify a valid substring of @s@; in particular, we must have @off+len <= length(s)@.
      stringSubstring :: Term h -> Term h -> Term h -> Term h

      -- | Append the given strings
      stringAppend :: [Term h] -> Term h

      -- | Forget all previously-declared struct types.
      resetDeclaredStructs :: WriterConn t h -> IO ()

      -- | Write a command to the connection.
      writeCommand :: WriterConn t h -> Command h -> IO ()

    -- | Write a command to the connection along with position information
    -- if it differs from the last position.
    addCommand :: SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand :: forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand WriterConn t h
    conn Command h
    cmd = do
      WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommandNoAck WriterConn t h
    conn Command h
    cmd
      AcknowledgementAction t h -> WriterConn t h -> Command h -> IO ()
    forall t h.
    AcknowledgementAction t h -> WriterConn t h -> Command h -> IO ()
    runAckAction (WriterConn t h -> AcknowledgementAction t h
    forall t h. WriterConn t h -> AcknowledgementAction t h
    consumeAcknowledgement WriterConn t h
    conn) WriterConn t h
    conn Command h
    cmd

    addCommandNoAck :: SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommandNoAck :: forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommandNoAck WriterConn t h
    conn Command h
    cmd = do
      las <- WriterConn t h -> State WriterState Position -> IO Position
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Position -> IO Position)
    -> State WriterState Position -> IO Position
    forall a b. (a -> b) -> a -> b
    $ Getting Position WriterState Position -> State WriterState Position
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    use Getting Position WriterState Position
    Lens' WriterState Position
    lastPosition
      cur <- withWriterState conn $ use position

      -- If the position of the last command differs from the current position, then
      -- write the current position and update the last position.
      when (las /= cur) $ do
        writeCommand conn $ commentCommand conn $ Builder.fromText $ Text.pack $ show $ pretty cur
        withWriterState conn $ lastPosition .= cur

      writeCommand conn cmd

    -- | Write a sequence of commands. All but the last should have
    -- acknowledgement.
    addCommands :: SMTWriter h => WriterConn t h -> [Command h] -> IO ()
    addCommands :: forall h t. SMTWriter h => WriterConn t h -> [Command h] -> IO ()
    addCommands WriterConn t h
    _ [] = String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "internal: empty list in addCommands"
    addCommands WriterConn t h
    conn [Command h]
    cmds = do
      (Command h -> IO ()) -> [Command h] -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand WriterConn t h
    conn) ([Command h] -> [Command h]
    forall a. HasCallStack => [a] -> [a]
    init [Command h]
    cmds)
      WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommandNoAck WriterConn t h
    conn ([Command h] -> Command h
    forall a. HasCallStack => [a] -> a
    last [Command h]
    cmds)

    -- | Create a new variable with the given name.
    mkFreeVar :: SMTWriter h
              => WriterConn t h
              -> Ctx.Assignment TypeMap args
              -> TypeMap rtp
              -> IO Text
    mkFreeVar :: forall h t (args :: Ctx BaseType) (rtp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> Assignment TypeMap args -> TypeMap rtp -> IO Text
    mkFreeVar WriterConn t h
    conn Assignment TypeMap args
    arg_types TypeMap rtp
    return_type = do
      var <- WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ State WriterState Text
    freshVarName
      traverseFC_ (declareTypes conn) arg_types
      declareTypes conn return_type
      addCommand conn $ declareCommand conn var arg_types return_type
      return var

    mkFreeVar' :: SMTWriter h => WriterConn t h -> TypeMap tp -> IO (SMTExpr h tp)
    mkFreeVar' :: forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO (SMTExpr h tp)
    mkFreeVar' WriterConn t h
    conn TypeMap tp
    tp = TypeMap tp -> Text -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Text -> SMTExpr h tp
    SMTName TypeMap tp
    tp (Text -> SMTExpr h tp) -> IO Text -> IO (SMTExpr h tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterConn t h
    -> Assignment TypeMap EmptyCtx -> TypeMap tp -> IO Text
    forall h t (args :: Ctx BaseType) (rtp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> Assignment TypeMap args -> TypeMap rtp -> IO Text
    mkFreeVar WriterConn t h
    conn Assignment TypeMap EmptyCtx
    forall {k} (f :: k -> Type). Assignment f EmptyCtx
    Ctx.empty TypeMap tp
    tp

    -- | Consider the bound variable as free within the current assumption frame.
    bindVarAsFree :: SMTWriter h
                  => WriterConn t h
                  -> ExprBoundVar t tp
                  -> IO ()
    bindVarAsFree :: forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> ExprBoundVar t tp -> IO ()
    bindVarAsFree WriterConn t h
    conn ExprBoundVar t tp
    var = do
      WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    forall t h (tp :: BaseType).
    WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    cacheLookupExpr WriterConn t h
    conn (ExprBoundVar t tp -> Nonce t tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
    bvarId ExprBoundVar t tp
    var) IO (Maybe (SMTExpr h tp))
    -> (Maybe (SMTExpr h tp) -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just SMTExpr h tp
    _ -> String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error in SMTLIB exporter: bound variables cannot be made free."
                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Nonce t tp -> String
    forall a. Show a => a -> String
    show (ExprBoundVar t tp -> Nonce t tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
    bvarId ExprBoundVar t tp
    var) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " defined at "
                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Position -> String
    forall a. Show a => a -> String
    show (ProgramLoc -> Position
    plSourceLoc (ExprBoundVar t tp -> ProgramLoc
    forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
    bvarLoc ExprBoundVar t tp
    var)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."
        Maybe (SMTExpr h tp)
    Nothing -> do
          smt_type <- WriterConn t h -> SMTCollector t h (TypeMap tp) -> IO (TypeMap tp)
    forall h t a.
    SMTWriter h =>
    WriterConn t h -> SMTCollector t h a -> IO a
    runOnLiveConnection WriterConn t h
    conn (SMTCollector t h (TypeMap tp) -> IO (TypeMap tp))
    -> SMTCollector t h (TypeMap tp) -> IO (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $ do
            ExprBoundVar t tp -> SMTCollector t h ()
    forall n (tp :: BaseType) h.
    ExprBoundVar n tp -> SMTCollector n h ()
    checkVarTypeSupport ExprBoundVar t tp
    var
            ExprBoundVar t tp -> SMTCollector t h (TypeMap tp)
    forall t (tp :: BaseType) h.
    ExprBoundVar t tp -> SMTCollector t h (TypeMap tp)
    getBaseSMT_Type ExprBoundVar t tp
    var
          var_name <- getSymbolName conn (VarSymbolBinding var)
          declareTypes conn smt_type
          addCommand conn $ declareCommand conn var_name Ctx.empty smt_type
          cacheValueExpr conn (bvarId var) DeleteOnPop $ SMTName smt_type var_name

    -- | Assume that the given formula holds.
    assumeFormula :: SMTWriter h => WriterConn t h -> Term h -> IO ()
    assumeFormula :: forall h t. SMTWriter h => WriterConn t h -> Term h -> IO ()
    assumeFormula WriterConn t h
    c Term h
    p = WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand WriterConn t h
    c (WriterConn t h -> Term h -> Command h
    forall h (f :: Type -> Type).
    SMTWriter h =>
    f h -> Term h -> Command h
    forall (f :: Type -> Type). f h -> Term h -> Command h
    assertCommand WriterConn t h
    c Term h
    p)

    assumeFormulaWithName :: SMTWriter h => WriterConn t h -> Term h -> Text -> IO ()
    assumeFormulaWithName :: forall h t.
    SMTWriter h =>
    WriterConn t h -> Term h -> Text -> IO ()
    assumeFormulaWithName WriterConn t h
    conn Term h
    p Text
    nm =
      do Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless (WriterConn t h -> ProblemFeatures
    forall t h. WriterConn t h -> ProblemFeatures
    supportedFeatures WriterConn t h
    conn ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useUnsatCores) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
           String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 5) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 5) -> String) -> Doc (ZonkAny 5) -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc (ZonkAny 5)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) Doc (ZonkAny 5) -> Doc (ZonkAny 5) -> Doc (ZonkAny 5)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 5)
    "is not configured to produce UNSAT cores"
         WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand WriterConn t h
    conn (WriterConn t h -> Term h -> Text -> Command h
    forall h (f :: Type -> Type).
    SMTWriter h =>
    f h -> Term h -> Text -> Command h
    forall (f :: Type -> Type). f h -> Term h -> Text -> Command h
    assertNamedCommand WriterConn t h
    conn Term h
    p Text
    nm)

    assumeFormulaWithFreshName :: SMTWriter h => WriterConn t h -> Term h -> IO Text
    assumeFormulaWithFreshName :: forall h t. SMTWriter h => WriterConn t h -> Term h -> IO Text
    assumeFormulaWithFreshName WriterConn t h
    conn Term h
    p =
      do var <- WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ State WriterState Text
    freshVarName
         assumeFormulaWithName conn p var
         return var

    addSynthFun ::
      SMTWriter h =>
      WriterConn t h ->
      ExprSymFn t args ret ->
      IO ()
    addSynthFun :: forall h t (args :: Ctx BaseType) (ret :: BaseType).
    SMTWriter h =>
    WriterConn t h -> ExprSymFn t args ret -> IO ()
    addSynthFun WriterConn t h
    conn ExprSymFn t args ret
    fn =
      WriterConn t h
    -> Nonce t (args ::> ret) -> IO (Maybe (SMTSymFn (args ::> ret)))
    forall t h (ctx :: Ctx BaseType).
    WriterConn t h -> Nonce t ctx -> IO (Maybe (SMTSymFn ctx))
    cacheLookupFn WriterConn t h
    conn (ExprSymFn t args ret -> Nonce t (args ::> ret)
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> Nonce t (args ::> ret)
    symFnId ExprSymFn t args ret
    fn) IO (Maybe (SMTSymFn (args ::> ret)))
    -> (Maybe (SMTSymFn (args ::> ret)) -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just{} ->
          String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error in SMTLIB exporter: function already declared."
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Nonce t (args ::> ret) -> String
    forall a. Show a => a -> String
    show (ExprSymFn t args ret -> Nonce t (args ::> ret)
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> Nonce t (args ::> ret)
    symFnId ExprSymFn t args ret
    fn) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " declared at "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Position -> String
    forall a. Show a => a -> String
    show (ProgramLoc -> Position
    plSourceLoc (ExprSymFn t args ret -> ProgramLoc
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> ProgramLoc
    symFnLoc ExprSymFn t args ret
    fn)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."
        Maybe (SMTSymFn (args ::> ret))
    Nothing -> case ExprSymFn t args ret -> SymFnInfo t args ret
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SymFnInfo t args ret
    symFnInfo ExprSymFn t args ret
    fn of
          UninterpFnInfo Assignment BaseTypeRepr args
    arg_types BaseTypeRepr ret
    ret_type -> do
            nm <- WriterConn t h -> SymbolBinding t -> IO Text
    forall t h. WriterConn t h -> SymbolBinding t -> IO Text
    getSymbolName WriterConn t h
    conn (ExprSymFn t args ret -> SymbolBinding t
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SymbolBinding t
    FnSymbolBinding ExprSymFn t args ret
    fn)
            let fn_source = SolverSymbol -> ProgramLoc -> SMTSource (ZonkAny 6)
    forall ann. SolverSymbol -> ProgramLoc -> SMTSource ann
    fnSource (ExprSymFn t args ret -> SolverSymbol
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SolverSymbol
    symFnName ExprSymFn t args ret
    fn) (ExprSymFn t args ret -> ProgramLoc
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> ProgramLoc
    symFnLoc ExprSymFn t args ret
    fn)
            smt_arg_types <- traverseFC (evalFirstClassTypeRepr conn fn_source) arg_types
            checkArgumentTypes conn smt_arg_types
            smt_ret_type <- evalFirstClassTypeRepr conn fn_source ret_type
            traverseFC_ (declareTypes conn) smt_arg_types
            declareTypes conn smt_ret_type
            smt_args <- mapM
              (\(Some TypeMap x
    tp) -> do
                var <- WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ State WriterState Text
    freshVarName
                return (var, Some tp))
              (toListFC Some smt_arg_types)
            addCommand conn $ synthFunCommand conn nm smt_args smt_ret_type
            cacheValueFn conn (symFnId fn) DeleteNever $! SMTSymFn nm smt_arg_types smt_ret_type
          DefinedFnInfo{} ->
            String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error in SMTLIB exporter: defined functions cannot be synthesized."
          MatlabSolverFnInfo{} ->
            String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error in SMTLIB exporter: MatlabSolver functions cannot be synthesized."

    addDeclareVar ::
      SMTWriter h =>
      WriterConn t h ->
      ExprBoundVar t tp ->
      IO ()
    addDeclareVar :: forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> ExprBoundVar t tp -> IO ()
    addDeclareVar WriterConn t h
    conn ExprBoundVar t tp
    var =
      WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    forall t h (tp :: BaseType).
    WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    cacheLookupExpr WriterConn t h
    conn (ExprBoundVar t tp -> Nonce t tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
    bvarId ExprBoundVar t tp
    var) IO (Maybe (SMTExpr h tp))
    -> (Maybe (SMTExpr h tp) -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just{} ->
          String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error in SMTLIB exporter: variable already declared."
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Nonce t tp -> String
    forall a. Show a => a -> String
    show (ExprBoundVar t tp -> Nonce t tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
    bvarId ExprBoundVar t tp
    var) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " declared at "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Position -> String
    forall a. Show a => a -> String
    show (ProgramLoc -> Position
    plSourceLoc (ExprBoundVar t tp -> ProgramLoc
    forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
    bvarLoc ExprBoundVar t tp
    var)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."
        Maybe (SMTExpr h tp)
    Nothing -> do
          nm <- WriterConn t h -> SymbolBinding t -> IO Text
    forall t h. WriterConn t h -> SymbolBinding t -> IO Text
    getSymbolName WriterConn t h
    conn (ExprBoundVar t tp -> SymbolBinding t
    forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
    VarSymbolBinding ExprBoundVar t tp
    var)
          let fn_source = SolverSymbol -> ProgramLoc -> SMTSource (ZonkAny 7)
    forall ann. SolverSymbol -> ProgramLoc -> SMTSource ann
    fnSource (ExprBoundVar t tp -> SolverSymbol
    forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
    bvarName ExprBoundVar t tp
    var) (ExprBoundVar t tp -> ProgramLoc
    forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
    bvarLoc ExprBoundVar t tp
    var)
          smt_type <- evalFirstClassTypeRepr conn fn_source $ bvarType var
          declareTypes conn smt_type
          addCommand conn $ declareVarCommand conn nm smt_type
          cacheValueExpr conn (bvarId var) DeleteNever $! SMTName smt_type nm

    addConstraint :: SMTWriter h => WriterConn t h -> BoolExpr t -> IO ()
    addConstraint :: forall h t. SMTWriter h => WriterConn t h -> BoolExpr t -> IO ()
    addConstraint WriterConn t h
    conn BoolExpr t
    p = do
      f <- WriterConn t h -> BoolExpr t -> IO (Term h)
    forall h t.
    SMTWriter h =>
    WriterConn t h -> BoolExpr t -> IO (Term h)
    mkFormula WriterConn t h
    conn BoolExpr t
    p
      updateProgramLoc conn (exprLoc p)
      addCommand conn $ constraintCommand conn f

    -- | Perform any necessary declarations to ensure that the mentioned type map
    --   sorts exist in the solver environment.
    declareTypes ::
      SMTWriter h =>
      WriterConn t h ->
      TypeMap tp ->
      IO ()
    declareTypes :: forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn = \case
      TypeMap tp
    BoolTypeMap -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      TypeMap tp
    IntegerTypeMap -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      TypeMap tp
    RealTypeMap    -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      BVTypeMap NatRepr w
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      FloatTypeMap FloatPrecisionRepr fpp
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      TypeMap tp
    UnicodeTypeMap -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      TypeMap tp
    ComplexToStructTypeMap -> WriterConn t h
    -> Assignment
         TypeMap ((EmptyCtx ::> 'BaseRealType) ::> 'BaseRealType)
    -> IO ()
    forall h t (args :: Ctx BaseType).
    SMTWriter h =>
    WriterConn t h -> Assignment TypeMap args -> IO ()
    forall t (args :: Ctx BaseType).
    WriterConn t h -> Assignment TypeMap args -> IO ()
    declareStructDatatype WriterConn t h
    conn (Assignment TypeMap EmptyCtx
    forall {k} (ctx :: Ctx k) (f :: k -> Type).
    (ctx ~ EmptyCtx) =>
    Assignment f ctx
    Ctx.Empty Assignment TypeMap EmptyCtx
    -> TypeMap 'BaseRealType
    -> Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    -> TypeMap 'BaseRealType
    -> Assignment
         TypeMap ((EmptyCtx ::> 'BaseRealType) ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap)
      TypeMap tp
    ComplexToArrayTypeMap  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
      PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    args TypeMap tp
    ret ->
        do (forall (x :: BaseType). TypeMap x -> IO ())
    -> forall (x :: Ctx BaseType). Assignment TypeMap x -> IO ()
    forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
           (f :: k -> Type) a.
    (FoldableFC t, Applicative m) =>
    (forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
    traverseFC_ (WriterConn t h -> TypeMap x -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn) Assignment TypeMap (idxl ::> idx)
    args
           WriterConn t h -> Assignment TypeMap (idxl ::> idx) -> IO ()
    forall h t (args :: Ctx BaseType).
    SMTWriter h =>
    WriterConn t h -> Assignment TypeMap args -> IO ()
    forall t (args :: Ctx BaseType).
    WriterConn t h -> Assignment TypeMap args -> IO ()
    declareStructDatatype WriterConn t h
    conn Assignment TypeMap (idxl ::> idx)
    args
           WriterConn t h -> TypeMap tp -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn TypeMap tp
    ret
      FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    args TypeMap tp
    ret ->
        do (forall (x :: BaseType). TypeMap x -> IO ())
    -> forall (x :: Ctx BaseType). Assignment TypeMap x -> IO ()
    forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
           (f :: k -> Type) a.
    (FoldableFC t, Applicative m) =>
    (forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
    traverseFC_ (WriterConn t h -> TypeMap x -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn) Assignment TypeMap (idxl ::> idx)
    args
           WriterConn t h -> TypeMap tp -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn TypeMap tp
    ret
      StructTypeMap Assignment TypeMap idx
    flds ->
        do (forall (x :: BaseType). TypeMap x -> IO ())
    -> forall (x :: Ctx BaseType). Assignment TypeMap x -> IO ()
    forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
           (f :: k -> Type) a.
    (FoldableFC t, Applicative m) =>
    (forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
    traverseFC_ (WriterConn t h -> TypeMap x -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn) Assignment TypeMap idx
    flds
           WriterConn t h -> Assignment TypeMap idx -> IO ()
    forall h t (args :: Ctx BaseType).
    SMTWriter h =>
    WriterConn t h -> Assignment TypeMap args -> IO ()
    forall t (args :: Ctx BaseType).
    WriterConn t h -> Assignment TypeMap args -> IO ()
    declareStructDatatype WriterConn t h
    conn Assignment TypeMap idx
    flds

    data DefineStyle
      = FunctionDefinition
      | EqualityDefinition
     deriving (DefineStyle -> DefineStyle -> Bool
    (DefineStyle -> DefineStyle -> Bool)
    -> (DefineStyle -> DefineStyle -> Bool) -> Eq DefineStyle
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DefineStyle -> DefineStyle -> Bool
    == :: DefineStyle -> DefineStyle -> Bool
    $c/= :: DefineStyle -> DefineStyle -> Bool
    /= :: DefineStyle -> DefineStyle -> Bool
    Eq, Int -> DefineStyle -> String -> String
    [DefineStyle] -> String -> String
    DefineStyle -> String
    (Int -> DefineStyle -> String -> String)
    -> (DefineStyle -> String)
    -> ([DefineStyle] -> String -> String)
    -> Show DefineStyle
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DefineStyle -> String -> String
    showsPrec :: Int -> DefineStyle -> String -> String
    $cshow :: DefineStyle -> String
    show :: DefineStyle -> String
    $cshowList :: [DefineStyle] -> String -> String
    showList :: [DefineStyle] -> String -> String
    Show)

    -- | Create a variable name eqivalent to the given expression.
    defineSMTVar :: SMTWriter h
                 => WriterConn t h
                 -> DefineStyle
                 -> Text
                    -- ^ Name of variable to define
                    -- Should not be defined or declared in the current SMT context
                 -> [(Text, Some TypeMap)]
                    -- ^ Names of variables in term and associated type.
                 -> TypeMap rtp -- ^ Type of expression.
                 -> Term h
                 -> IO ()
    defineSMTVar :: forall h t (rtp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> DefineStyle
    -> Text
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> IO ()
    defineSMTVar WriterConn t h
    conn DefineStyle
    defSty Text
    var [(Text, Some TypeMap)]
    args TypeMap rtp
    return_type Term h
    expr
      | WriterConn t h -> Bool
    forall t h. WriterConn t h -> Bool
    supportFunctionDefs WriterConn t h
    conn Bool -> Bool -> Bool
    && DefineStyle
    defSty DefineStyle -> DefineStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == DefineStyle
    FunctionDefinition = do
        ((Text, Some TypeMap) -> IO ()) -> [(Text, Some TypeMap)] -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((forall (x :: BaseType). TypeMap x -> IO ())
    -> Some TypeMap -> IO ()
    forall {k} (f :: k -> Type) r.
    (forall (tp :: k). f tp -> r) -> Some f -> r
    viewSome (WriterConn t h -> TypeMap tp -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn) (Some TypeMap -> IO ())
    -> ((Text, Some TypeMap) -> Some TypeMap)
    -> (Text, Some TypeMap)
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, Some TypeMap) -> Some TypeMap
    forall a b. (a, b) -> b
    snd) [(Text, Some TypeMap)]
    args
        WriterConn t h -> TypeMap rtp -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn TypeMap rtp
    return_type
        WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand WriterConn t h
    conn (Command h -> IO ()) -> Command h -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WriterConn t h
    -> Text
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> Command h
    forall h (f :: Type -> Type) (rtp :: BaseType).
    SMTWriter h =>
    f h
    -> Text
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> Command h
    forall (f :: Type -> Type) (rtp :: BaseType).
    f h
    -> Text
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> Command h
    defineCommand WriterConn t h
    conn Text
    var [(Text, Some TypeMap)]
    args TypeMap rtp
    return_type Term h
    expr
      | Bool
    otherwise = do
        Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not ([(Text, Some TypeMap)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [(Text, Some TypeMap)]
    args)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " interface does not support defined functions."
        WriterConn t h -> TypeMap rtp -> IO ()
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO ()
    declareTypes WriterConn t h
    conn TypeMap rtp
    return_type
        WriterConn t h -> Command h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Command h -> IO ()
    addCommand WriterConn t h
    conn (Command h -> IO ()) -> Command h -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WriterConn t h
    -> Text -> Assignment TypeMap EmptyCtx -> TypeMap rtp -> Command h
    forall h (f :: Type -> Type) (args :: Ctx BaseType)
           (rtp :: BaseType).
    SMTWriter h =>
    f h -> Text -> Assignment TypeMap args -> TypeMap rtp -> Command h
    forall (f :: Type -> Type) (args :: Ctx BaseType)
           (rtp :: BaseType).
    f h -> Text -> Assignment TypeMap args -> TypeMap rtp -> Command h
    declareCommand WriterConn t h
    conn Text
    var Assignment TypeMap EmptyCtx
    forall {k} (f :: k -> Type). Assignment f EmptyCtx
    Ctx.empty TypeMap rtp
    return_type
        WriterConn t h -> Term h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Term h -> IO ()
    assumeFormula WriterConn t h
    conn (Term h -> IO ()) -> Term h -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Term h
    forall v. SupportTermOps v => Text -> v
    fromText Text
    var Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .== Term h
    expr

    -- | Create a variable name eqivalent to the given expression.
    freshBoundVarName :: SMTWriter h
                      => WriterConn t h
                      -> DefineStyle
                      -> [(Text, Some TypeMap)]
                         -- ^ Names of variables in term and associated type.
                      -> TypeMap rtp -- ^ Type of expression.
                      -> Term h
                      -> IO Text
    freshBoundVarName :: forall h t (rtp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> DefineStyle
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> IO Text
    freshBoundVarName WriterConn t h
    conn DefineStyle
    defSty [(Text, Some TypeMap)]
    args TypeMap rtp
    return_type Term h
    expr = do
      var <- WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ State WriterState Text
    freshVarName
      defineSMTVar conn defSty var args return_type expr
      return var

    -- | Function for create a new name given a base type.
    data FreshVarFn h = FreshVarFn (forall tp . TypeMap tp -> IO (SMTExpr h tp))

    -- | The state of a side collector monad
    --
    -- This has predicate for introducing new bound variables
    data SMTCollectorState t h
      = SMTCollectorState
        { forall t h. SMTCollectorState t h -> WriterConn t h
    scConn :: !(WriterConn t h)
        , forall t h.
    SMTCollectorState t h
    -> forall (rtp :: BaseType).
       Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    freshBoundTermFn :: !(forall rtp . Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ())
          -- ^ 'freshBoundTerm nm args ret_type ret' will record that 'nm(args) = ret'
          -- 'ret_type' should be the type of 'ret'.
        , forall t h. SMTCollectorState t h -> Maybe (FreshVarFn h)
    freshConstantFn  :: !(Maybe (FreshVarFn h))
        , forall t h. SMTCollectorState t h -> Maybe (Term h -> IO ())
    recordSideCondFn :: !(Maybe (Term h -> IO ()))
          -- ^ Called when we need to need to assert a predicate about some
          -- variables.
        }

    -- | The SMT term collector
    type SMTCollector t h = ReaderT (SMTCollectorState t h) IO

    -- | Create a fresh constant
    freshConstant :: String -- ^ The name of the constant based on its reaon.
                   -> TypeMap tp -- ^ Type of the constant.
                   -> SMTCollector t h (SMTExpr h tp)
    freshConstant :: forall (tp :: BaseType) t h.
    String -> TypeMap tp -> SMTCollector t h (SMTExpr h tp)
    freshConstant String
    nm TypeMap tp
    tpr = do
      mf <- (SMTCollectorState t h -> Maybe (FreshVarFn h))
    -> ReaderT (SMTCollectorState t h) IO (Maybe (FreshVarFn h))
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> Maybe (FreshVarFn h)
    forall t h. SMTCollectorState t h -> Maybe (FreshVarFn h)
    freshConstantFn
      case mf of
       Maybe (FreshVarFn h)
    Nothing -> do
         conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
         liftIO $ do
         loc <- withWriterState conn $ use position
         fail $ "Cannot create the free constant within a function needed to define the "
           ++ nm ++ " term created at " ++ show loc ++ "."
       Just (FreshVarFn forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp)
    f) ->
        IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (SMTExpr h tp)
     -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> IO (SMTExpr h tp)
    forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp)
    f TypeMap tp
    tpr

    data BaseTypeError = ComplexTypeUnsupported
                       | ArrayUnsupported
                       | StringTypeUnsupported (Some StringInfoRepr)

    -- | Given a solver connection and a base type repr, 'typeMap' attempts to
    -- find the best encoding for a variable of that type supported by teh solver.
    typeMap :: WriterConn t h  -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMap :: forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMap WriterConn t h
    conn BaseTypeRepr tp
    tp0 = do
      case WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn BaseTypeRepr tp
    tp0 of
        Right TypeMap tp
    tm -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    tm
        -- Recover from array unsupported if possible.
        Left BaseTypeError
    ArrayUnsupported
          | WriterConn t h -> Bool
    forall t h. WriterConn t h -> Bool
    supportFunctionDefs WriterConn t h
    conn
          , BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
    idxTp BaseTypeRepr xs
    eltTp <- BaseTypeRepr tp
    tp0 ->
            Assignment TypeMap (idx ::> tp) -> TypeMap xs -> TypeMap tp
    Assignment TypeMap (idx ::> tp)
    -> TypeMap xs -> TypeMap ('BaseArrayType (idx ::> tp) xs)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    FnArrayTypeMap (Assignment TypeMap (idx ::> tp) -> TypeMap xs -> TypeMap tp)
    -> Either BaseTypeError (Assignment TypeMap (idx ::> tp))
    -> Either BaseTypeError (TypeMap xs -> TypeMap tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (forall (x :: BaseType).
     BaseTypeRepr x -> Either BaseTypeError (TypeMap x))
    -> forall (x :: Ctx BaseType).
       Assignment BaseTypeRepr x
       -> Either BaseTypeError (Assignment TypeMap x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC (WriterConn t h
    -> BaseTypeRepr x -> Either BaseTypeError (TypeMap x)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn) Assignment BaseTypeRepr (idx ::> tp)
    idxTp
                           Either BaseTypeError (TypeMap xs -> TypeMap tp)
    -> Either BaseTypeError (TypeMap xs)
    -> Either BaseTypeError (TypeMap tp)
    forall a b.
    Either BaseTypeError (a -> b)
    -> Either BaseTypeError a -> Either BaseTypeError b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> WriterConn t h
    -> BaseTypeRepr xs -> Either BaseTypeError (TypeMap xs)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn BaseTypeRepr xs
    eltTp
        -- Pass other functions on.
        Left BaseTypeError
    e -> BaseTypeError -> Either BaseTypeError (TypeMap tp)
    forall a b. a -> Either a b
    Left BaseTypeError
    e

    -- | This is a helper function for 'typeMap' that only returns values that can
    -- be passed as arguments to a function.
    typeMapFirstClass :: WriterConn t h -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass :: forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn BaseTypeRepr tp
    tp0 = do
      let feat :: ProblemFeatures
    feat = WriterConn t h -> ProblemFeatures
    forall t h. WriterConn t h -> ProblemFeatures
    supportedFeatures WriterConn t h
    conn
      case BaseTypeRepr tp
    tp0 of
        BaseTypeRepr tp
    BaseBoolRepr -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    TypeMap BaseBoolType
    BoolTypeMap
        BaseBVRepr NatRepr w
    w -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right (TypeMap tp -> Either BaseTypeError (TypeMap tp))
    -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $! NatRepr w -> TypeMap ('BaseBVType w)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr w
    w
        BaseFloatRepr FloatPrecisionRepr fpp
    fpp -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right (TypeMap tp -> Either BaseTypeError (TypeMap tp))
    -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $! FloatPrecisionRepr fpp -> TypeMap ('BaseFloatType fpp)
    forall (idx :: FloatPrecision).
    FloatPrecisionRepr idx -> TypeMap (BaseFloatType idx)
    FloatTypeMap FloatPrecisionRepr fpp
    fpp
        BaseTypeRepr tp
    BaseRealRepr -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap
        BaseTypeRepr tp
    BaseIntegerRepr -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    TypeMap 'BaseIntegerType
    IntegerTypeMap
        BaseStringRepr StringInfoRepr si
    UnicodeRepr -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    TypeMap ('BaseStringType Unicode)
    UnicodeTypeMap
        BaseStringRepr StringInfoRepr si
    si -> BaseTypeError -> Either BaseTypeError (TypeMap tp)
    forall a b. a -> Either a b
    Left (Some StringInfoRepr -> BaseTypeError
    StringTypeUnsupported (StringInfoRepr si -> Some StringInfoRepr
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some StringInfoRepr si
    si))
        BaseTypeRepr tp
    BaseComplexRepr
          | ProblemFeatures
    feat ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useStructs        -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    TypeMap 'BaseComplexType
    ComplexToStructTypeMap
          | ProblemFeatures
    feat ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useSymbolicArrays -> TypeMap tp -> Either BaseTypeError (TypeMap tp)
    forall a b. b -> Either a b
    Right TypeMap tp
    TypeMap 'BaseComplexType
    ComplexToArrayTypeMap
          | Bool
    otherwise -> BaseTypeError -> Either BaseTypeError (TypeMap tp)
    forall a b. a -> Either a b
    Left BaseTypeError
    ComplexTypeUnsupported
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
    idxTp BaseTypeRepr xs
    eltTp -> do
          -- This is a proxy for the property we want, because we assume that EITHER
          -- the solver uses symbolic arrays, OR functions are first-class objects
          let mkArray :: Assignment TypeMap (idx ::> tp)
    -> TypeMap xs -> TypeMap ('BaseArrayType (idx ::> tp) xs)
    mkArray = if ProblemFeatures
    feat ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useSymbolicArrays
                        then Assignment TypeMap (idx ::> tp)
    -> TypeMap xs -> TypeMap ('BaseArrayType (idx ::> tp) xs)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    PrimArrayTypeMap
                        else Assignment TypeMap (idx ::> tp)
    -> TypeMap xs -> TypeMap ('BaseArrayType (idx ::> tp) xs)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    FnArrayTypeMap
          Assignment TypeMap (idx ::> tp) -> TypeMap xs -> TypeMap tp
    Assignment TypeMap (idx ::> tp)
    -> TypeMap xs -> TypeMap ('BaseArrayType (idx ::> tp) xs)
    mkArray (Assignment TypeMap (idx ::> tp) -> TypeMap xs -> TypeMap tp)
    -> Either BaseTypeError (Assignment TypeMap (idx ::> tp))
    -> Either BaseTypeError (TypeMap xs -> TypeMap tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (forall (x :: BaseType).
     BaseTypeRepr x -> Either BaseTypeError (TypeMap x))
    -> forall (x :: Ctx BaseType).
       Assignment BaseTypeRepr x
       -> Either BaseTypeError (Assignment TypeMap x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC (WriterConn t h
    -> BaseTypeRepr x -> Either BaseTypeError (TypeMap x)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn) Assignment BaseTypeRepr (idx ::> tp)
    idxTp
                  Either BaseTypeError (TypeMap xs -> TypeMap tp)
    -> Either BaseTypeError (TypeMap xs)
    -> Either BaseTypeError (TypeMap tp)
    forall a b.
    Either BaseTypeError (a -> b)
    -> Either BaseTypeError a -> Either BaseTypeError b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> WriterConn t h
    -> BaseTypeRepr xs -> Either BaseTypeError (TypeMap xs)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn BaseTypeRepr xs
    eltTp
        BaseStructRepr Assignment BaseTypeRepr ctx
    flds ->
          Assignment TypeMap ctx -> TypeMap tp
    Assignment TypeMap ctx -> TypeMap ('BaseStructType ctx)
    forall (idx :: Ctx BaseType).
    Assignment TypeMap idx -> TypeMap (BaseStructType idx)
    StructTypeMap (Assignment TypeMap ctx -> TypeMap tp)
    -> Either BaseTypeError (Assignment TypeMap ctx)
    -> Either BaseTypeError (TypeMap tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (forall (x :: BaseType).
     BaseTypeRepr x -> Either BaseTypeError (TypeMap x))
    -> forall (x :: Ctx BaseType).
       Assignment BaseTypeRepr x
       -> Either BaseTypeError (Assignment TypeMap x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC (WriterConn t h
    -> BaseTypeRepr x -> Either BaseTypeError (TypeMap x)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn) Assignment BaseTypeRepr ctx
    flds

    getBaseSMT_Type :: ExprBoundVar t tp -> SMTCollector t h (TypeMap tp)
    getBaseSMT_Type :: forall t (tp :: BaseType) h.
    ExprBoundVar t tp -> SMTCollector t h (TypeMap tp)
    getBaseSMT_Type ExprBoundVar t tp
    v = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      let errMsg String
    typename =
            Doc (ZonkAny 3) -> String
    forall a. Show a => a -> String
    show
              (Doc (ZonkAny 3) -> String) -> Doc (ZonkAny 3) -> String
    forall a b. (a -> b) -> a -> b
    $   SolverSymbol -> Doc (ZonkAny 3)
    forall a ann. Show a => a -> Doc ann
    viaShow (ExprBoundVar t tp -> SolverSymbol
    forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
    bvarName ExprBoundVar t tp
    v)
              Doc (ZonkAny 3) -> Doc (ZonkAny 3) -> Doc (ZonkAny 3)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 3)
    "is a"
              Doc (ZonkAny 3) -> Doc (ZonkAny 3) -> Doc (ZonkAny 3)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> String -> Doc (ZonkAny 3)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    typename
              Doc (ZonkAny 3) -> Doc (ZonkAny 3) -> Doc (ZonkAny 3)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 3)
    "variable, and we do not support this with"
              Doc (ZonkAny 3) -> Doc (ZonkAny 3) -> Doc (ZonkAny 3)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> String -> Doc (ZonkAny 3)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".")
      case typeMap conn (bvarType v) of
        Left  (StringTypeUnsupported (Some StringInfoRepr x
    si)) -> String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg (String
    "string " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ StringInfoRepr x -> String
    forall a. Show a => a -> String
    show StringInfoRepr x
    si)
        Left  BaseTypeError
    ComplexTypeUnsupported -> String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg String
    "complex"
        Left  BaseTypeError
    ArrayUnsupported       -> String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg String
    "array"
        Right TypeMap tp
    smtType                -> TypeMap tp -> ReaderT (SMTCollectorState t h) IO (TypeMap tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return TypeMap tp
    smtType

    -- | Create a fresh bound term from the SMT expression with the given name.
    freshBoundFn :: [(Text, Some TypeMap)] -- ^ Arguments expected for function.
                 -> TypeMap rtp -- ^ Type of result
                 -> Term h   -- ^ Result of function
                 -> SMTCollector t h Text
    freshBoundFn :: forall (rtp :: BaseType) h t.
    [(Text, Some TypeMap)]
    -> TypeMap rtp -> Term h -> SMTCollector t h Text
    freshBoundFn [(Text, Some TypeMap)]
    args TypeMap rtp
    tp Term h
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      f <- asks $ \SMTCollectorState t h
    x -> SMTCollectorState t h
    -> forall (rtp :: BaseType).
       Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    forall t h.
    SMTCollectorState t h
    -> forall (rtp :: BaseType).
       Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    freshBoundTermFn SMTCollectorState t h
    x
      liftIO $ do
        var <- withWriterState conn $ freshVarName
        f var args tp t
        return var

    -- | Create a fresh bound term from the SMT expression with the given name.
    freshBoundTerm :: TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm :: forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    tp Term h
    t = TypeMap tp -> Text -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Text -> SMTExpr h tp
    SMTName TypeMap tp
    tp (Text -> SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO Text
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Some TypeMap)]
    -> TypeMap tp -> Term h -> ReaderT (SMTCollectorState t h) IO Text
    forall (rtp :: BaseType) h t.
    [(Text, Some TypeMap)]
    -> TypeMap rtp -> Term h -> SMTCollector t h Text
    freshBoundFn [] TypeMap tp
    tp Term h
    t

    -- | Create a fresh bound term from the SMT expression with the given name.
    freshBoundTerm' :: SupportTermOps (Term h) => SMTExpr h tp -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm' :: forall h (tp :: BaseType) t.
    SupportTermOps (Term h) =>
    SMTExpr h tp -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm' SMTExpr h tp
    t = TypeMap tp -> Text -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Text -> SMTExpr h tp
    SMTName TypeMap tp
    tp (Text -> SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO Text
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Some TypeMap)]
    -> TypeMap tp -> Term h -> ReaderT (SMTCollectorState t h) IO Text
    forall (rtp :: BaseType) h t.
    [(Text, Some TypeMap)]
    -> TypeMap rtp -> Term h -> SMTCollector t h Text
    freshBoundFn [] TypeMap tp
    tp (SMTExpr h tp -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h tp
    t)
      where tp :: TypeMap tp
    tp = SMTExpr h tp -> TypeMap tp
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h tp
    t

    -- | Assert a predicate holds as a side condition to some formula.
    addSideCondition ::
       String {- ^ Reason that condition is being added. -} ->
       Term h {- ^ Predicate that should hold. -} ->
       SMTCollector t h ()
    addSideCondition :: forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    nm Term h
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      mf <- asks recordSideCondFn
      loc <- liftIO $ withWriterState conn $ use position
      case mf of
       Just Term h -> IO ()
    f ->
         IO () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT (SMTCollectorState t h) IO ())
    -> IO () -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h -> IO ()
    f Term h
    t
       Maybe (Term h -> IO ())
    Nothing -> do
         String -> ReaderT (SMTCollectorState t h) IO ()
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO ())
    -> String -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Cannot add a side condition within a function needed to define the "
           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    nm String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " term created at " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Position -> String
    forall a. Show a => a -> String
    show Position
    loc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."

    addPartialSideCond ::
      forall t h tp.
      SMTWriter h =>
      WriterConn t h ->
      Term h ->
      TypeMap tp ->
      Maybe (AbstractValue tp) ->
      SMTCollector t h ()

    -- no abstract domain information means unconstrained values
    addPartialSideCond :: forall t h (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> SMTCollector t h ()
    addPartialSideCond WriterConn t h
    _ Term h
    _ TypeMap tp
    _ Maybe (AbstractValue tp)
    Nothing = () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

    addPartialSideCond WriterConn t h
    _ Term h
    _ TypeMap tp
    BoolTypeMap (Just Maybe Bool
    AbstractValue tp
    Nothing) = () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
    addPartialSideCond WriterConn t h
    _ Term h
    t TypeMap tp
    BoolTypeMap (Just (Just Bool
    b)) =
       -- This is a weird case, but technically possible, so...
      String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "bool_val" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h
    t Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .== Bool -> Term h
    forall v. SupportTermOps v => Bool -> v
    boolExpr Bool
    b

    addPartialSideCond WriterConn t h
    _ Term h
    t TypeMap tp
    IntegerTypeMap (Just AbstractValue tp
    rng) =
      do case ValueRange Integer -> ValueBound Integer
    forall tp. ValueRange tp -> ValueBound tp
    rangeLowBound AbstractValue tp
    ValueRange Integer
    rng of
           ValueBound Integer
    Unbounded -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
           Inclusive Integer
    lo -> String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "int_range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h
    t Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .>= Integer -> Term h
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    lo
         case ValueRange Integer -> ValueBound Integer
    forall tp. ValueRange tp -> ValueBound tp
    rangeHiBound AbstractValue tp
    ValueRange Integer
    rng of
           ValueBound Integer
    Unbounded -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
           Inclusive Integer
    hi -> String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "int_range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h
    t Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= Integer -> Term h
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    hi

    addPartialSideCond WriterConn t h
    _ Term h
    t TypeMap tp
    RealTypeMap (Just AbstractValue tp
    rng) =
      do case ValueRange Rational -> ValueBound Rational
    forall tp. ValueRange tp -> ValueBound tp
    rangeLowBound (RealAbstractValue -> ValueRange Rational
    ravRange AbstractValue tp
    RealAbstractValue
    rng) of
           ValueBound Rational
    Unbounded -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
           Inclusive Rational
    lo -> String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "real_range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h
    t Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .>= Rational -> Term h
    forall v. SupportTermOps v => Rational -> v
    rationalTerm Rational
    lo
         case ValueRange Rational -> ValueBound Rational
    forall tp. ValueRange tp -> ValueBound tp
    rangeHiBound (RealAbstractValue -> ValueRange Rational
    ravRange AbstractValue tp
    RealAbstractValue
    rng) of
           ValueBound Rational
    Unbounded -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
           Inclusive Rational
    hi -> String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "real_range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h
    t Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= Rational -> Term h
    forall v. SupportTermOps v => Rational -> v
    rationalTerm Rational
    hi

    addPartialSideCond WriterConn t h
    _ Term h
    t (BVTypeMap NatRepr w
    w) (Just (BVD.BVDArith Domain w
    rng)) = Maybe (Integer, Integer) -> ReaderT (SMTCollectorState t h) IO ()
    assertRange (Domain w -> Maybe (Integer, Integer)
    forall (w :: Natural). Domain w -> Maybe (Integer, Integer)
    BVD.arithDomainData Domain w
    rng)
       where
       assertRange :: Maybe (Integer, Integer) -> ReaderT (SMTCollectorState t h) IO ()
    assertRange Maybe (Integer, Integer)
    Nothing = () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
       assertRange (Just (Integer
    lo, Integer
    sz)) =
         String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "bv_range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvULe (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvSub Term h
    t (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w Integer
    lo))) (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w Integer
    sz))

    addPartialSideCond WriterConn t h
    _ Term h
    t (BVTypeMap NatRepr w
    w) (Just (BVD.BVDBitwise Domain w
    rng)) = (Integer, Integer) -> ReaderT (SMTCollectorState t h) IO ()
    assertBitRange (Domain w -> (Integer, Integer)
    forall (w :: Natural). Domain w -> (Integer, Integer)
    BVD.bitbounds Domain w
    rng)
       where
       assertBitRange :: (Integer, Integer) -> ReaderT (SMTCollectorState t h) IO ()
    assertBitRange (Integer
    lo, Integer
    hi) = do
         Bool
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Integer
    lo Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0) (ReaderT (SMTCollectorState t h) IO ()
     -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $
           String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "bv_bitrange" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvOr (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w Integer
    lo)) Term h
    t) Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .== Term h
    t
         Bool
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Integer
    hi Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < NatRepr w -> Integer
    forall (w :: Natural). NatRepr w -> Integer
    maxUnsigned NatRepr w
    w) (ReaderT (SMTCollectorState t h) IO ()
     -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $
           String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "bv_bitrange" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvOr Term h
    t (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w Integer
    hi))) Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .== (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w Integer
    hi))

    addPartialSideCond WriterConn t h
    _ Term h
    t (TypeMap tp
    UnicodeTypeMap) (Just (StringAbs ValueRange Integer
    len)) =
      do case ValueRange Integer -> ValueBound Integer
    forall tp. ValueRange tp -> ValueBound tp
    rangeLowBound ValueRange Integer
    len of
           Inclusive Integer
    lo ->
              String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "string length low range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $
                 Integer -> Term h
    forall v. SupportTermOps v => Integer -> v
    integerTerm (Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    max Integer
    0 Integer
    lo) Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= forall h. SMTWriter h => Term h -> Term h
    stringLength @h Term h
    t
           ValueBound Integer
    Unbounded ->
              String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "string length low range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $
                 Integer -> Term h
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    0 Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= forall h. SMTWriter h => Term h -> Term h
    stringLength @h Term h
    t

         case ValueRange Integer -> ValueBound Integer
    forall tp. ValueRange tp -> ValueBound tp
    rangeHiBound ValueRange Integer
    len of
           ValueBound Integer
    Unbounded -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
           Inclusive Integer
    hi ->
             String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "string length high range" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $
               forall h. SMTWriter h => Term h -> Term h
    stringLength @h Term h
    t Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= Integer -> Term h
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    hi

    addPartialSideCond WriterConn t h
    _ Term h
    _ (FloatTypeMap FloatPrecisionRepr fpp
    _) (Just ()) = () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

    addPartialSideCond WriterConn t h
    conn Term h
    t TypeMap tp
    ComplexToStructTypeMap (Just (RealAbstractValue
    realRng :+ RealAbstractValue
    imagRng)) =
      do let r :: Term h
    r = forall h. SMTWriter h => Term h -> Term h
    arrayComplexRealPart @h Term h
    t
         let i :: Term h
    i = forall h. SMTWriter h => Term h -> Term h
    arrayComplexImagPart @h Term h
    t
         WriterConn t h
    -> Term h
    -> TypeMap 'BaseRealType
    -> Maybe (AbstractValue 'BaseRealType)
    -> ReaderT (SMTCollectorState t h) IO ()
    forall t h (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> SMTCollector t h ()
    addPartialSideCond WriterConn t h
    conn Term h
    r TypeMap 'BaseRealType
    RealTypeMap (RealAbstractValue -> Maybe RealAbstractValue
    forall a. a -> Maybe a
    Just RealAbstractValue
    realRng)
         WriterConn t h
    -> Term h
    -> TypeMap 'BaseRealType
    -> Maybe (AbstractValue 'BaseRealType)
    -> ReaderT (SMTCollectorState t h) IO ()
    forall t h (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> SMTCollector t h ()
    addPartialSideCond WriterConn t h
    conn Term h
    i TypeMap 'BaseRealType
    RealTypeMap (RealAbstractValue -> Maybe RealAbstractValue
    forall a. a -> Maybe a
    Just RealAbstractValue
    imagRng)

    addPartialSideCond WriterConn t h
    conn Term h
    t TypeMap tp
    ComplexToArrayTypeMap (Just (RealAbstractValue
    realRng :+ RealAbstractValue
    imagRng)) =
      do let r :: Term h
    r = forall h. SMTWriter h => Term h -> Term h
    arrayComplexRealPart @h Term h
    t
         let i :: Term h
    i = forall h. SMTWriter h => Term h -> Term h
    arrayComplexImagPart @h Term h
    t
         WriterConn t h
    -> Term h
    -> TypeMap 'BaseRealType
    -> Maybe (AbstractValue 'BaseRealType)
    -> ReaderT (SMTCollectorState t h) IO ()
    forall t h (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> SMTCollector t h ()
    addPartialSideCond WriterConn t h
    conn Term h
    r TypeMap 'BaseRealType
    RealTypeMap (RealAbstractValue -> Maybe RealAbstractValue
    forall a. a -> Maybe a
    Just RealAbstractValue
    realRng)
         WriterConn t h
    -> Term h
    -> TypeMap 'BaseRealType
    -> Maybe (AbstractValue 'BaseRealType)
    -> ReaderT (SMTCollectorState t h) IO ()
    forall t h (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> SMTCollector t h ()
    addPartialSideCond WriterConn t h
    conn Term h
    i TypeMap 'BaseRealType
    RealTypeMap (RealAbstractValue -> Maybe RealAbstractValue
    forall a. a -> Maybe a
    Just RealAbstractValue
    imagRng)

    addPartialSideCond WriterConn t h
    conn Term h
    t (StructTypeMap Assignment TypeMap idx
    ctx) (Just AbstractValue tp
    abvs) =
         Size idx
    -> (forall (tp :: BaseType).
        ReaderT (SMTCollectorState t h) IO ()
        -> Index idx tp -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall {k} (ctx :: Ctx k) r.
    Size ctx -> (forall (tp :: k). r -> Index ctx tp -> r) -> r -> r
    Ctx.forIndex (Assignment TypeMap idx -> Size idx
    forall {k} (f :: k -> Type) (ctx :: Ctx k).
    Assignment f ctx -> Size ctx
    Ctx.size Assignment TypeMap idx
    ctx)
            (\ReaderT (SMTCollectorState t h) IO ()
    start Index idx tp
    i ->
                do ReaderT (SMTCollectorState t h) IO ()
    start
                   WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> ReaderT (SMTCollectorState t h) IO ()
    forall t h (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Term h
    -> TypeMap tp
    -> Maybe (AbstractValue tp)
    -> SMTCollector t h ()
    addPartialSideCond WriterConn t h
    conn
                     (forall h (args :: Ctx BaseType) (tp :: BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> Index args tp -> Term h -> Term h
    structProj @h Assignment TypeMap idx
    ctx Index idx tp
    i Term h
    t)
                     (Assignment TypeMap idx
    ctx Assignment TypeMap idx -> Index idx tp -> TypeMap tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index idx tp
    i)
                     (AbstractValue tp -> Maybe (AbstractValue tp)
    forall a. a -> Maybe a
    Just (AbstractValueWrapper tp -> AbstractValue tp
    forall (tp :: BaseType).
    AbstractValueWrapper tp -> AbstractValue tp
    unwrapAV (Assignment AbstractValueWrapper idx
    AbstractValue tp
    abvs Assignment AbstractValueWrapper idx
    -> Index idx tp -> AbstractValueWrapper tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index idx tp
    i))))
            (() -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ())

    addPartialSideCond WriterConn t h
    _ Term h
    _t (PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    _idxTp TypeMap tp
    _resTp) (Just AbstractValue tp
    _abv) =
      String -> ReaderT (SMTCollectorState t h) IO ()
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "SMTWriter.addPartialSideCond: bounds on array values not supported"
    addPartialSideCond WriterConn t h
    _ Term h
    _t (FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    _idxTp TypeMap tp
    _resTp) (Just AbstractValue tp
    _abv) =
      String -> ReaderT (SMTCollectorState t h) IO ()
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "SMTWriter.addPartialSideCond: bounds on array values not supported"

    -- | This runs the collector on the connection
    runOnLiveConnection :: SMTWriter h => WriterConn t h -> SMTCollector t h a -> IO a
    runOnLiveConnection :: forall h t a.
    SMTWriter h =>
    WriterConn t h -> SMTCollector t h a -> IO a
    runOnLiveConnection WriterConn t h
    conn SMTCollector t h a
    coll = SMTCollector t h a -> SMTCollectorState t h -> IO a
    forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
    runReaderT SMTCollector t h a
    coll SMTCollectorState t h
    s
      where s :: SMTCollectorState t h
    s = SMTCollectorState
                  { scConn :: WriterConn t h
    scConn = WriterConn t h
    conn
                  , freshBoundTermFn :: forall (rtp :: BaseType).
    Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    freshBoundTermFn = WriterConn t h
    -> DefineStyle
    -> Text
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> IO ()
    forall h t (rtp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> DefineStyle
    -> Text
    -> [(Text, Some TypeMap)]
    -> TypeMap rtp
    -> Term h
    -> IO ()
    defineSMTVar WriterConn t h
    conn DefineStyle
    FunctionDefinition
                  , freshConstantFn :: Maybe (FreshVarFn h)
    freshConstantFn  = FreshVarFn h -> Maybe (FreshVarFn h)
    forall a. a -> Maybe a
    Just (FreshVarFn h -> Maybe (FreshVarFn h))
    -> FreshVarFn h -> Maybe (FreshVarFn h)
    forall a b. (a -> b) -> a -> b
    $! (forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp))
    -> FreshVarFn h
    forall h.
    (forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp))
    -> FreshVarFn h
    FreshVarFn (WriterConn t h -> TypeMap tp -> IO (SMTExpr h tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> TypeMap tp -> IO (SMTExpr h tp)
    mkFreeVar' WriterConn t h
    conn)
                  , recordSideCondFn :: Maybe (Term h -> IO ())
    recordSideCondFn = (Term h -> IO ()) -> Maybe (Term h -> IO ())
    forall a. a -> Maybe a
    Just ((Term h -> IO ()) -> Maybe (Term h -> IO ()))
    -> (Term h -> IO ()) -> Maybe (Term h -> IO ())
    forall a b. (a -> b) -> a -> b
    $! WriterConn t h -> Term h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Term h -> IO ()
    assumeFormula WriterConn t h
    conn
                  }

    prependToRefList :: IORef [a] -> a -> IO ()
    prependToRefList :: forall a. IORef [a] -> a -> IO ()
    prependToRefList IORef [a]
    r a
    a = a -> IO () -> IO ()
    forall a b. a -> b -> b
    seq a
    a (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IORef [a] -> ([a] -> [a]) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef [a]
    r (a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :)

    freshSandboxBoundTerm :: SupportTermOps v
                          => IORef [(Text, v)]
                          -> Text -- ^ Name to define.
                          -> [(Text, Some TypeMap)] -- Argument name and types.
                          -> TypeMap rtp
                          -> v
                          -> IO ()
    freshSandboxBoundTerm :: forall v (rtp :: BaseType).
    SupportTermOps v =>
    IORef [(Text, v)]
    -> Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> v -> IO ()
    freshSandboxBoundTerm IORef [(Text, v)]
    ref Text
    var [] TypeMap rtp
    _ v
    t = do
      IORef [(Text, v)] -> (Text, v) -> IO ()
    forall a. IORef [a] -> a -> IO ()
    prependToRefList IORef [(Text, v)]
    ref (Text
    var,v
    t)
    freshSandboxBoundTerm IORef [(Text, v)]
    ref Text
    var [(Text, Some TypeMap)]
    args TypeMap rtp
    _ v
    t = do
      case Maybe ([(Text, Some TypeMap)] -> v -> v)
    forall v.
    SupportTermOps v =>
    Maybe ([(Text, Some TypeMap)] -> v -> v)
    lambdaTerm of
        Maybe ([(Text, Some TypeMap)] -> v -> v)
    Nothing -> do
          String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Cannot create terms with arguments inside defined functions."
        Just [(Text, Some TypeMap)] -> v -> v
    lambdaFn -> do
          let r :: v
    r = [(Text, Some TypeMap)] -> v -> v
    lambdaFn [(Text, Some TypeMap)]
    args v
    t
          v -> IO () -> IO ()
    forall a b. a -> b -> b
    seq v
    r (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IORef [(Text, v)] -> (Text, v) -> IO ()
    forall a. IORef [a] -> a -> IO ()
    prependToRefList IORef [(Text, v)]
    ref (Text
    var, v
    r)

    freshSandboxConstant :: WriterConn t h
                         -> IORef [(Text, Some TypeMap)]
                         -> TypeMap tp
                         -> IO (SMTExpr h tp)
    freshSandboxConstant :: forall t h (tp :: BaseType).
    WriterConn t h
    -> IORef [(Text, Some TypeMap)] -> TypeMap tp -> IO (SMTExpr h tp)
    freshSandboxConstant WriterConn t h
    conn IORef [(Text, Some TypeMap)]
    ref TypeMap tp
    tp = do
      var <- WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ State WriterState Text
    freshVarName
      prependToRefList ref (var, Some tp)
      return $! SMTName tp var

    -- | This describes the result that was collected from the solver.
    data CollectorResults h a =
      CollectorResults { forall h a. CollectorResults h a -> a
    crResult :: !a
                         -- ^ Result from sandboxed computation.
                       , forall h a. CollectorResults h a -> [(Text, Term h)]
    crBindings :: !([(Text, Term h)])
                         -- ^ List of bound variables.
                       , forall h a. CollectorResults h a -> [(Text, Some TypeMap)]
    crFreeConstants :: !([(Text, Some TypeMap)])
                         -- ^ Constants added during generation.
                       , forall h a. CollectorResults h a -> [Term h]
    crSideConds :: !([Term h])
                         -- ^ List of Boolean predicates asserted by collector.
                       }

    -- | Create a forall expression from a CollectorResult.
    forallResult :: forall h
                 .  SMTWriter h
                 => CollectorResults h (Term h)
                 -> Term h
    forallResult :: forall h. SMTWriter h => CollectorResults h (Term h) -> Term h
    forallResult CollectorResults h (Term h)
    cr =
      forall h. SMTWriter h => [(Text, Some TypeMap)] -> Term h -> Term h
    forallExpr @h (CollectorResults h (Term h) -> [(Text, Some TypeMap)]
    forall h a. CollectorResults h a -> [(Text, Some TypeMap)]
    crFreeConstants CollectorResults h (Term h)
    cr) (Term h -> Term h) -> Term h -> Term h
    forall a b. (a -> b) -> a -> b
    $
        [(Text, Term h)] -> Term h -> Term h
    forall v. SupportTermOps v => [(Text, v)] -> v -> v
    letExpr (CollectorResults h (Term h) -> [(Text, Term h)]
    forall h a. CollectorResults h a -> [(Text, Term h)]
    crBindings CollectorResults h (Term h)
    cr) (Term h -> Term h) -> Term h -> Term h
    forall a b. (a -> b) -> a -> b
    $
          [Term h] -> Term h -> Term h
    forall v. SupportTermOps v => [v] -> v -> v
    impliesAllExpr (CollectorResults h (Term h) -> [Term h]
    forall h a. CollectorResults h a -> [Term h]
    crSideConds CollectorResults h (Term h)
    cr) (CollectorResults h (Term h) -> Term h
    forall h a. CollectorResults h a -> a
    crResult CollectorResults h (Term h)
    cr)

    -- | @impliesAllExpr l r@ returns an expression equivalent to
    -- forall l implies r.
    impliesAllExpr :: SupportTermOps v => [v] -> v -> v
    impliesAllExpr :: forall v. SupportTermOps v => [v] -> v -> v
    impliesAllExpr [v]
    l v
    r = [v] -> v
    forall v. SupportTermOps v => [v] -> v
    orAll ((v -> v
    forall v. SupportTermOps v => v -> v
    notExpr (v -> v) -> [v] -> [v]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [v]
    l) [v] -> [v] -> [v]
    forall a. [a] -> [a] -> [a]
    ++ [v
    r])

    -- | Create a forall expression from a CollectorResult.
    existsResult :: forall h
                 .  SMTWriter h
                 => CollectorResults h (Term h)
                 -> Term h
    existsResult :: forall h. SMTWriter h => CollectorResults h (Term h) -> Term h
    existsResult CollectorResults h (Term h)
    cr =
      forall h. SMTWriter h => [(Text, Some TypeMap)] -> Term h -> Term h
    existsExpr @h (CollectorResults h (Term h) -> [(Text, Some TypeMap)]
    forall h a. CollectorResults h a -> [(Text, Some TypeMap)]
    crFreeConstants CollectorResults h (Term h)
    cr) (Term h -> Term h) -> Term h -> Term h
    forall a b. (a -> b) -> a -> b
    $
        [(Text, Term h)] -> Term h -> Term h
    forall v. SupportTermOps v => [(Text, v)] -> v -> v
    letExpr (CollectorResults h (Term h) -> [(Text, Term h)]
    forall h a. CollectorResults h a -> [(Text, Term h)]
    crBindings CollectorResults h (Term h)
    cr) (Term h -> Term h) -> Term h -> Term h
    forall a b. (a -> b) -> a -> b
    $
          [Term h] -> Term h
    forall v. SupportTermOps v => [v] -> v
    andAll (CollectorResults h (Term h) -> [Term h]
    forall h a. CollectorResults h a -> [Term h]
    crSideConds CollectorResults h (Term h)
    cr [Term h] -> [Term h] -> [Term h]
    forall a. [a] -> [a] -> [a]
    ++ [CollectorResults h (Term h) -> Term h
    forall h a. CollectorResults h a -> a
    crResult CollectorResults h (Term h)
    cr])

    -- | This runs the side collector and collects the results.
    runInSandbox :: SupportTermOps (Term h)
                 => WriterConn t h
                 -> SMTCollector t h a
                 -> IO (CollectorResults h a)
    runInSandbox :: forall h t a.
    SupportTermOps (Term h) =>
    WriterConn t h -> SMTCollector t h a -> IO (CollectorResults h a)
    runInSandbox WriterConn t h
    conn SMTCollector t h a
    sc = do
      -- A list of bound terms.
      boundTermRef    <- [(Text, Term h)] -> IO (IORef [(Text, Term h)])
    forall a. a -> IO (IORef a)
    newIORef []
      -- A list of free constants
      freeConstantRef <- (newIORef [] :: IO (IORef [(Text, Some TypeMap)]))
      -- A list of references to side conditions.
      sideCondRef     <- newIORef []

      let s = SMTCollectorState
              { scConn :: WriterConn t h
    scConn = WriterConn t h
    conn
              , freshBoundTermFn :: forall (rtp :: BaseType).
    Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    freshBoundTermFn = IORef [(Text, Term h)]
    -> Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    forall v (rtp :: BaseType).
    SupportTermOps v =>
    IORef [(Text, v)]
    -> Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> v -> IO ()
    freshSandboxBoundTerm IORef [(Text, Term h)]
    boundTermRef
              , freshConstantFn :: Maybe (FreshVarFn h)
    freshConstantFn  = FreshVarFn h -> Maybe (FreshVarFn h)
    forall a. a -> Maybe a
    Just (FreshVarFn h -> Maybe (FreshVarFn h))
    -> FreshVarFn h -> Maybe (FreshVarFn h)
    forall a b. (a -> b) -> a -> b
    $! (forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp))
    -> FreshVarFn h
    forall h.
    (forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp))
    -> FreshVarFn h
    FreshVarFn (WriterConn t h
    -> IORef [(Text, Some TypeMap)] -> TypeMap tp -> IO (SMTExpr h tp)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> IORef [(Text, Some TypeMap)] -> TypeMap tp -> IO (SMTExpr h tp)
    freshSandboxConstant WriterConn t h
    conn IORef [(Text, Some TypeMap)]
    freeConstantRef)
              , recordSideCondFn :: Maybe (Term h -> IO ())
    recordSideCondFn = (Term h -> IO ()) -> Maybe (Term h -> IO ())
    forall a. a -> Maybe a
    Just ((Term h -> IO ()) -> Maybe (Term h -> IO ()))
    -> (Term h -> IO ()) -> Maybe (Term h -> IO ())
    forall a b. (a -> b) -> a -> b
    $! IORef [Term h] -> Term h -> IO ()
    forall a. IORef [a] -> a -> IO ()
    prependToRefList IORef [Term h]
    sideCondRef
              }
      r <- runReaderT sc s

      boundTerms    <- readIORef boundTermRef
      freeConstants <- readIORef freeConstantRef
      sideConds     <- readIORef sideCondRef
      return $! CollectorResults { crResult = r
                                 , crBindings = reverse boundTerms
                                 , crFreeConstants = reverse freeConstants
                                 , crSideConds = reverse sideConds
                                 }

    -- | Cache the result of writing an Expr named by the given nonce.
    cacheWriterResult :: Nonce t tp
                         -- ^ Nonce to associate term with
                      -> TermLifetime
                         -- ^ Lifetime of term
                      -> SMTCollector t h (SMTExpr h tp)
                         -- ^ Action to create term.
                      -> SMTCollector t h (SMTExpr h tp)
    cacheWriterResult :: forall t (tp :: BaseType) h.
    Nonce t tp
    -> TermLifetime
    -> SMTCollector t h (SMTExpr h tp)
    -> SMTCollector t h (SMTExpr h tp)
    cacheWriterResult Nonce t tp
    n TermLifetime
    lifetime SMTCollector t h (SMTExpr h tp)
    fallback = do
      c <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      (liftIO $ cacheLookupExpr c n) >>= \case
        Just SMTExpr h tp
    x -> SMTExpr h tp -> SMTCollector t h (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return SMTExpr h tp
    x
        Maybe (SMTExpr h tp)
    Nothing -> do
          x <- SMTCollector t h (SMTExpr h tp)
    fallback
          liftIO $ cacheValueExpr c n lifetime x
          return x

    -- | Associate a bound variable with the givne SMT Expression until
    -- the a
    bindVar :: ExprBoundVar t tp
            -- ^ Variable to bind
            -> SMTExpr h tp
            -- ^ SMT Expression to bind to var.
            -> SMTCollector t h ()
    bindVar :: forall t (tp :: BaseType) h.
    ExprBoundVar t tp -> SMTExpr h tp -> SMTCollector t h ()
    bindVar ExprBoundVar t tp
    v SMTExpr h tp
    x  = do
      let n :: Nonce t tp
    n = ExprBoundVar t tp -> Nonce t tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
    bvarId ExprBoundVar t tp
    v
      c <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      liftIO $ do
        whenM (isJust <$> cacheLookupExpr c n) $ fail "Variable is already bound."
        cacheValueExpr c n DeleteOnPop x

    ------------------------------------------------------------------------
    -- Evaluate applications.

    -- @bvIntTerm w x@ builds an integer term that has the same value as
    -- the unsigned integer value of the bitvector @x@.  This is done by
    -- explicitly decomposing the positional notation of the bitvector
    -- into a sum of powers of 2.
    bvIntTerm :: forall v w
               . (SupportTermOps v, 1 <= w)
              => NatRepr w
              -> v
              -> v
    bvIntTerm :: forall v (w :: Natural).
    (SupportTermOps v, 1 <= w) =>
    NatRepr w -> v -> v
    bvIntTerm NatRepr w
    w v
    x = [v] -> v
    forall v. SupportTermOps v => [v] -> v
    sumExpr ((\Natural
    i -> Natural -> v
    digit (Natural
    iNatural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    -Natural
    1)) (Natural -> v) -> [Natural] -> [v]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Natural
    1..NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w])
     where digit :: Natural -> v
           digit :: Natural -> v
    digit Natural
    d = v -> v -> v -> v
    forall v. SupportTermOps v => v -> v -> v -> v
    ite (NatRepr w -> Natural -> v -> v
    forall (w :: Natural). NatRepr w -> Natural -> v -> v
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w Natural
    d v
    x)
                         (Integer -> v
    forall a. Num a => Integer -> a
    fromInteger (Integer
    2Integer -> Natural -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Natural
    d))
                         v
    0

    sbvIntTerm :: SupportTermOps v
               => NatRepr w
               -> v
               -> v
    sbvIntTerm :: forall v (w :: Natural). SupportTermOps v => NatRepr w -> v -> v
    sbvIntTerm NatRepr w
    w0 v
    x0 = [v] -> v
    forall v. SupportTermOps v => [v] -> v
    sumExpr (v
    signed_offset v -> [v] -> [v]
    forall a. a -> [a] -> [a]
    : NatRepr w -> v -> Natural -> [v]
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> v -> Natural -> [v]
    go NatRepr w
    w0 v
    x0 (NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w0 Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    2))
     where signed_offset :: v
    signed_offset = v -> v -> v -> v
    forall v. SupportTermOps v => v -> v -> v -> v
    ite (NatRepr w -> Natural -> v -> v
    forall (w :: Natural). NatRepr w -> Natural -> v -> v
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w0 (NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w0 Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    1) v
    x0)
                               (Integer -> v
    forall a. Num a => Integer -> a
    fromInteger (Integer -> Integer
    forall a. Num a => a -> a
    negate (Integer
    2Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(NatRepr w -> Int
    forall (n :: Natural). NatRepr n -> Int
    widthVal NatRepr w
    w0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))))
                               v
    0
           go :: SupportTermOps v => NatRepr w -> v -> Natural -> [v]
           go :: forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> v -> Natural -> [v]
    go NatRepr w
    w v
    x Natural
    n
            | Natural
    n Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    > Natural
    0     = NatRepr w -> v -> Natural -> v
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> v -> Natural -> v
    digit NatRepr w
    w v
    x Natural
    n v -> [v] -> [v]
    forall a. a -> [a] -> [a]
    : NatRepr w -> v -> Natural -> [v]
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> v -> Natural -> [v]
    go NatRepr w
    w v
    x (Natural
    nNatural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    -Natural
    1)
            | Natural
    n Natural -> Natural -> Bool
    forall a. Eq a => a -> a -> Bool
    == Natural
    0    = [NatRepr w -> v -> Natural -> v
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> v -> Natural -> v
    digit NatRepr w
    w v
    x Natural
    0]
            | Bool
    otherwise = [] -- this branch should only be called in the degenerate case
                             -- of length 1 signed bitvectors

           digit :: SupportTermOps v => NatRepr w -> v -> Natural -> v
           digit :: forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> v -> Natural -> v
    digit NatRepr w
    w v
    x Natural
    d = v -> v -> v -> v
    forall v. SupportTermOps v => v -> v -> v -> v
    ite (NatRepr w -> Natural -> v -> v
    forall (w :: Natural). NatRepr w -> Natural -> v -> v
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w Natural
    d v
    x)
                             (Integer -> v
    forall a. Num a => Integer -> a
    fromInteger (Integer
    2Integer -> Natural -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Natural
    d))
                             v
    0

    unsupportedTerm  :: MonadFail m => Expr t tp -> m a
    unsupportedTerm :: forall (m :: Type -> Type) t (tp :: BaseType) a.
    MonadFail m =>
    Expr t tp -> m a
    unsupportedTerm Expr t tp
    e =
      String -> m a
    forall a. String -> m a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> m a) -> String -> m a
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 2) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 2) -> String) -> Doc (ZonkAny 2) -> String
    forall a b. (a -> b) -> a -> b
    $
      [Doc (ZonkAny 2)] -> Doc (ZonkAny 2)
    forall ann. [Doc ann] -> Doc ann
    vcat
      [ Doc (ZonkAny 2)
    "Cannot generate solver output for term generated at"
          Doc (ZonkAny 2) -> Doc (ZonkAny 2) -> Doc (ZonkAny 2)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Position -> Doc (ZonkAny 2)
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Position -> Doc ann
    pretty (ProgramLoc -> Position
    plSourceLoc (Expr t tp -> ProgramLoc
    forall t (tp :: BaseType). Expr t tp -> ProgramLoc
    exprLoc Expr t tp
    e)) Doc (ZonkAny 2) -> Doc (ZonkAny 2) -> Doc (ZonkAny 2)
    forall a. Semigroup a => a -> a -> a
    <> Doc (ZonkAny 2)
    ":"
      , Int -> Doc (ZonkAny 2) -> Doc (ZonkAny 2)
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    2 (Expr t tp -> Doc (ZonkAny 2)
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Expr t tp -> Doc ann
    pretty Expr t tp
    e)
      ]

    -- | Checks whether a variable is supported.
    --
    -- Returns the SMT type of the variable and a predicate (if needed) that the variable
    -- should be assumed to hold.  This is used for Natural number variables.
    checkVarTypeSupport :: ExprBoundVar n tp -> SMTCollector n h ()
    checkVarTypeSupport :: forall n (tp :: BaseType) h.
    ExprBoundVar n tp -> SMTCollector n h ()
    checkVarTypeSupport ExprBoundVar n tp
    var = do
      let t :: Expr n tp
    t = ExprBoundVar n tp -> Expr n tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
    BoundVarExpr ExprBoundVar n tp
    var
      case ExprBoundVar n tp -> BaseTypeRepr tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
    bvarType ExprBoundVar n tp
    var of
        BaseTypeRepr tp
    BaseIntegerRepr -> Expr n tp -> SMTCollector n h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr n tp
    t
        BaseTypeRepr tp
    BaseRealRepr    -> Expr n tp -> SMTCollector n h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr n tp
    t
        BaseTypeRepr tp
    BaseComplexRepr -> Expr n tp -> SMTCollector n h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr n tp
    t
        BaseStringRepr StringInfoRepr si
    _ -> Expr n tp -> SMTCollector n h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr n tp
    t
        BaseFloatRepr FloatPrecisionRepr fpp
    _  -> Expr n tp -> SMTCollector n h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkFloatSupport Expr n tp
    t
        BaseBVRepr NatRepr w
    _     -> Expr n tp -> SMTCollector n h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkBitvectorSupport Expr n tp
    t
        BaseTypeRepr tp
    _ -> () -> SMTCollector n h ()
    forall a. a -> ReaderT (SMTCollectorState n h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

    theoryUnsupported :: MonadFail m => WriterConn t h -> String -> Expr t tp -> m a
    theoryUnsupported :: forall (m :: Type -> Type) t h (tp :: BaseType) a.
    MonadFail m =>
    WriterConn t h -> String -> Expr t tp -> m a
    theoryUnsupported WriterConn t h
    conn String
    theory_name Expr t tp
    t =
      String -> m a
    forall a. String -> m a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> m a) -> String -> m a
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 1) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 1) -> String) -> Doc (ZonkAny 1) -> String
    forall a b. (a -> b) -> a -> b
    $
        String -> Doc (ZonkAny 1)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) Doc (ZonkAny 1) -> Doc (ZonkAny 1) -> Doc (ZonkAny 1)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 1)
    "does not support the" Doc (ZonkAny 1) -> Doc (ZonkAny 1) -> Doc (ZonkAny 1)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> String -> Doc (ZonkAny 1)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    theory_name
        Doc (ZonkAny 1) -> Doc (ZonkAny 1) -> Doc (ZonkAny 1)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 1)
    "term generated at" Doc (ZonkAny 1) -> Doc (ZonkAny 1) -> Doc (ZonkAny 1)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Position -> Doc (ZonkAny 1)
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Position -> Doc ann
    pretty (ProgramLoc -> Position
    plSourceLoc (Expr t tp -> ProgramLoc
    forall t (tp :: BaseType). Expr t tp -> ProgramLoc
    exprLoc Expr t tp
    t))
        -- <> ":" <$$> indent 2 (pretty t)

    checkIntegerSupport :: Expr t tp -> SMTCollector t h ()
    checkIntegerSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useIntegerArithmetic) $ do
        theoryUnsupported conn "integer arithmetic" t

    checkStringSupport :: Expr t tp -> SMTCollector t h ()
    checkStringSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useStrings) $ do
        theoryUnsupported conn "string" t

    checkBitvectorSupport :: Expr t tp -> SMTCollector t h ()
    checkBitvectorSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkBitvectorSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useBitvectors) $ do
        theoryUnsupported conn "bitvector" t

    checkFloatSupport :: Expr t tp -> SMTCollector t h ()
    checkFloatSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkFloatSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useFloatingPoint) $ do
        theoryUnsupported conn "floating-point arithmetic" t

    checkLinearSupport :: Expr t tp -> SMTCollector t h ()
    checkLinearSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useLinearArithmetic) $ do
        theoryUnsupported conn "linear arithmetic" t

    checkNonlinearSupport :: Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useNonlinearArithmetic) $ do
        theoryUnsupported conn "non-linear arithmetic" t

    checkComputableSupport :: Expr t tp -> SMTCollector t h ()
    checkComputableSupport :: forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkComputableSupport Expr t tp
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      unless (supportedFeatures conn `hasProblemFeature` useComputableReals) $ do
        theoryUnsupported conn "computable arithmetic" t

    checkQuantifierSupport :: String -> Expr t p -> SMTCollector t h ()
    checkQuantifierSupport :: forall t (p :: BaseType) h.
    String -> Expr t p -> SMTCollector t h ()
    checkQuantifierSupport String
    nm Expr t p
    t = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      when (supportQuantifiers conn == False) $ do
        theoryUnsupported conn nm t

    -- | Check that the types can be passed to functions.
    checkArgumentTypes :: WriterConn t h -> Ctx.Assignment TypeMap args -> IO ()
    checkArgumentTypes :: forall t h (args :: Ctx BaseType).
    WriterConn t h -> Assignment TypeMap args -> IO ()
    checkArgumentTypes WriterConn t h
    conn Assignment TypeMap args
    types = do
      Assignment TypeMap args
    -> (forall (x :: BaseType). TypeMap x -> IO ()) -> IO ()
    forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
           (f :: k -> Type) (c :: l) a.
    (FoldableFC t, Applicative m) =>
    t f c -> (forall (x :: k). f x -> m a) -> m ()
    forFC_ Assignment TypeMap args
    types ((forall (x :: BaseType). TypeMap x -> IO ()) -> IO ())
    -> (forall (x :: BaseType). TypeMap x -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \TypeMap x
    tp -> do
        case TypeMap x
    tp of
          FnArrayTypeMap{} | WriterConn t h -> Bool
    forall t h. WriterConn t h -> Bool
    supportFunctionArguments WriterConn t h
    conn Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    False -> do
              String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 0) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 0) -> String) -> Doc (ZonkAny 0) -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc (ZonkAny 0)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn)
                 Doc (ZonkAny 0) -> Doc (ZonkAny 0) -> Doc (ZonkAny 0)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 0)
    "does not allow arrays encoded as functions to be function arguments."
          TypeMap x
    _ ->
            () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

    -- | This generates an error message from a solver and a type error.
    --
    -- It issed for error reporting
    type SMTSource ann = String -> BaseTypeError -> Doc ann

    ppBaseTypeError :: BaseTypeError -> Doc ann
    ppBaseTypeError :: forall ann. BaseTypeError -> Doc ann
    ppBaseTypeError BaseTypeError
    ComplexTypeUnsupported = Doc ann
    "complex values"
    ppBaseTypeError BaseTypeError
    ArrayUnsupported = Doc ann
    "arrays encoded as a functions"
    ppBaseTypeError (StringTypeUnsupported (Some StringInfoRepr x
    si)) = Doc ann
    "string values" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> StringInfoRepr x -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow StringInfoRepr x
    si

    eltSource :: Expr t tp -> SMTSource ann
    eltSource :: forall t (tp :: BaseType) ann. Expr t tp -> SMTSource ann
    eltSource Expr t tp
    e String
    solver_name BaseTypeError
    cause =
      [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    vcat
      [ String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    solver_name Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
        Doc ann
    "does not support" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> BaseTypeError -> Doc ann
    forall ann. BaseTypeError -> Doc ann
    ppBaseTypeError BaseTypeError
    cause Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <>
        Doc ann
    ", and cannot interpret the term generated at" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
        Position -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Position -> Doc ann
    pretty (ProgramLoc -> Position
    plSourceLoc (Expr t tp -> ProgramLoc
    forall t (tp :: BaseType). Expr t tp -> ProgramLoc
    exprLoc Expr t tp
    e)) Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    ":"
      , Int -> Doc ann -> Doc ann
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    2 (Expr t tp -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Expr t tp -> Doc ann
    pretty Expr t tp
    e) Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    "."
      ]

    fnSource :: SolverSymbol -> ProgramLoc -> SMTSource ann
    fnSource :: forall ann. SolverSymbol -> ProgramLoc -> SMTSource ann
    fnSource SolverSymbol
    fn_name ProgramLoc
    loc String
    solver_name BaseTypeError
    cause =
      String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    solver_name Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
      Doc ann
    "does not support" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> BaseTypeError -> Doc ann
    forall ann. BaseTypeError -> Doc ann
    ppBaseTypeError BaseTypeError
    cause Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <>
      Doc ann
    ", and cannot interpret the function" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> SolverSymbol -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow SolverSymbol
    fn_name Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
      Doc ann
    "generated at" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Position -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Position -> Doc ann
    pretty (ProgramLoc -> Position
    plSourceLoc ProgramLoc
    loc) Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    "."

    -- | Evaluate a base type repr as a first class SMT type.
    --
    -- First class types are those that can be passed as function arguments and
    -- returned by functions.
    evalFirstClassTypeRepr :: MonadFail m
                           => WriterConn t h
                           -> SMTSource ann
                           -> BaseTypeRepr tp
                           -> m (TypeMap tp)
    evalFirstClassTypeRepr :: forall (m :: Type -> Type) t h ann (tp :: BaseType).
    MonadFail m =>
    WriterConn t h
    -> SMTSource ann -> BaseTypeRepr tp -> m (TypeMap tp)
    evalFirstClassTypeRepr WriterConn t h
    conn SMTSource ann
    src BaseTypeRepr tp
    base_tp =
      case WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMapFirstClass WriterConn t h
    conn BaseTypeRepr tp
    base_tp of
        Left BaseTypeError
    e -> String -> m (TypeMap tp)
    forall a. String -> m a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> m (TypeMap tp)) -> String -> m (TypeMap tp)
    forall a b. (a -> b) -> a -> b
    $ Doc ann -> String
    forall a. Show a => a -> String
    show (Doc ann -> String) -> Doc ann -> String
    forall a b. (a -> b) -> a -> b
    $ SMTSource ann
    src (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) BaseTypeError
    e
        Right TypeMap tp
    smt_ret -> TypeMap tp -> m (TypeMap tp)
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return TypeMap tp
    smt_ret

    withConnEntryStack :: WriterConn t h -> IO a -> IO a
    withConnEntryStack :: forall t h a. WriterConn t h -> IO a -> IO a
    withConnEntryStack WriterConn t h
    conn = IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (WriterConn t h -> IO ()
    forall t h. WriterConn t h -> IO ()
    pushEntryStack WriterConn t h
    conn) (WriterConn t h -> IO ()
    forall t h. WriterConn t h -> IO ()
    popEntryStack WriterConn t h
    conn)

    -- | Convert structure to list.
    mkIndexLitTerm :: SupportTermOps v
                   => IndexLit tp
                   -> v
    mkIndexLitTerm :: forall v (tp :: BaseType). SupportTermOps v => IndexLit tp -> v
    mkIndexLitTerm (IntIndexLit Integer
    i)  = Integer -> v
    forall a. Num a => Integer -> a
    fromInteger Integer
    i
    mkIndexLitTerm (BVIndexLit NatRepr w
    w BV w
    i) = NatRepr w -> BV w -> v
    forall (w :: Natural). NatRepr w -> BV w -> v
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    i

    -- | Convert structure to list.
    mkIndexLitTerms :: SupportTermOps v
                    => Ctx.Assignment IndexLit ctx
                    -> [v]
    mkIndexLitTerms :: forall v (ctx :: Ctx BaseType).
    SupportTermOps v =>
    Assignment IndexLit ctx -> [v]
    mkIndexLitTerms = (forall (x :: BaseType). IndexLit x -> v)
    -> forall (x :: Ctx BaseType). Assignment IndexLit x -> [v]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC IndexLit x -> v
    forall v (tp :: BaseType). SupportTermOps v => IndexLit tp -> v
    forall (x :: BaseType). IndexLit x -> v
    mkIndexLitTerm

    -- | Create index arguments with given type.
    --
    -- Returns the name of the argument and the type.
    createTypeMapArgsForArray :: forall t h args
                              .  WriterConn t h
                              -> Ctx.Assignment TypeMap args
                              -> IO [(Text, Some TypeMap)]
    createTypeMapArgsForArray :: forall t h (args :: Ctx BaseType).
    WriterConn t h
    -> Assignment TypeMap args -> IO [(Text, Some TypeMap)]
    createTypeMapArgsForArray WriterConn t h
    conn Assignment TypeMap args
    types = do
      -- Create names for index variables.
      let mkIndexVar :: TypeMap utp -> IO (Text, Some TypeMap)
          mkIndexVar :: forall (utp :: BaseType). TypeMap utp -> IO (Text, Some TypeMap)
    mkIndexVar TypeMap utp
    base_tp = do
            i_nm <- WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ Builder -> State WriterState Text
    freshVarName' Builder
    "i!"
            return (i_nm, Some base_tp)
      -- Get SMT arguments.
      [IO (Text, Some TypeMap)] -> IO [(Text, Some TypeMap)]
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence ([IO (Text, Some TypeMap)] -> IO [(Text, Some TypeMap)])
    -> [IO (Text, Some TypeMap)] -> IO [(Text, Some TypeMap)]
    forall a b. (a -> b) -> a -> b
    $ (forall (utp :: BaseType). TypeMap utp -> IO (Text, Some TypeMap))
    -> forall (x :: Ctx BaseType).
       Assignment TypeMap x -> [IO (Text, Some TypeMap)]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC TypeMap x -> IO (Text, Some TypeMap)
    forall (utp :: BaseType). TypeMap utp -> IO (Text, Some TypeMap)
    mkIndexVar Assignment TypeMap args
    types

    smt_array_select :: forall h idxl idx tp
                     .  SMTWriter h
                     => SMTExpr h (BaseArrayType (idxl Ctx.::> idx) tp)
                     -> [Term h]
                     -> SMTExpr h tp
    smt_array_select :: forall h (idxl :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    SMTWriter h =>
    SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    -> [Term h] -> SMTExpr h tp
    smt_array_select SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    aexpr [Term h]
    idxl =
      case SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    -> TypeMap (BaseArrayType (idxl ::> idx) tp)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    aexpr of
        PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    _ TypeMap tp
    res_type ->
          TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap tp
    res_type (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ forall h. SMTWriter h => Term h -> [Term h] -> Term h
    arraySelect @h (SMTExpr h (BaseArrayType (idxl ::> idx) tp) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    aexpr) [Term h]
    idxl
        FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    _ TypeMap tp
    res_type ->
          TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap tp
    res_type (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ Term h -> [Term h] -> Term h
    forall v. SupportTermOps v => v -> [v] -> v
    smtFnApp (SMTExpr h (BaseArrayType (idxl ::> idx) tp) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    aexpr) [Term h]
    idxl

    -- | Get name associated with symbol binding if defined, creating it if needed.
    getSymbolName :: WriterConn t h -> SymbolBinding t -> IO Text
    getSymbolName :: forall t h. WriterConn t h -> SymbolBinding t -> IO Text
    getSymbolName WriterConn t h
    conn SymbolBinding t
    b =
      case SymbolBinding t -> SymbolVarBimap t -> Maybe SolverSymbol
    forall t. SymbolBinding t -> SymbolVarBimap t -> Maybe SolverSymbol
    lookupSymbolOfBinding SymbolBinding t
    b (WriterConn t h -> SymbolVarBimap t
    forall t h. WriterConn t h -> SymbolVarBimap t
    varBindings WriterConn t h
    conn) of
        Just SolverSymbol
    sym -> Text -> IO Text
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Text -> IO Text) -> Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $! SolverSymbol -> Text
    solverSymbolAsText SolverSymbol
    sym
        Maybe SolverSymbol
    Nothing -> WriterConn t h -> State WriterState Text -> IO Text
    forall t h a. WriterConn t h -> State WriterState a -> IO a
    withWriterState WriterConn t h
    conn (State WriterState Text -> IO Text)
    -> State WriterState Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ State WriterState Text
    freshVarName

    -- | 'defineSMTFunction conn var action' will introduce a function
    --
    -- It returns the return type of the value.
    -- Note: This function is declared at a global scope.  It bypasses
    -- any subfunctions.  We need to investigate how to support nested
    -- functions.
    defineSMTFunction :: SMTWriter h
                      => WriterConn t h
                      -> Text
                      -> (FreshVarFn h -> SMTCollector t h (SMTExpr h ret))
                         -- ^ Action to generate
                      -> IO (TypeMap ret)
    defineSMTFunction :: forall h t (ret :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Text
    -> (FreshVarFn h -> SMTCollector t h (SMTExpr h ret))
    -> IO (TypeMap ret)
    defineSMTFunction WriterConn t h
    conn Text
    var FreshVarFn h -> SMTCollector t h (SMTExpr h ret)
    action =
      WriterConn t h -> IO (TypeMap ret) -> IO (TypeMap ret)
    forall t h a. WriterConn t h -> IO a -> IO a
    withConnEntryStack WriterConn t h
    conn (IO (TypeMap ret) -> IO (TypeMap ret))
    -> IO (TypeMap ret) -> IO (TypeMap ret)
    forall a b. (a -> b) -> a -> b
    $ do
        -- A list of bound terms.
        freeConstantRef <- ([(Text, Some TypeMap)] -> IO (IORef [(Text, Some TypeMap)])
    forall a. a -> IO (IORef a)
    newIORef [] :: IO (IORef [(Text, Some TypeMap)]))
        boundTermRef    <- newIORef []
        let s = SMTCollectorState { scConn :: WriterConn t h
    scConn = WriterConn t h
    conn
                                  , freshBoundTermFn :: forall (rtp :: BaseType).
    Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    freshBoundTermFn = IORef [(Text, Term h)]
    -> Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> Term h -> IO ()
    forall v (rtp :: BaseType).
    SupportTermOps v =>
    IORef [(Text, v)]
    -> Text -> [(Text, Some TypeMap)] -> TypeMap rtp -> v -> IO ()
    freshSandboxBoundTerm IORef [(Text, Term h)]
    boundTermRef
                                  , freshConstantFn :: Maybe (FreshVarFn h)
    freshConstantFn  = Maybe (FreshVarFn h)
    forall a. Maybe a
    Nothing
                                  , recordSideCondFn :: Maybe (Term h -> IO ())
    recordSideCondFn = Maybe (Term h -> IO ())
    forall a. Maybe a
    Nothing
                                  }
        -- Associate a variable with each bound variable
        let varFn = (forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp))
    -> FreshVarFn h
    forall h.
    (forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp))
    -> FreshVarFn h
    FreshVarFn (WriterConn t h
    -> IORef [(Text, Some TypeMap)] -> TypeMap tp -> IO (SMTExpr h tp)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> IORef [(Text, Some TypeMap)] -> TypeMap tp -> IO (SMTExpr h tp)
    freshSandboxConstant WriterConn t h
    conn IORef [(Text, Some TypeMap)]
    freeConstantRef)
        pair <- flip runReaderT s (action varFn)

        args       <- readIORef freeConstantRef
        boundTerms <- readIORef boundTermRef

        let res = [(Text, Term h)] -> Term h -> Term h
    forall v. SupportTermOps v => [(Text, v)] -> v -> v
    letExpr ([(Text, Term h)] -> [(Text, Term h)]
    forall a. [a] -> [a]
    reverse [(Text, Term h)]
    boundTerms) (SMTExpr h ret -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ret
    pair)

        defineSMTVar conn FunctionDefinition var (reverse args) (smtExprType pair) res
        return $! smtExprType pair

    ------------------------------------------------------------------------
    -- Mutually recursive functions for translating What4 expressions to SMTLIB definitions.

    -- | Convert an expression into a SMT Expression.
    mkExpr :: forall h t tp. SMTWriter h => Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr :: forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr (BoolExpr Bool
    b ProgramLoc
    _) =
      SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap BaseBoolType
    BoolTypeMap (Bool -> Term h
    forall v. SupportTermOps v => Bool -> v
    boolExpr Bool
    b))
    mkExpr t :: Expr t tp
    t@(SemiRingLiteral SemiRingRepr sr
    SR.SemiRingIntegerRepr Coefficient sr
    i ProgramLoc
    _) = do
      Expr t tp -> SMTCollector t h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr t tp
    t
      SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap 'BaseIntegerType
    IntegerTypeMap (Integer -> Term h
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    Coefficient sr
    i))
    mkExpr t :: Expr t tp
    t@(SemiRingLiteral SemiRingRepr sr
    SR.SemiRingRealRepr Coefficient sr
    r ProgramLoc
    _) = do
      Expr t tp -> SMTCollector t h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr t tp
    t
      SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap (Rational -> Term h
    forall v. SupportTermOps v => Rational -> v
    rationalTerm Rational
    Coefficient sr
    r))
    mkExpr t :: Expr t tp
    t@(SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
    _flv NatRepr w
    w) Coefficient sr
    x ProgramLoc
    _) = do
      Expr t tp -> SMTCollector t h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkBitvectorSupport Expr t tp
    t
      SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> SMTExpr h tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr (NatRepr w -> TypeMap (BaseBVType w)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr w
    w) (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    Coefficient sr
    x
    mkExpr t :: Expr t tp
    t@(FloatExpr FloatPrecisionRepr fpp
    fpp BigFloat
    f ProgramLoc
    _) = do
      Expr t tp -> SMTCollector t h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkFloatSupport Expr t tp
    t
      SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> SMTExpr h tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr (FloatPrecisionRepr fpp -> TypeMap ('BaseFloatType fpp)
    forall (idx :: FloatPrecision).
    FloatPrecisionRepr idx -> TypeMap (BaseFloatType idx)
    FloatTypeMap FloatPrecisionRepr fpp
    fpp) (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ FloatPrecisionRepr fpp -> BigFloat -> Term h
    forall v (fpp :: FloatPrecision).
    SupportTermOps v =>
    FloatPrecisionRepr fpp -> BigFloat -> v
    forall (fpp :: FloatPrecision).
    FloatPrecisionRepr fpp -> BigFloat -> Term h
    floatTerm FloatPrecisionRepr fpp
    fpp BigFloat
    f
    mkExpr t :: Expr t tp
    t@(StringExpr StringLiteral si
    l ProgramLoc
    _) =
      case StringLiteral si
    l of
        UnicodeLiteral Text
    str -> do
          Expr t tp -> SMTCollector t h ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    t
          SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> SMTExpr h tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap ('BaseStringType Unicode)
    UnicodeTypeMap (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ forall h. SMTWriter h => Text -> Term h
    stringTerm @h Text
    str
        StringLiteral si
    _ -> do
          conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
          theoryUnsupported conn ("strings " ++ show (stringLiteralInfo l)) t

    mkExpr (NonceAppExpr NonceAppExpr t tp
    ea) =
      Nonce t tp
    -> TermLifetime
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall t (tp :: BaseType) h.
    Nonce t tp
    -> TermLifetime
    -> SMTCollector t h (SMTExpr h tp)
    -> SMTCollector t h (SMTExpr h tp)
    cacheWriterResult (NonceAppExpr t tp -> Nonce t tp
    forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
    nonceExprId NonceAppExpr t tp
    ea) TermLifetime
    DeleteOnPop (ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
     -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $
        NonceAppExpr t tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall t h (tp :: BaseType).
    SMTWriter h =>
    NonceAppExpr t tp -> SMTCollector t h (SMTExpr h tp)
    predSMTExpr NonceAppExpr t tp
    ea
    mkExpr (AppExpr AppExpr t tp
    ea) =
      Nonce t tp
    -> TermLifetime
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall t (tp :: BaseType) h.
    Nonce t tp
    -> TermLifetime
    -> SMTCollector t h (SMTExpr h tp)
    -> SMTCollector t h (SMTExpr h tp)
    cacheWriterResult (AppExpr t tp -> Nonce t tp
    forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
    appExprId AppExpr t tp
    ea) TermLifetime
    DeleteOnPop (ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
     -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ do
        AppExpr t tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall t h (tp :: BaseType).
    SMTWriter h =>
    AppExpr t tp -> SMTCollector t h (SMTExpr h tp)
    appSMTExpr AppExpr t tp
    ea
    mkExpr (BoundVarExpr ExprBoundVar t tp
    var) = do
      case ExprBoundVar t tp -> VarKind
    forall t (tp :: BaseType). ExprBoundVar t tp -> VarKind
    bvarKind ExprBoundVar t tp
    var of
       VarKind
    QuantifierVarKind -> do
         conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
         mr <- liftIO $ cacheLookupExpr conn (bvarId var)
         case mr of
          Just SMTExpr h tp
    x -> SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return SMTExpr h tp
    x
          Maybe (SMTExpr h tp)
    Nothing -> do
            String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error in SMTLIB exporter due to unbound variable "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Nonce t tp -> String
    forall a. Show a => a -> String
    show (ExprBoundVar t tp -> Nonce t tp
    forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
    bvarId ExprBoundVar t tp
    var) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " defined at "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Position -> String
    forall a. Show a => a -> String
    show (ProgramLoc -> Position
    plSourceLoc (ExprBoundVar t tp -> ProgramLoc
    forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
    bvarLoc ExprBoundVar t tp
    var)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."
       VarKind
    LatchVarKind ->
         String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String
    "SMTLib exporter does not support the latch defined at "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Position -> String
    forall a. Show a => a -> String
    show (ProgramLoc -> Position
    plSourceLoc (ExprBoundVar t tp -> ProgramLoc
    forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
    bvarLoc ExprBoundVar t tp
    var)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."
       VarKind
    UninterpVarKind -> do
         conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
         cacheWriterResult (bvarId var) DeleteNever $ do
           checkVarTypeSupport var
           -- Use predefined var name if it has not been defined.
           var_name <- liftIO $ getSymbolName conn (VarSymbolBinding var)

           smt_type <- getBaseSMT_Type var

           liftIO $
             do declareTypes conn smt_type
                addCommand conn $ declareCommand conn var_name Ctx.empty smt_type

           -- Add assertion based on var type.
           addPartialSideCond conn (fromText var_name) smt_type (bvarAbstractValue var)

           -- Return variable name
           return $ SMTName smt_type var_name

    -- | Convert an element to a base expression.
    mkBaseExpr :: SMTWriter h => Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr :: forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e = SMTExpr h tp -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase (SMTExpr h tp -> Term h)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t tp
    e
    {-# INLINE mkBaseExpr #-}

    -- | Convert structure to list.
    mkIndicesTerms :: SMTWriter h
                   => Ctx.Assignment (Expr t) ctx
                   -> SMTCollector t h [Term h]
    mkIndicesTerms :: forall h t (ctx :: Ctx BaseType).
    SMTWriter h =>
    Assignment (Expr t) ctx -> SMTCollector t h [Term h]
    mkIndicesTerms = (forall (x :: BaseType).
     Expr t x
     -> ReaderT (SMTCollectorState t h) IO [Term h]
     -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> forall (x :: Ctx BaseType).
       ReaderT (SMTCollectorState t h) IO [Term h]
       -> Assignment (Expr t) x
       -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) b.
    FoldableFC t =>
    (forall (x :: k). f x -> b -> b)
    -> forall (x :: l). b -> t f x -> b
    forall (f :: BaseType -> Type) b.
    (forall (x :: BaseType). f x -> b -> b)
    -> forall (x :: Ctx BaseType). b -> Assignment f x -> b
    foldrFC (\Expr t x
    e ReaderT (SMTCollectorState t h) IO [Term h]
    r -> (:) (Term h -> [Term h] -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO ([Term h] -> [Term h])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t x -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t x
    e ReaderT (SMTCollectorState t h) IO ([Term h] -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a b.
    ReaderT (SMTCollectorState t h) IO (a -> b)
    -> ReaderT (SMTCollectorState t h) IO a
    -> ReaderT (SMTCollectorState t h) IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> ReaderT (SMTCollectorState t h) IO [Term h]
    r) ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [])

    predSMTExpr :: forall t h tp
                 . SMTWriter h
                => NonceAppExpr t tp
                -> SMTCollector t h (SMTExpr h tp)
    predSMTExpr :: forall t h (tp :: BaseType).
    SMTWriter h =>
    NonceAppExpr t tp -> SMTCollector t h (SMTExpr h tp)
    predSMTExpr NonceAppExpr t tp
    e0 = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      let i = NonceAppExpr t tp -> Expr t tp
    forall t (tp :: BaseType). NonceAppExpr t tp -> Expr t tp
    NonceAppExpr NonceAppExpr t tp
    e0
      h <- asks scConn
      liftIO $ updateProgramLoc h (nonceExprLoc e0)
      case nonceExprApp e0 of
        Annotation BaseTypeRepr tp
    _tpr Nonce t tp
    _n Expr t tp
    e -> Expr t tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t tp
    e
        Forall ExprBoundVar t tp1
    var Expr t BaseBoolType
    e -> do
          String -> Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (p :: BaseType) h.
    String -> Expr t p -> SMTCollector t h ()
    checkQuantifierSupport String
    "universal quantifier" Expr t tp
    i

          smtType <- ExprBoundVar t tp1 -> SMTCollector t h (TypeMap tp1)
    forall t (tp :: BaseType) h.
    ExprBoundVar t tp -> SMTCollector t h (TypeMap tp)
    getBaseSMT_Type ExprBoundVar t tp1
    var
          liftIO $ declareTypes h smtType

          cr <- liftIO $ withConnEntryStack conn $ do
            runInSandbox conn $ do
              checkVarTypeSupport var

              Just (FreshVarFn f) <- asks freshConstantFn
              t <- liftIO $ f smtType
              bindVar var t

              addPartialSideCond conn (asBase t) smtType (bvarAbstractValue var)
              mkBaseExpr e
          freshBoundTerm BoolTypeMap $ forallResult cr
        Exists ExprBoundVar t tp1
    var Expr t BaseBoolType
    e -> do
          String -> Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (p :: BaseType) h.
    String -> Expr t p -> SMTCollector t h ()
    checkQuantifierSupport String
    "existential quantifiers" Expr t tp
    i

          smtType <- ExprBoundVar t tp1 -> SMTCollector t h (TypeMap tp1)
    forall t (tp :: BaseType) h.
    ExprBoundVar t tp -> SMTCollector t h (TypeMap tp)
    getBaseSMT_Type ExprBoundVar t tp1
    var
          liftIO $ declareTypes h smtType

          cr <- liftIO $ withConnEntryStack conn $ do
            runInSandbox conn $ do
              checkVarTypeSupport var

              Just (FreshVarFn f) <- asks freshConstantFn
              t <- liftIO $ f smtType
              bindVar var t

              addPartialSideCond conn (asBase t) smtType (bvarAbstractValue var)
              mkBaseExpr e
          freshBoundTerm BoolTypeMap $ existsResult cr

        ArrayFromFn ExprSymFn t (idx ::> itp) ret
    f -> do
          -- Evaluate arg types
          smt_arg_types <-
            (forall (x :: BaseType).
     BaseTypeRepr x -> ReaderT (SMTCollectorState t h) IO (TypeMap x))
    -> forall (x :: Ctx BaseType).
       Assignment BaseTypeRepr x
       -> ReaderT (SMTCollectorState t h) IO (Assignment TypeMap x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC (WriterConn t h
    -> SMTSource (ZonkAny 9)
    -> BaseTypeRepr x
    -> ReaderT (SMTCollectorState t h) IO (TypeMap x)
    forall (m :: Type -> Type) t h ann (tp :: BaseType).
    MonadFail m =>
    WriterConn t h
    -> SMTSource ann -> BaseTypeRepr tp -> m (TypeMap tp)
    evalFirstClassTypeRepr WriterConn t h
    conn (Expr t tp -> SMTSource (ZonkAny 9)
    forall t (tp :: BaseType) ann. Expr t tp -> SMTSource ann
    eltSource Expr t tp
    i))
                       (ExprSymFn t (idx ::> itp) ret
    -> Assignment BaseTypeRepr (idx ::> itp)
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> Assignment BaseTypeRepr args
    symFnArgTypes ExprSymFn t (idx ::> itp) ret
    f)
          -- Evaluate simple function
          (smt_f, ret_tp) <- liftIO $ getSMTSymFn conn f smt_arg_types

          let array_tp = Assignment TypeMap (idx ::> itp)
    -> TypeMap ret -> TypeMap ('BaseArrayType (idx ::> itp) ret)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    FnArrayTypeMap Assignment TypeMap (idx ::> itp)
    smt_arg_types TypeMap ret
    ret_tp
          return $! SMTName array_tp smt_f

        MapOverArrays ExprSymFn t (ctx ::> d) r
    f Assignment BaseTypeRepr (idx ::> itp)
    idx_types Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
    arrays -> do
          -- :: Ctx.Assignment (ArrayResultWrapper (Expr t) (idx Ctx.::> itp)) ctx)  -> do
          -- Evaluate arg types for indices.

          smt_idx_types <- (forall (x :: BaseType).
     BaseTypeRepr x -> ReaderT (SMTCollectorState t h) IO (TypeMap x))
    -> forall (x :: Ctx BaseType).
       Assignment BaseTypeRepr x
       -> ReaderT (SMTCollectorState t h) IO (Assignment TypeMap x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC (WriterConn t h
    -> SMTSource (ZonkAny 10)
    -> BaseTypeRepr x
    -> ReaderT (SMTCollectorState t h) IO (TypeMap x)
    forall (m :: Type -> Type) t h ann (tp :: BaseType).
    MonadFail m =>
    WriterConn t h
    -> SMTSource ann -> BaseTypeRepr tp -> m (TypeMap tp)
    evalFirstClassTypeRepr WriterConn t h
    conn (Expr t tp -> SMTSource (ZonkAny 10)
    forall t (tp :: BaseType) ann. Expr t tp -> SMTSource ann
    eltSource Expr t tp
    i)) Assignment BaseTypeRepr (idx ::> itp)
    idx_types

          let evalArray :: forall idx itp etp
                         . ArrayResultWrapper (Expr t) (idx Ctx.::> itp) etp
                         -> SMTCollector t h (ArrayResultWrapper (SMTExpr h) (idx Ctx.::> itp) etp)
              evalArray (ArrayResultWrapper Expr t (BaseArrayType (idx ::> itp) etp)
    a) = SMTExpr h (BaseArrayType (idx ::> itp) etp)
    -> ArrayResultWrapper (SMTExpr h) (idx ::> itp) etp
    forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
           (tp :: BaseType).
    f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
    ArrayResultWrapper (SMTExpr h (BaseArrayType (idx ::> itp) etp)
     -> ArrayResultWrapper (SMTExpr h) (idx ::> itp) etp)
    -> ReaderT
         (SMTCollectorState t h)
         IO
         (SMTExpr h (BaseArrayType (idx ::> itp) etp))
    -> ReaderT
         (SMTCollectorState t h)
         IO
         (ArrayResultWrapper (SMTExpr h) (idx ::> itp) etp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t (BaseArrayType (idx ::> itp) etp)
    -> ReaderT
         (SMTCollectorState t h)
         IO
         (SMTExpr h (BaseArrayType (idx ::> itp) etp))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t (BaseArrayType (idx ::> itp) etp)
    a

          smt_arrays <- traverseFC evalArray arrays

          liftIO $ do

          -- Create name of function to reutrn.
          nm <- liftIO $ withWriterState conn $ freshVarName

          ret_type <-
            defineSMTFunction conn nm $ \(FreshVarFn forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp)
    freshVar) -> do
              -- Create type for indices.
              smt_indices <- (forall (x :: BaseType).
     TypeMap x -> ReaderT (SMTCollectorState t h) IO (SMTExpr h x))
    -> forall (x :: Ctx BaseType).
       Assignment TypeMap x
       -> ReaderT (SMTCollectorState t h) IO (Assignment (SMTExpr h) x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC (\TypeMap x
    tp -> IO (SMTExpr h x)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h x)
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (TypeMap x -> IO (SMTExpr h x)
    forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp)
    freshVar TypeMap x
    tp)) Assignment TypeMap (idx ::> itp)
    smt_idx_types

              let idxl = (forall (x :: BaseType). SMTExpr h x -> Term h)
    -> forall (x :: Ctx BaseType). Assignment (SMTExpr h) x -> [Term h]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC SMTExpr h x -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    forall (x :: BaseType). SMTExpr h x -> Term h
    asBase Assignment (SMTExpr h) (idx ::> itp)
    smt_indices
              let select :: forall  idxl idx etp
                         .  ArrayResultWrapper (SMTExpr h) (idxl Ctx.::> idx) etp
                         -> SMTExpr h etp
                  select (ArrayResultWrapper SMTExpr h (BaseArrayType (idxl ::> idx) etp)
    a) = SMTExpr h (BaseArrayType (idxl ::> idx) etp)
    -> [Term h] -> SMTExpr h etp
    forall h (idxl :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    SMTWriter h =>
    SMTExpr h (BaseArrayType (idxl ::> idx) tp)
    -> [Term h] -> SMTExpr h tp
    smt_array_select SMTExpr h (BaseArrayType (idxl ::> idx) etp)
    a [Term h]
    idxl
              let array_vals = (forall (x :: BaseType).
     ArrayResultWrapper (SMTExpr h) (idx ::> itp) x -> SMTExpr h x)
    -> forall (x :: Ctx BaseType).
       Assignment (ArrayResultWrapper (SMTExpr h) (idx ::> itp)) x
       -> Assignment (SMTExpr h) x
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type).
    FunctorFC t =>
    (forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
    forall (f :: BaseType -> Type) (g :: BaseType -> Type).
    (forall (x :: BaseType). f x -> g x)
    -> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
    fmapFC ArrayResultWrapper (SMTExpr h) (idx ::> itp) x -> SMTExpr h x
    forall (idxl :: Ctx BaseType) (idx :: BaseType) (etp :: BaseType).
    ArrayResultWrapper (SMTExpr h) (idxl ::> idx) etp -> SMTExpr h etp
    forall (x :: BaseType).
    ArrayResultWrapper (SMTExpr h) (idx ::> itp) x -> SMTExpr h x
    select Assignment
      (ArrayResultWrapper (SMTExpr h) (idx ::> itp)) (ctx ::> d)
    smt_arrays

              (smt_f, ret_type) <- liftIO $ getSMTSymFn conn f (fmapFC smtExprType array_vals)

              return $ SMTExpr ret_type $ smtFnApp (fromText smt_f) (toListFC asBase array_vals)

          let array_tp = Assignment TypeMap (idx ::> itp)
    -> TypeMap r -> TypeMap ('BaseArrayType (idx ::> itp) r)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    FnArrayTypeMap Assignment TypeMap (idx ::> itp)
    smt_idx_types TypeMap r
    ret_type
          return $! SMTName array_tp nm

        ArrayTrueOnEntries{} -> do
          String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String
    "SMTWriter does not yet support ArrayTrueOnEntries.\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Expr t tp -> String
    forall a. Show a => a -> String
    show Expr t tp
    i

        FnApp ExprSymFn t args tp
    f Assignment (Expr t) args
    args -> do
          smt_args <- (forall (x :: BaseType).
     Expr t x -> ReaderT (SMTCollectorState t h) IO (SMTExpr h x))
    -> forall (x :: Ctx BaseType).
       Assignment (Expr t) x
       -> ReaderT (SMTCollectorState t h) IO (Assignment (SMTExpr h) x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC Expr t x -> SMTCollector t h (SMTExpr h x)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    forall (x :: BaseType).
    Expr t x -> ReaderT (SMTCollectorState t h) IO (SMTExpr h x)
    mkExpr Assignment (Expr t) args
    args
          (smt_f, ret_type) <- liftIO $ getSMTSymFn conn f (fmapFC smtExprType smt_args)
          freshBoundTerm ret_type $! smtFnApp (fromText smt_f) (toListFC asBase smt_args)

    appSMTExpr :: forall t h tp
                . SMTWriter h
               => AppExpr t tp
               -> SMTCollector t h (SMTExpr h tp)
    appSMTExpr :: forall t h (tp :: BaseType).
    SMTWriter h =>
    AppExpr t tp -> SMTCollector t h (SMTExpr h tp)
    appSMTExpr AppExpr t tp
    ae = do
      conn <- (SMTCollectorState t h -> WriterConn t h)
    -> ReaderT (SMTCollectorState t h) IO (WriterConn t h)
    forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
    asks SMTCollectorState t h -> WriterConn t h
    forall t h. SMTCollectorState t h -> WriterConn t h
    scConn
      let i = AppExpr t tp -> Expr t tp
    forall t (tp :: BaseType). AppExpr t tp -> Expr t tp
    AppExpr AppExpr t tp
    ae
      liftIO $ updateProgramLoc conn (appExprLoc ae)
      case appExprApp ae of

        BaseEq BaseTypeRepr tp1
    _ Expr t tp1
    x Expr t tp1
    y ->
          do xe <- Expr t tp1 -> SMTCollector t h (SMTExpr h tp1)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t tp1
    x
             ye <- mkExpr y

             let xtp = SMTExpr h tp1 -> TypeMap tp1
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h tp1
    xe
             let ytp = SMTExpr h tp1 -> TypeMap tp1
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h tp1
    ye

             let checkArrayType Expr t tp1
    z (FnArrayTypeMap{}) = do
                   String -> ReaderT (SMTCollectorState t h) IO ()
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO ())
    -> String -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 12) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 12) -> String) -> Doc (ZonkAny 12) -> String
    forall a b. (a -> b) -> a -> b
    $
                     [Doc (ZonkAny 12)] -> Doc (ZonkAny 12)
    forall ann. [Doc ann] -> Doc ann
    vcat
                     [ String -> Doc (ZonkAny 12)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) Doc (ZonkAny 12) -> Doc (ZonkAny 12) -> Doc (ZonkAny 12)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
                       Doc (ZonkAny 12)
    "does not support checking equality for the array generated at"
                       Doc (ZonkAny 12) -> Doc (ZonkAny 12) -> Doc (ZonkAny 12)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Position -> Doc (ZonkAny 12)
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Position -> Doc ann
    pretty (ProgramLoc -> Position
    plSourceLoc (Expr t tp1 -> ProgramLoc
    forall t (tp :: BaseType). Expr t tp -> ProgramLoc
    exprLoc Expr t tp1
    z)) Doc (ZonkAny 12) -> Doc (ZonkAny 12) -> Doc (ZonkAny 12)
    forall a. Semigroup a => a -> a -> a
    <> Doc (ZonkAny 12)
    ":"
                     , Int -> Doc (ZonkAny 12) -> Doc (ZonkAny 12)
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    2 (Expr t ('BaseArrayType (idxl ::> idx) tp) -> Doc (ZonkAny 12)
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Expr t ('BaseArrayType (idxl ::> idx) tp) -> Doc ann
    pretty Expr t tp1
    Expr t ('BaseArrayType (idxl ::> idx) tp)
    z)
                     ]
                 checkArrayType Expr t tp1
    _ TypeMap tp1
    _ = () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

             checkArrayType x xtp
             checkArrayType y ytp

             when (xtp /= ytp) $ do
               fail $ unwords ["Type representations are not equal:", show xtp, show ytp]

             freshBoundTerm BoolTypeMap $ asBase xe .== asBase ye

        BaseIte BaseTypeRepr tp
    btp Integer
    _ Expr t BaseBoolType
    c Expr t tp
    x Expr t tp
    y -> do
          let errMsg :: String -> String
    errMsg String
    typename =
               Doc (ZonkAny 11) -> String
    forall a. Show a => a -> String
    show
                 (Doc (ZonkAny 11) -> String) -> Doc (ZonkAny 11) -> String
    forall a b. (a -> b) -> a -> b
    $   Doc (ZonkAny 11)
    "we do not support if/then/else expressions at type"
                 Doc (ZonkAny 11) -> Doc (ZonkAny 11) -> Doc (ZonkAny 11)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> String -> Doc (ZonkAny 11)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    typename
                 Doc (ZonkAny 11) -> Doc (ZonkAny 11) -> Doc (ZonkAny 11)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc (ZonkAny 11)
    "with solver"
                 Doc (ZonkAny 11) -> Doc (ZonkAny 11) -> Doc (ZonkAny 11)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> String -> Doc (ZonkAny 11)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) Doc (ZonkAny 11) -> Doc (ZonkAny 11) -> Doc (ZonkAny 11)
    forall a. Semigroup a => a -> a -> a
    <> Doc (ZonkAny 11)
    "."
          case WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    forall t h (tp :: BaseType).
    WriterConn t h
    -> BaseTypeRepr tp -> Either BaseTypeError (TypeMap tp)
    typeMap WriterConn t h
    conn BaseTypeRepr tp
    btp of
            Left  (StringTypeUnsupported (Some StringInfoRepr x
    si)) -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg (String
    "string " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ StringInfoRepr x -> String
    forall a. Show a => a -> String
    show StringInfoRepr x
    si)
            Left  BaseTypeError
    ComplexTypeUnsupported -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg String
    "complex"
            Left  BaseTypeError
    ArrayUnsupported       -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg String
    "array"
            Right FnArrayTypeMap{}       -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    errMsg String
    "function-backed array"
            Right TypeMap tp
    tym ->
              do cb <- Expr t BaseBoolType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t BaseBoolType
    c
                 xb <- mkBaseExpr x
                 yb <- mkBaseExpr y
                 freshBoundTerm tym $ ite cb xb yb

        SemiRingLe OrderedSemiRingRepr sr
    _sr Expr t (SemiRingBase sr)
    x Expr t (SemiRingBase sr)
    y -> do
          xb <- Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (SemiRingBase sr)
    x
          yb <- mkBaseExpr y
          freshBoundTerm BoolTypeMap $ xb .<= yb

        RealIsInteger Expr t 'BaseRealType
    r -> do
          rb <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    r
          freshBoundTerm BoolTypeMap $! realIsInteger rb

        BVTestBit Natural
    n Expr t (BaseBVType w)
    xe -> do
          x <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    xe
          let this_bit = NatRepr w -> Natural -> Natural -> Term h -> Term h
    forall (w :: Natural).
    NatRepr w -> Natural -> Natural -> Term h -> Term h
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> Natural -> v -> v
    bvExtract (Expr t (BaseBVType w) -> NatRepr w
    forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
    forall (e :: BaseType -> Type) (w :: Natural).
    IsExpr e =>
    e (BaseBVType w) -> NatRepr w
    bvWidth Expr t (BaseBVType w)
    xe) Natural
    n Natural
    1 Term h
    x
              one = NatRepr 1 -> BV 1 -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm (NatRepr 1
    forall (n :: Natural). KnownNat n => NatRepr n
    knownNat :: NatRepr 1) (NatRepr 1 -> BV 1
    forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
    BV.one NatRepr 1
    forall (n :: Natural). KnownNat n => NatRepr n
    knownNat)
          freshBoundTerm BoolTypeMap $ this_bit .== one
        BVSlt Expr t (BaseBVType w)
    xe Expr t (BaseBVType w)
    ye -> do
          x <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm BoolTypeMap $ x `bvSLt` y
        BVUlt Expr t (BaseBVType w)
    xe Expr t (BaseBVType w)
    ye -> do
          x <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm BoolTypeMap $ x `bvULt` y

        IntDiv Expr t 'BaseIntegerType
    xe Expr t 'BaseIntegerType
    ye -> do
          case Expr t 'BaseIntegerType
    ye of
            SemiRingLiteral SemiRingRepr sr
    _ Coefficient sr
    _ ProgramLoc
    _ -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
            Expr t 'BaseIntegerType
    _ -> Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport Expr t tp
    i

          x <- Expr t 'BaseIntegerType
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseIntegerType
    xe
          y <- mkBaseExpr ye

          freshBoundTerm IntegerTypeMap (intDiv x y)

        IntMod Expr t 'BaseIntegerType
    xe Expr t 'BaseIntegerType
    ye -> do
          case Expr t 'BaseIntegerType
    ye of
            SemiRingLiteral SemiRingRepr sr
    _ Coefficient sr
    _ ProgramLoc
    _ -> () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
            Expr t 'BaseIntegerType
    _ -> Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport Expr t tp
    i

          x <- Expr t 'BaseIntegerType
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseIntegerType
    xe
          y <- mkBaseExpr ye

          freshBoundTerm IntegerTypeMap (intMod x y)

        IntAbs Expr t 'BaseIntegerType
    xe -> do
          x <- Expr t 'BaseIntegerType
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseIntegerType
    xe
          freshBoundTerm IntegerTypeMap (intAbs x)

        IntDivisible Expr t 'BaseIntegerType
    xe Natural
    k -> do
          x <- Expr t 'BaseIntegerType
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseIntegerType
    xe
          freshBoundTerm BoolTypeMap (intDivisible x k)

        NotPred Expr t BaseBoolType
    x -> TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap BaseBoolType
    BoolTypeMap (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> (Term h -> Term h)
    -> Term h
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term h -> Term h
    forall v. SupportTermOps v => v -> v
    notExpr (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr t BaseBoolType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t BaseBoolType
    x

        ConjPred BoolMap (Expr t)
    xs ->
          let pol :: (Expr t tp, Polarity) -> SMTCollector t h (Term h)
    pol (Expr t tp
    x,Polarity
    Positive) = Expr t tp -> SMTCollector t h (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    x
              pol (Expr t tp
    x,Polarity
    Negative) = Term h -> Term h
    forall v. SupportTermOps v => v -> v
    notExpr (Term h -> Term h)
    -> SMTCollector t h (Term h) -> SMTCollector t h (Term h)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> SMTCollector t h (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    x
          in
          case BoolMap (Expr t) -> BoolMapView (Expr t)
    forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
    BM.viewBoolMap BoolMap (Expr t)
    xs of
            BoolMapView (Expr t)
    BM.BoolMapUnit ->
              SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> SMTExpr h tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap BaseBoolType
    BoolTypeMap (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ Bool -> Term h
    forall v. SupportTermOps v => Bool -> v
    boolExpr Bool
    True
            BoolMapView (Expr t)
    BM.BoolMapDualUnit ->
              SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (SMTExpr h tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> SMTExpr h tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap BaseBoolType
    BoolTypeMap (Term h -> SMTExpr h tp) -> Term h -> SMTExpr h tp
    forall a b. (a -> b) -> a -> b
    $ Bool -> Term h
    forall v. SupportTermOps v => Bool -> v
    boolExpr Bool
    False
            BM.BoolMapTerms ((Expr t BaseBoolType, Polarity)
    t:|[]) ->
              TypeMap tp -> Term h -> SMTExpr h tp
    forall (tp :: BaseType) h. TypeMap tp -> Term h -> SMTExpr h tp
    SMTExpr TypeMap tp
    TypeMap BaseBoolType
    BoolTypeMap (Term h -> SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Expr t BaseBoolType, Polarity)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall {h} {t} {tp :: BaseType}.
    SMTWriter h =>
    (Expr t tp, Polarity) -> SMTCollector t h (Term h)
    pol (Expr t BaseBoolType, Polarity)
    t
            BM.BoolMapTerms ((Expr t BaseBoolType, Polarity)
    t:|[(Expr t BaseBoolType, Polarity)]
    ts) ->
              do cnj <- [Term h] -> Term h
    forall v. SupportTermOps v => [v] -> v
    andAll ([Term h] -> Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Expr t BaseBoolType, Polarity)
     -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> [(Expr t BaseBoolType, Polarity)]
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM (Expr t BaseBoolType, Polarity)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall {h} {t} {tp :: BaseType}.
    SMTWriter h =>
    (Expr t tp, Polarity) -> SMTCollector t h (Term h)
    pol ((Expr t BaseBoolType, Polarity)
    t(Expr t BaseBoolType, Polarity)
    -> [(Expr t BaseBoolType, Polarity)]
    -> [(Expr t BaseBoolType, Polarity)]
    forall a. a -> [a] -> [a]
    :[(Expr t BaseBoolType, Polarity)]
    ts)
                 freshBoundTerm BoolTypeMap cnj

        ------------------------------------------
        -- Real operations.

        SemiRingProd SemiRingProduct (Expr t) sr
    pd ->
          case SemiRingProduct (Expr t) sr -> SemiRingRepr sr
    forall (f :: BaseType -> Type) (sr :: SemiRing).
    SemiRingProduct f sr -> SemiRingRepr sr
    WSum.prodRepr SemiRingProduct (Expr t) sr
    pd of
            SR.SemiRingBVRepr BVFlavorRepr fv
    SR.BVArithRepr NatRepr w
    w ->
              do pd' <- (Term h -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> (Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> SemiRingProduct (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO (Maybe (Term h))
    forall (m :: Type -> Type) r (f :: BaseType -> Type)
           (sr :: SemiRing).
    Monad m =>
    (r -> r -> m r)
    -> (f (SemiRingBase sr) -> m r)
    -> SemiRingProduct f sr
    -> m (Maybe r)
    WSum.prodEvalM (\Term h
    a Term h
    b -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvMul Term h
    a Term h
    b)) Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr SemiRingProduct (Expr t) sr
    pd
                 maybe (return $ SMTExpr (BVTypeMap w) $ bvTerm w (BV.one w))
                       (freshBoundTerm (BVTypeMap w))
                       pd'

            SR.SemiRingBVRepr BVFlavorRepr fv
    SR.BVBitsRepr NatRepr w
    w ->
              do pd' <- (Term h -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> (Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> SemiRingProduct (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO (Maybe (Term h))
    forall (m :: Type -> Type) r (f :: BaseType -> Type)
           (sr :: SemiRing).
    Monad m =>
    (r -> r -> m r)
    -> (f (SemiRingBase sr) -> m r)
    -> SemiRingProduct f sr
    -> m (Maybe r)
    WSum.prodEvalM (\Term h
    a Term h
    b -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvAnd Term h
    a Term h
    b)) Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr SemiRingProduct (Expr t) sr
    pd
                 maybe (return $ SMTExpr (BVTypeMap w) $ bvTerm w (BV.maxUnsigned w))
                       (freshBoundTerm (BVTypeMap w))
                       pd'
            SemiRingRepr sr
    sr ->
              do Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport Expr t tp
    i
                 pd' <- (Term h -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> (Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> SemiRingProduct (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO (Maybe (Term h))
    forall (m :: Type -> Type) r (f :: BaseType -> Type)
           (sr :: SemiRing).
    Monad m =>
    (r -> r -> m r)
    -> (f (SemiRingBase sr) -> m r)
    -> SemiRingProduct f sr
    -> m (Maybe r)
    WSum.prodEvalM (\Term h
    a Term h
    b -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Term h
    a Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    * Term h
    b)) Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr SemiRingProduct (Expr t) sr
    pd
                 maybe (return $ SMTExpr (semiRingTypeMap sr) $ integerTerm 1)
                       (freshBoundTerm (semiRingTypeMap sr))
                       pd'

        SemiRingSum WeightedSum (Expr t) sr
    s ->
          case WeightedSum (Expr t) sr -> SemiRingRepr sr
    forall (f :: BaseType -> Type) (sr :: SemiRing).
    WeightedSum f sr -> SemiRingRepr sr
    WSum.sumRepr WeightedSum (Expr t) sr
    s of
            SemiRingRepr sr
    SR.SemiRingIntegerRepr ->
              let smul :: Integer -> Expr t tp -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul Integer
    c Expr t tp
    e
                    | Integer
    c Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  Integer
    1   = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e
                    | Integer
    c Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Integer
    1   = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term h -> Term h
    forall a. Num a => a -> a
    negate (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e
                    | Bool
    otherwise = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Term h
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    c Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e
                  cnst :: Integer -> [a]
    cnst Integer
    0 = []
                  cnst Integer
    x = [Integer -> a
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    x]
                  add :: [a] -> [a] -> f [a]
    add [a]
    x [a]
    y = [a] -> f [a]
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([a]
    y [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    x) -- reversed for efficiency when grouped to the left
              in
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseIntegerType
    IntegerTypeMap (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ([Term h] -> Term h)
    -> [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Term h] -> Term h
    forall v. SupportTermOps v => [v] -> v
    sumExpr
                ([Term h] -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ([Term h]
     -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr
        -> Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> WeightedSum (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (m :: Type -> Type) r (sr :: SemiRing)
           (f :: BaseType -> Type).
    Monad m =>
    (r -> r -> m r)
    -> (Coefficient sr -> f (SemiRingBase sr) -> m r)
    -> (Coefficient sr -> m r)
    -> WeightedSum f sr
    -> m r
    WSum.evalM [Term h] -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall {f :: Type -> Type} {a}.
    Applicative f =>
    [a] -> [a] -> f [a]
    add Integer
    -> Expr t 'BaseIntegerType
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    Coefficient sr
    -> Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall {h} {t} {tp :: BaseType}.
    SMTWriter h =>
    Integer -> Expr t tp -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Integer -> [Term h])
    -> Integer
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> [Term h]
    forall {a}. SupportTermOps a => Integer -> [a]
    cnst) WeightedSum (Expr t) sr
    s

            SemiRingRepr sr
    SR.SemiRingRealRepr ->
              let smul :: Rational
    -> Expr t tp -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul Rational
    c Expr t tp
    e
                    | Rational
    c Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  Rational
    1 = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e
                    | Rational
    c Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Rational
    1 = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term h -> Term h
    forall a. Num a => a -> a
    negate (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e
                    | Bool
    otherwise = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Rational -> Term h
    forall v. SupportTermOps v => Rational -> v
    rationalTerm Rational
    c Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t tp -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    e
                  cnst :: Rational -> [a]
    cnst Rational
    0 = []
                  cnst Rational
    x = [Rational -> a
    forall v. SupportTermOps v => Rational -> v
    rationalTerm Rational
    x]
                  add :: [a] -> [a] -> f [a]
    add [a]
    x [a]
    y = [a] -> f [a]
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([a]
    y [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    x) -- reversed for efficiency when grouped to the left
              in
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ([Term h] -> Term h)
    -> [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Term h] -> Term h
    forall v. SupportTermOps v => [v] -> v
    sumExpr
                ([Term h] -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ([Term h]
     -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr
        -> Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> WeightedSum (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (m :: Type -> Type) r (sr :: SemiRing)
           (f :: BaseType -> Type).
    Monad m =>
    (r -> r -> m r)
    -> (Coefficient sr -> f (SemiRingBase sr) -> m r)
    -> (Coefficient sr -> m r)
    -> WeightedSum f sr
    -> m r
    WSum.evalM [Term h] -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall {f :: Type -> Type} {a}.
    Applicative f =>
    [a] -> [a] -> f [a]
    add Rational
    -> Expr t 'BaseRealType
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    Coefficient sr
    -> Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall {h} {t} {tp :: BaseType}.
    SMTWriter h =>
    Rational
    -> Expr t tp -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Rational -> [Term h])
    -> Rational
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rational -> [Term h]
    forall {a}. SupportTermOps a => Rational -> [a]
    cnst) WeightedSum (Expr t) sr
    s

            SR.SemiRingBVRepr BVFlavorRepr fv
    SR.BVArithRepr NatRepr w
    w ->
              let smul :: BV w
    -> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul BV w
    c Expr t (BaseBVType w)
    e
                    | BV w
    c BV w -> BV w -> Bool
    forall a. Eq a => a -> a -> Bool
    == NatRepr w -> BV w
    forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
    BV.one NatRepr w
    w = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    e
                    | BV w
    c BV w -> BV w -> Bool
    forall a. Eq a => a -> a -> Bool
    == NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.maxUnsigned NatRepr w
    w = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term h -> Term h
    forall v. SupportTermOps v => v -> v
    bvNeg (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    e
                    | Bool
    otherwise = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvMul (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    c)) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    e
                  cnst :: BV w -> [Term h]
    cnst (BV.BV Integer
    0) = []
                  cnst BV w
    x = [NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    x]
                  add :: [a] -> [a] -> f [a]
    add [a]
    x [a]
    y = [a] -> f [a]
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([a]
    y [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    x) -- reversed for efficiency when grouped to the left
               in
               TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm (NatRepr w -> TypeMap (BaseBVType w)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr w
    w) (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ([Term h] -> Term h)
    -> [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NatRepr w -> [Term h] -> Term h
    forall (w :: Natural). NatRepr w -> [Term h] -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> [v] -> v
    bvSumExpr NatRepr w
    w
                 ([Term h] -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ([Term h]
     -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr
        -> Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> WeightedSum (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (m :: Type -> Type) r (sr :: SemiRing)
           (f :: BaseType -> Type).
    Monad m =>
    (r -> r -> m r)
    -> (Coefficient sr -> f (SemiRingBase sr) -> m r)
    -> (Coefficient sr -> m r)
    -> WeightedSum f sr
    -> m r
    WSum.evalM [Term h] -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall {f :: Type -> Type} {a}.
    Applicative f =>
    [a] -> [a] -> f [a]
    add BV w
    -> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    Coefficient sr
    -> Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (BV w -> [Term h])
    -> BV w
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BV w -> [Term h]
    cnst) WeightedSum (Expr t) sr
    s

            SR.SemiRingBVRepr BVFlavorRepr fv
    SR.BVBitsRepr NatRepr w
    w ->
              let smul :: BV w
    -> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul BV w
    c Expr t (BaseBVType w)
    e
                    | BV w
    c BV w -> BV w -> Bool
    forall a. Eq a => a -> a -> Bool
    == NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.maxUnsigned NatRepr w
    w = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    e
                    | Bool
    otherwise             = (Term h -> [Term h] -> [Term h]
    forall a. a -> [a] -> [a]
    :[]) (Term h -> [Term h]) -> (Term h -> Term h) -> Term h -> [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvAnd (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    c)) (Term h -> [Term h])
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    e
                  cnst :: BV w -> [Term h]
    cnst (BV.BV Integer
    0) = []
                  cnst BV w
    x = [NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    x]
                  add :: [a] -> [a] -> f [a]
    add [a]
    x [a]
    y = [a] -> f [a]
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([a]
    y [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    x) -- reversed for efficiency when grouped to the left
                  xorsum :: [Term h] -> Term h
    xorsum [] = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr w
    w)
                  xorsum [Term h]
    xs = (Term h -> Term h -> Term h) -> [Term h] -> Term h
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> a -> a) -> t a -> a
    foldr1 Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvXor [Term h]
    xs
               in
               TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm (NatRepr w -> TypeMap (BaseBVType w)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr w
    w) (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ([Term h] -> Term h)
    -> [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Term h] -> Term h
    xorsum
                 ([Term h] -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ([Term h]
     -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr
        -> Expr t (SemiRingBase sr)
        -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (Coefficient sr -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> WeightedSum (Expr t) sr
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (m :: Type -> Type) r (sr :: SemiRing)
           (f :: BaseType -> Type).
    Monad m =>
    (r -> r -> m r)
    -> (Coefficient sr -> f (SemiRingBase sr) -> m r)
    -> (Coefficient sr -> m r)
    -> WeightedSum f sr
    -> m r
    WSum.evalM [Term h] -> [Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall {f :: Type -> Type} {a}.
    Applicative f =>
    [a] -> [a] -> f [a]
    add BV w
    -> Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    Coefficient sr
    -> Expr t (SemiRingBase sr)
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    smul ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Term h] -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> (BV w -> [Term h])
    -> BV w
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BV w -> [Term h]
    cnst) WeightedSum (Expr t) sr
    s

        RealDiv Expr t 'BaseRealType
    xe Expr t 'BaseRealType
    ye -> do
          x <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          case ye of
            SemiRingLiteral SemiRingRepr sr
    SR.SemiRingRealRepr Coefficient sr
    r ProgramLoc
    _ | Rational
    Coefficient sr
    r Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Rational
    0 -> do
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ Term h
    x Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    * Rational -> Term h
    forall v. SupportTermOps v => Rational -> v
    rationalTerm (Rational -> Rational
    forall a. Fractional a => a -> a
    recip Rational
    Coefficient sr
    r)
            Expr t 'BaseRealType
    _ -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport Expr t tp
    i
              y <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    ye
              freshBoundTerm RealTypeMap $ realDiv x y

        RealSqrt Expr t 'BaseRealType
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkNonlinearSupport Expr t tp
    i

          x <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          nm <- freshConstant "real sqrt" RealTypeMap
          let v = SMTExpr h 'BaseRealType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseRealType
    nm
          -- assert v*v = x | x < 0
          addSideCondition "real sqrt" $ v * v .== x .|| x .< 0
          -- assert v >= 0
          addSideCondition "real sqrt" $ v .>= 0
          -- Return variable
          return nm

        RealSpecialFunction SpecialFunction args
    fn (SFn.SpecialFnArgs Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    args) -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkComputableSupport Expr t tp
    i
          let sf1 :: (Term h -> Term h) ->
                     Ctx.Assignment (SFn.SpecialFnArg (Expr t) BaseRealType) (Ctx.EmptyCtx Ctx.::> SFn.R) ->
                     SMTCollector t h (SMTExpr h BaseRealType)
              sf1 :: (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    tmfn (Assignment (SpecialFnArg (Expr t) 'BaseRealType) ctx
    Ctx.Empty Ctx.:> SFn.SpecialFnArg Expr t 'BaseRealType
    xe) =
                 TypeMap 'BaseRealType
    -> Term h -> SMTCollector t h (SMTExpr h 'BaseRealType)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap 'BaseRealType
    RealTypeMap (Term h -> SMTCollector t h (SMTExpr h 'BaseRealType))
    -> (Term h -> Term h)
    -> Term h
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Term h -> Term h
    tmfn (Term h -> SMTCollector t h (SMTExpr h 'BaseRealType))
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          case SpecialFunction args
    fn of
            SpecialFunction args
    SFn.Sin  -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realSin  Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Cos  -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realCos  Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Tan  -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realTan  Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Sinh -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realSinh Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Cosh -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realCosh Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Tanh -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realTanh Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Exp  -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realExp  Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Log  -> (Term h -> Term h)
    -> Assignment
         (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    sf1 Term h -> Term h
    forall v. SupportTermOps v => v -> v
    realLog  Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    Assignment (SpecialFnArg (Expr t) 'BaseRealType) (EmptyCtx ::> R)
    args
            SpecialFunction args
    SFn.Arctan2 ->
              case Assignment (SpecialFnArg (Expr t) 'BaseRealType) args
    args of
                Assignment (SpecialFnArg (Expr t) 'BaseRealType) ctx
    Ctx.Empty Ctx.:> SFn.SpecialFnArg Expr t 'BaseRealType
    ye Ctx.:> SFn.SpecialFnArg Expr t 'BaseRealType
    xe ->
                  do y <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    ye
                     x <- mkBaseExpr xe
                     freshBoundTerm RealTypeMap $ realATan2 y x
            SpecialFunction args
    _ -> Expr t tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) t (tp :: BaseType) a.
    MonadFail m =>
    Expr t tp -> m a
    unsupportedTerm Expr t tp
    i -- TODO? more functions?

        ------------------------------------------
        -- Bitvector operations

        -- BGS: If UnaryBV is ported to BV, a lot of the unnecessary masks
        -- here will go away
        BVUnaryTerm UnaryBV (Expr t BaseBoolType) n
    t -> do
          let w :: NatRepr n
    w = UnaryBV (Expr t BaseBoolType) n -> NatRepr n
    forall p (n :: Natural). UnaryBV p n -> NatRepr n
    UnaryBV.width UnaryBV (Expr t BaseBoolType) n
    t
          let entries :: [(Expr t BaseBoolType, Integer, Integer)]
    entries = UnaryBV (Expr t BaseBoolType) n
    -> [(Expr t BaseBoolType, Integer, Integer)]
    forall p (n :: Natural). UnaryBV p n -> [(p, Integer, Integer)]
    UnaryBV.unsignedRanges UnaryBV (Expr t BaseBoolType) n
    t

          nm <- String
    -> TypeMap ('BaseBVType n)
    -> SMTCollector t h (SMTExpr h ('BaseBVType n))
    forall (tp :: BaseType) t h.
    String -> TypeMap tp -> SMTCollector t h (SMTExpr h tp)
    freshConstant String
    "unary term" (NatRepr n -> TypeMap ('BaseBVType n)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr n
    w)
          let nm_s = SMTExpr h ('BaseBVType n) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseBVType n)
    nm
          forM_ entries $ \(Expr t BaseBoolType
    pr,Integer
    l,Integer
    u) -> do
            -- Add assertion that for all values v in l,u, the predicate
            -- q is equivalent to v being less than or equal to the result
            -- of this term (denoted by nm)
            q <- Expr t BaseBoolType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t BaseBoolType
    pr
            addSideCondition "unary term" $ q .== nm_s `bvULe` bvTerm w (BV.mkBV w l)
            addSideCondition "unary term" $ q .== nm_s `bvULe` bvTerm w (BV.mkBV w u)

          case entries of
            (Expr t BaseBoolType
    _, Integer
    l, Integer
    _):[(Expr t BaseBoolType, Integer, Integer)]
    _ | Integer
    l Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0 -> do
              String -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall h t. String -> Term h -> SMTCollector t h ()
    addSideCondition String
    "unary term" (Term h -> ReaderT (SMTCollectorState t h) IO ())
    -> Term h -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ NatRepr n -> BV n -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr n
    w (NatRepr n -> Integer -> BV n
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr n
    w Integer
    l) Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    `bvULe` Term h
    nm_s
            [(Expr t BaseBoolType, Integer, Integer)]
    _ ->
              () -> ReaderT (SMTCollectorState t h) IO ()
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
          return nm

        BVOrBits NatRepr w
    w BVOrSet (Expr t) w
    bs ->
           do bs' <- (Expr t ('BaseBVType w)
     -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> [Expr t ('BaseBVType w)]
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr (BVOrSet (Expr t) w -> [Expr t ('BaseBVType w)]
    forall (e :: BaseType -> Type) (w :: Natural).
    BVOrSet e w -> [e (BaseBVType w)]
    bvOrToList BVOrSet (Expr t) w
    bs)
              freshBoundTerm (BVTypeMap w) $!
                case bs' of
                  [] -> NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr w
    w)
                  Term h
    x:[Term h]
    xs -> (Term h -> Term h -> Term h) -> Term h -> [Term h] -> Term h
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvOr Term h
    x [Term h]
    xs

        BVConcat NatRepr (u + v)
    w Expr t (BaseBVType u)
    xe Expr t (BaseBVType v)
    ye -> do
          x <- Expr t (BaseBVType u)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType u)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvConcat x y

        BVSelect NatRepr idx
    idx NatRepr n
    n Expr t (BaseBVType w)
    xe -> do
          x <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    xe
          freshBoundTerm (BVTypeMap n) $ bvExtract (bvWidth xe) (natValue idx) (natValue n) x

        BVUdiv NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvUDiv x y

        BVUrem NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvURem x y

        BVSdiv NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvSDiv x y

        BVSrem NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvSRem x y

        BVShl NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvShl x y

        BVLshr NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvLshr x y

        BVAshr NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y <- mkBaseExpr ye
          freshBoundTerm (BVTypeMap w) $ bvAshr x y

        BVRol NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x  <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y  <- mkBaseExpr ye

          let w' = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.width NatRepr w
    w)
          y' <- asBase <$> (freshBoundTerm (BVTypeMap w) $ bvURem y w')

          let lo = Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvLshr Term h
    x (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvSub Term h
    w' Term h
    y')
          let hi = Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvShl Term h
    x Term h
    y'

          freshBoundTerm (BVTypeMap w) $ bvXor hi lo

        BVRor NatRepr w
    w Expr t ('BaseBVType w)
    xe Expr t ('BaseBVType w)
    ye -> do
          x  <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
          y  <- mkBaseExpr ye

          let w' = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.width NatRepr w
    w)
          y' <- asBase <$> (freshBoundTerm (BVTypeMap w) $ bvURem y w')

          let lo = Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvLshr Term h
    x Term h
    y'
          let hi = Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvShl Term h
    x (Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvSub Term h
    w' Term h
    y')

          freshBoundTerm (BVTypeMap w) $ bvXor hi lo

        BVZext NatRepr r
    w' Expr t (BaseBVType w)
    xe -> do
          let w :: NatRepr w
    w = Expr t (BaseBVType w) -> NatRepr w
    forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
    forall (e :: BaseType -> Type) (w :: Natural).
    IsExpr e =>
    e (BaseBVType w) -> NatRepr w
    bvWidth Expr t (BaseBVType w)
    xe
          x <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    xe
          let n = NatRepr r -> Integer
    forall (w :: Natural). NatRepr w -> Integer
    intValue NatRepr r
    w' Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - NatRepr w -> Integer
    forall (w :: Natural). NatRepr w -> Integer
    intValue NatRepr w
    w
          case someNat n of
            Just (Some NatRepr x
    w2) | Just LeqProof 1 r
    LeqProof <- NatRepr r -> Maybe (LeqProof 1 r)
    forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
    isPosNat NatRepr r
    w' -> do
              let zeros :: Term h
    zeros = NatRepr x -> BV x -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr x
    w2 (NatRepr x -> BV x
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr x
    w2)
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm (NatRepr r -> TypeMap ('BaseBVType r)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr r
    w') (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvConcat Term h
    zeros Term h
    x
            Maybe (Some NatRepr)
    _ -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "invalid zero extension"

        BVSext NatRepr r
    w' Expr t (BaseBVType w)
    xe -> do
          let w :: NatRepr w
    w = Expr t (BaseBVType w) -> NatRepr w
    forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
    forall (e :: BaseType -> Type) (w :: Natural).
    IsExpr e =>
    e (BaseBVType w) -> NatRepr w
    bvWidth Expr t (BaseBVType w)
    xe
          x <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    xe
          let n = NatRepr r -> Integer
    forall (w :: Natural). NatRepr w -> Integer
    intValue NatRepr r
    w' Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - NatRepr w -> Integer
    forall (w :: Natural). NatRepr w -> Integer
    intValue NatRepr w
    w
          case someNat n of
            Just (Some NatRepr x
    w2) | Just LeqProof 1 r
    LeqProof <- NatRepr r -> Maybe (LeqProof 1 r)
    forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
    isPosNat NatRepr r
    w' -> do
              let zeros :: Term h
    zeros = NatRepr x -> BV x -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr x
    w2 (NatRepr x -> BV x
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr x
    w2)
              let ones :: Term h
    ones  = NatRepr x -> BV x -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr x
    w2 (NatRepr x -> BV x
    forall (w :: Natural). NatRepr w -> BV w
    BV.maxUnsigned NatRepr x
    w2)
              let sgn :: Term h
    sgn = NatRepr w -> Natural -> Term h -> Term h
    forall (w :: Natural). NatRepr w -> Natural -> Term h -> Term h
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w (NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    1) Term h
    x
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm (NatRepr r -> TypeMap ('BaseBVType r)
    forall (idx :: Natural).
    (1 <= idx) =>
    NatRepr idx -> TypeMap (BaseBVType idx)
    BVTypeMap NatRepr r
    w') (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    bvConcat (Term h -> Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v -> v
    ite Term h
    sgn Term h
    ones Term h
    zeros) Term h
    x
            Maybe (Some NatRepr)
    _ -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "invalid sign extension"

        BVFill NatRepr w
    w Expr t BaseBoolType
    xe ->
          do x <- Expr t BaseBoolType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t BaseBoolType
    xe
             let zeros = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr w
    w)
             let ones  = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.maxUnsigned NatRepr w
    w)
             freshBoundTerm (BVTypeMap w) $ ite x ones zeros

        BVPopcount NatRepr w
    w Expr t ('BaseBVType w)
    xe ->
          do x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
             let zs = [ Term h -> Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v -> v
    ite (NatRepr w -> Natural -> Term h -> Term h
    forall (w :: Natural). NatRepr w -> Natural -> Term h -> Term h
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w Natural
    idx Term h
    x) (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
    BV.one NatRepr w
    w)) (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.zero NatRepr w
    w))
                      | Natural
    idx <- [ Natural
    0 .. NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    1 ]
                      ]
             freshBoundTerm (BVTypeMap w) $! bvSumExpr w zs

        -- BGS: The mkBV call here shouldn't be necessary, but it is
        -- unless we use a NatRepr as the index
        BVCountLeadingZeros NatRepr w
    w Expr t ('BaseBVType w)
    xe ->
          do x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
             freshBoundTerm (BVTypeMap w) $! go 0 x
         where
         go :: Natural -> Term h -> Term h
    go !Natural
    idx Term h
    x
           | Natural
    idx Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    < NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w = Term h -> Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v -> v
    ite (NatRepr w -> Natural -> Term h -> Term h
    forall (w :: Natural). NatRepr w -> Natural -> Term h -> Term h
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w (NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    idx Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    1) Term h
    x) (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w (Natural -> Integer
    forall a. Integral a => a -> Integer
    toInteger Natural
    idx))) (Natural -> Term h -> Term h
    go (Natural
    idxNatural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    +Natural
    1) Term h
    x)
           | Bool
    otherwise = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.width NatRepr w
    w)

        -- BGS: The mkBV call here shouldn't be necessary, but it is
        -- unless we use a NatRepr as the index
        BVCountTrailingZeros NatRepr w
    w Expr t ('BaseBVType w)
    xe ->
          do x <- Expr t ('BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseBVType w)
    xe
             freshBoundTerm (BVTypeMap w) $! go 0 x
         where
         go :: Natural -> Term h -> Term h
    go !Natural
    idx Term h
    x
           | Natural
    idx Natural -> Natural -> Bool
    forall a. Ord a => a -> a -> Bool
    < NatRepr w -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr w
    w = Term h -> Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v -> v
    ite (NatRepr w -> Natural -> Term h -> Term h
    forall (w :: Natural). NatRepr w -> Natural -> Term h -> Term h
    forall v (w :: Natural).
    SupportTermOps v =>
    NatRepr w -> Natural -> v -> v
    bvTestBit NatRepr w
    w Natural
    idx Term h
    x) (NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> Integer -> BV w
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV NatRepr w
    w (Natural -> Integer
    forall a. Integral a => a -> Integer
    toInteger Natural
    idx))) (Natural -> Term h -> Term h
    go (Natural
    idxNatural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    +Natural
    1) Term h
    x)
           | Bool
    otherwise = NatRepr w -> BV w -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w (NatRepr w -> BV w
    forall (w :: Natural). NatRepr w -> BV w
    BV.width NatRepr w
    w)

        ------------------------------------------
        -- String operations

        StringLength Expr t (BaseStringType si)
    xe -> do
          case Expr t (BaseStringType si) -> StringInfoRepr si
    forall (si :: StringInfo).
    Expr t (BaseStringType si) -> StringInfoRepr si
    forall (e :: BaseType -> Type) (si :: StringInfo).
    IsExpr e =>
    e (BaseStringType si) -> StringInfoRepr si
    stringInfo Expr t (BaseStringType si)
    xe of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              x <- Expr t (BaseStringType si)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseStringType si)
    xe
              freshBoundTerm IntegerTypeMap $ stringLength @h x
            StringInfoRepr si
    si -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string length operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        StringIndexOf Expr t (BaseStringType si)
    xe Expr t (BaseStringType si)
    ye Expr t 'BaseIntegerType
    ke ->
          case Expr t (BaseStringType si) -> StringInfoRepr si
    forall (si :: StringInfo).
    Expr t (BaseStringType si) -> StringInfoRepr si
    forall (e :: BaseType -> Type) (si :: StringInfo).
    IsExpr e =>
    e (BaseStringType si) -> StringInfoRepr si
    stringInfo Expr t (BaseStringType si)
    xe of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              x <- Expr t (BaseStringType si)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseStringType si)
    xe
              y <- mkBaseExpr ye
              k <- mkBaseExpr ke
              freshBoundTerm IntegerTypeMap $ stringIndexOf @h x y k
            StringInfoRepr si
    si -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string index-of operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        StringSubstring StringInfoRepr si
    _ Expr t ('BaseStringType si)
    xe Expr t 'BaseIntegerType
    offe Expr t 'BaseIntegerType
    lene ->
          case Expr t ('BaseStringType si) -> StringInfoRepr si
    forall (si :: StringInfo).
    Expr t (BaseStringType si) -> StringInfoRepr si
    forall (e :: BaseType -> Type) (si :: StringInfo).
    IsExpr e =>
    e (BaseStringType si) -> StringInfoRepr si
    stringInfo Expr t ('BaseStringType si)
    xe of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              x <- Expr t ('BaseStringType si)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseStringType si)
    xe
              off <- mkBaseExpr offe
              len <- mkBaseExpr lene
              freshBoundTerm UnicodeTypeMap $ stringSubstring @h x off len
            StringInfoRepr si
    si -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string substring operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        StringContains Expr t (BaseStringType si)
    xe Expr t (BaseStringType si)
    ye ->
          case Expr t (BaseStringType si) -> StringInfoRepr si
    forall (si :: StringInfo).
    Expr t (BaseStringType si) -> StringInfoRepr si
    forall (e :: BaseType -> Type) (si :: StringInfo).
    IsExpr e =>
    e (BaseStringType si) -> StringInfoRepr si
    stringInfo Expr t (BaseStringType si)
    xe of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              x <- Expr t (BaseStringType si)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseStringType si)
    xe
              y <- mkBaseExpr ye
              freshBoundTerm BoolTypeMap $ stringContains @h x y
            StringInfoRepr si
    si -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string contains operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        StringIsPrefixOf Expr t (BaseStringType si)
    xe Expr t (BaseStringType si)
    ye ->
          case Expr t (BaseStringType si) -> StringInfoRepr si
    forall (si :: StringInfo).
    Expr t (BaseStringType si) -> StringInfoRepr si
    forall (e :: BaseType -> Type) (si :: StringInfo).
    IsExpr e =>
    e (BaseStringType si) -> StringInfoRepr si
    stringInfo Expr t (BaseStringType si)
    xe of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              x <- Expr t (BaseStringType si)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseStringType si)
    xe
              y <- mkBaseExpr ye
              freshBoundTerm BoolTypeMap $ stringIsPrefixOf @h x y
            StringInfoRepr si
    si -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string is-prefix-of operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        StringIsSuffixOf Expr t (BaseStringType si)
    xe Expr t (BaseStringType si)
    ye ->
          case Expr t (BaseStringType si) -> StringInfoRepr si
    forall (si :: StringInfo).
    Expr t (BaseStringType si) -> StringInfoRepr si
    forall (e :: BaseType -> Type) (si :: StringInfo).
    IsExpr e =>
    e (BaseStringType si) -> StringInfoRepr si
    stringInfo Expr t (BaseStringType si)
    xe of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              x <- Expr t (BaseStringType si)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseStringType si)
    xe
              y <- mkBaseExpr ye
              freshBoundTerm BoolTypeMap $ stringIsSuffixOf @h x y
            StringInfoRepr si
    si -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string is-suffix-of operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        StringAppend StringInfoRepr si
    si StringSeq (Expr t) si
    xes ->
          case StringInfoRepr si
    si of
            StringInfoRepr si
    UnicodeRepr -> do
              Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkStringSupport Expr t tp
    i
              let f :: StringSeqEntry (Expr t) Unicode
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    f (SSeq.StringSeqLiteral StringLiteral Unicode
    l) = Term h -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Term h -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall a b. (a -> b) -> a -> b
    $ forall h. SMTWriter h => Text -> Term h
    stringTerm @h (Text -> Term h) -> Text -> Term h
    forall a b. (a -> b) -> a -> b
    $ StringLiteral Unicode -> Text
    fromUnicodeLit StringLiteral Unicode
    l
                  f (SSeq.StringSeqTerm Expr t ('BaseStringType Unicode)
    t)    = Expr t ('BaseStringType Unicode)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseStringType Unicode)
    t
              xs <- (StringSeqEntry (Expr t) Unicode
     -> ReaderT (SMTCollectorState t h) IO (Term h))
    -> [StringSeqEntry (Expr t) Unicode]
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM StringSeqEntry (Expr t) Unicode
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    f ([StringSeqEntry (Expr t) Unicode]
     -> ReaderT (SMTCollectorState t h) IO [Term h])
    -> [StringSeqEntry (Expr t) Unicode]
    -> ReaderT (SMTCollectorState t h) IO [Term h]
    forall a b. (a -> b) -> a -> b
    $ StringSeq (Expr t) Unicode -> [StringSeqEntry (Expr t) Unicode]
    forall (e :: BaseType -> Type) (si :: StringInfo).
    StringSeq e si -> [StringSeqEntry e si]
    SSeq.toList StringSeq (Expr t) si
    StringSeq (Expr t) Unicode
    xes
              freshBoundTerm UnicodeTypeMap $ stringAppend @h xs

            StringInfoRepr si
    _ -> String -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String
    "Unsupported symbolic string append operation " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  StringInfoRepr si -> String
    forall a. Show a => a -> String
    show StringInfoRepr si
    si)

        ------------------------------------------
        -- Floating-point operations

        FloatNeg FloatPrecisionRepr fpp
    fpp Expr t ('BaseFloatType fpp)
    x -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          freshBoundTerm (FloatTypeMap fpp) $ floatNeg xe
        FloatAbs FloatPrecisionRepr fpp
    fpp Expr t ('BaseFloatType fpp)
    x -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          freshBoundTerm (FloatTypeMap fpp) $ floatAbs xe
        FloatSqrt FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          freshBoundTerm (FloatTypeMap fpp) $ floatSqrt r xe
        FloatAdd FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x Expr t ('BaseFloatType fpp)
    y -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm (FloatTypeMap fpp) $ floatAdd r xe ye
        FloatSub FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x Expr t ('BaseFloatType fpp)
    y -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm (FloatTypeMap fpp) $ floatSub r xe ye
        FloatMul FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x Expr t ('BaseFloatType fpp)
    y -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm (FloatTypeMap fpp) $ floatMul r xe ye
        FloatDiv FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x Expr t ('BaseFloatType fpp)
    y -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm (FloatTypeMap fpp) $ floatDiv r xe ye
        FloatRem FloatPrecisionRepr fpp
    fpp Expr t ('BaseFloatType fpp)
    x Expr t ('BaseFloatType fpp)
    y -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm (FloatTypeMap fpp) $ floatRem xe ye
        FloatFMA FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x Expr t ('BaseFloatType fpp)
    y Expr t ('BaseFloatType fpp)
    z -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          ze <- mkBaseExpr z
          freshBoundTerm (FloatTypeMap fpp) $ floatFMA r xe ye ze
        FloatFpEq Expr t (BaseFloatType fpp)
    x Expr t (BaseFloatType fpp)
    y -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm BoolTypeMap $ floatFpEq xe ye
        FloatLe Expr t (BaseFloatType fpp)
    x Expr t (BaseFloatType fpp)
    y -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm BoolTypeMap $ floatLe xe ye
        FloatLt Expr t (BaseFloatType fpp)
    x Expr t (BaseFloatType fpp)
    y -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          ye <- mkBaseExpr y
          freshBoundTerm BoolTypeMap $ floatLt xe ye
        FloatIsNaN Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsNaN xe
        FloatIsInf Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsInf xe
        FloatIsZero Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsZero xe
        FloatIsPos Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsPos xe
        FloatIsNeg Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsNeg xe
        FloatIsSubnorm Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsSubnorm xe
        FloatIsNorm Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm BoolTypeMap $ floatIsNorm xe
        FloatCast FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t (BaseFloatType fpp')
    x -> do
          xe <- Expr t (BaseFloatType fpp')
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp')
    x
          freshBoundTerm (FloatTypeMap fpp) $
            floatCast fpp r xe
        FloatRound FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t ('BaseFloatType fpp)
    x -> do
          xe <- Expr t ('BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t ('BaseFloatType fpp)
    x
          freshBoundTerm (FloatTypeMap fpp)$ floatRound r xe
        FloatToBinary fpp :: FloatPrecisionRepr (FloatingPointPrecision eb sb)
    fpp@(FloatingPointPrecisionRepr NatRepr eb
    eb NatRepr sb
    sb) Expr t (BaseFloatType (FloatingPointPrecision eb sb))
    x -> do
          xe <- Expr t (BaseFloatType (FloatingPointPrecision eb sb))
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType (FloatingPointPrecision eb sb))
    x
          val <- asBase <$> (freshConstant "float_binary" $ BVTypeMap $ addNat eb sb)
          -- (assert (= ((_ to_fp eb sb) val) xe))
          addSideCondition "float_binary" $
            floatFromBinary fpp val .== xe
          -- qnan: 0b0 0b1..1 0b10..0
          -- BGS: I tried using bv-sized primitives for this and it would
          -- have required a lot of proofs. Probable worth revisiting this.
          let qnan = NatRepr (eb + sb) -> BV (eb + sb) -> Term h
    forall (w :: Natural). NatRepr w -> BV w -> Term h
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm (NatRepr eb -> NatRepr sb -> NatRepr (eb + sb)
    forall (m :: Natural) (n :: Natural).
    NatRepr m -> NatRepr n -> NatRepr (m + n)
    addNat NatRepr eb
    eb NatRepr sb
    sb) (BV (eb + sb) -> Term h) -> BV (eb + sb) -> Term h
    forall a b. (a -> b) -> a -> b
    $
                     NatRepr (eb + sb) -> Integer -> BV (eb + sb)
    forall (w :: Natural). NatRepr w -> Integer -> BV w
    BV.mkBV (NatRepr eb -> NatRepr sb -> NatRepr (eb + sb)
    forall (m :: Natural) (n :: Natural).
    NatRepr m -> NatRepr n -> NatRepr (m + n)
    addNat NatRepr eb
    eb NatRepr sb
    sb) (Integer -> BV (eb + sb)) -> Integer -> BV (eb + sb)
    forall a b. (a -> b) -> a -> b
    $
                     Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    Bits.shiftL
                      (Integer
    2 Integer -> Natural -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (NatRepr eb -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr eb
    eb Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    + Natural
    1) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1)
                      (Natural -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (NatRepr sb -> Natural
    forall (n :: Natural). NatRepr n -> Natural
    natValue NatRepr sb
    sb Natural -> Natural -> Natural
    forall a. Num a => a -> a -> a
    - Natural
    2))
          freshBoundTerm (BVTypeMap $ addNat eb sb) $ ite (floatIsNaN xe) qnan val
        FloatFromBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
    fpp Expr t (BaseBVType (eb + sb))
    x -> do
          xe <- Expr t (BaseBVType (eb + sb))
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType (eb + sb))
    x
          freshBoundTerm (FloatTypeMap fpp) $
            floatFromBinary fpp xe
        BVToFloat FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t (BaseBVType w)
    x -> do
          xe <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    x
          freshBoundTerm (FloatTypeMap fpp) $
            bvToFloat fpp r xe
        SBVToFloat FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t (BaseBVType w)
    x -> do
          xe <- Expr t (BaseBVType w)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseBVType w)
    x
          freshBoundTerm (FloatTypeMap fpp) $
            sbvToFloat fpp r xe
        RealToFloat FloatPrecisionRepr fpp
    fpp RoundingMode
    r Expr t 'BaseRealType
    x -> do
          xe <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    x
          freshBoundTerm (FloatTypeMap fpp) $
            realToFloat fpp r xe
        FloatToBV NatRepr w
    w RoundingMode
    r Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm (BVTypeMap w) $ floatToBV (natValue w) r xe
        FloatToSBV NatRepr w
    w RoundingMode
    r Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm (BVTypeMap w) $ floatToSBV (natValue w) r xe
        FloatToReal Expr t (BaseFloatType fpp)
    x -> do
          xe <- Expr t (BaseFloatType fpp)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t (BaseFloatType fpp)
    x
          freshBoundTerm RealTypeMap $ floatToReal xe
        FloatSpecialFunction{} -> Expr t tp -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) t (tp :: BaseType) a.
    MonadFail m =>
    Expr t tp -> m a
    unsupportedTerm Expr t tp
    i

        ------------------------------------------------------------------------
        -- Array Operations

        ArrayMap Assignment BaseTypeRepr (i ::> itp)
    _ BaseTypeRepr tp1
    _ ArrayUpdateMap (Expr t) (i ::> itp) tp1
    elts Expr t ('BaseArrayType (i ::> itp) tp1)
    def -> do
          base_array <- Expr t ('BaseArrayType (i ::> itp) tp1)
    -> SMTCollector t h (SMTExpr h ('BaseArrayType (i ::> itp) tp1))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t ('BaseArrayType (i ::> itp) tp1)
    def
          elt_exprs <- (traverse._2) mkBaseExpr (AUM.toList elts)
          let array_type = SMTExpr h ('BaseArrayType (i ::> itp) tp1)
    -> TypeMap ('BaseArrayType (i ::> itp) tp1)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h ('BaseArrayType (i ::> itp) tp1)
    base_array
          case array_type of
            PrimArrayTypeMap{} -> do
              let set_at_index :: Term h
                               -> (Ctx.Assignment IndexLit ctx, Term h)
                               -> Term h
                  set_at_index :: forall (ctx :: Ctx BaseType).
    Term h -> (Assignment IndexLit ctx, Term h) -> Term h
    set_at_index Term h
    ma (Assignment IndexLit ctx
    idx, Term h
    elt) =
                    forall h. SMTWriter h => Term h -> [Term h] -> Term h -> Term h
    arrayUpdate @h Term h
    ma (Assignment IndexLit ctx -> [Term h]
    forall v (ctx :: Ctx BaseType).
    SupportTermOps v =>
    Assignment IndexLit ctx -> [v]
    mkIndexLitTerms Assignment IndexLit ctx
    idx) Term h
    elt
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap ('BaseArrayType (i ::> itp) tp1)
    array_type (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $
                (Term h -> (Assignment IndexLit (i ::> itp), Term h) -> Term h)
    -> Term h -> [(Assignment IndexLit (i ::> itp), Term h)] -> Term h
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Term h -> (Assignment IndexLit (i ::> itp), Term h) -> Term h
    forall (ctx :: Ctx BaseType).
    Term h -> (Assignment IndexLit ctx, Term h) -> Term h
    set_at_index (SMTExpr h ('BaseArrayType (i ::> itp) tp1) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseArrayType (i ::> itp) tp1)
    base_array) [(Assignment IndexLit (i ::> itp), Term h)]
    elt_exprs

            FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    idx_types TypeMap tp
    resType -> do
              case Maybe (Term h -> [Term h] -> Term h -> Term h)
    forall v. SupportTermOps v => Maybe (v -> [v] -> v -> v)
    smtFnUpdate of
                Just Term h -> [Term h] -> Term h -> Term h
    updateFn -> do

                  let set_at_index :: Term h
                                   -> (Ctx.Assignment IndexLit ctx, Term h)
                                   -> Term h
                      set_at_index :: forall (ctx :: Ctx BaseType).
    Term h -> (Assignment IndexLit ctx, Term h) -> Term h
    set_at_index Term h
    ma (Assignment IndexLit ctx
    idx, Term h
    elt) =
                        Term h -> [Term h] -> Term h -> Term h
    updateFn Term h
    ma ((forall (x :: BaseType). IndexLit x -> Term h)
    -> forall (x :: Ctx BaseType). Assignment IndexLit x -> [Term h]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC IndexLit x -> Term h
    forall v (tp :: BaseType). SupportTermOps v => IndexLit tp -> v
    forall (x :: BaseType). IndexLit x -> Term h
    mkIndexLitTerm Assignment IndexLit ctx
    idx) Term h
    elt
                  TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap ('BaseArrayType (i ::> itp) tp1)
    array_type (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $
                    (Term h -> (Assignment IndexLit (i ::> itp), Term h) -> Term h)
    -> Term h -> [(Assignment IndexLit (i ::> itp), Term h)] -> Term h
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Term h -> (Assignment IndexLit (i ::> itp), Term h) -> Term h
    forall (ctx :: Ctx BaseType).
    Term h -> (Assignment IndexLit ctx, Term h) -> Term h
    set_at_index (SMTExpr h ('BaseArrayType (i ::> itp) tp1) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseArrayType (i ::> itp) tp1)
    base_array) [(Assignment IndexLit (i ::> itp), Term h)]
    elt_exprs
                Maybe (Term h -> [Term h] -> Term h -> Term h)
    Nothing -> do
                  -- Supporting arrays as functons requires that we can create
                  -- function definitions.
                  Bool
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (WriterConn t h -> Bool
    forall t h. WriterConn t h -> Bool
    supportFunctionDefs WriterConn t h
    conn)) (ReaderT (SMTCollectorState t h) IO ()
     -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    String -> ReaderT (SMTCollectorState t h) IO ()
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO ())
    -> String -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 13) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 13) -> String) -> Doc (ZonkAny 13) -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc (ZonkAny 13)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) Doc (ZonkAny 13) -> Doc (ZonkAny 13) -> Doc (ZonkAny 13)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
                      Doc (ZonkAny 13)
    "does not support arrays as functions."
                  -- Create names for index variables.
                  args <- IO [(Text, Some TypeMap)]
    -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)]
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO [(Text, Some TypeMap)]
     -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)])
    -> IO [(Text, Some TypeMap)]
    -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)]
    forall a b. (a -> b) -> a -> b
    $ WriterConn t h
    -> Assignment TypeMap (idxl ::> idx) -> IO [(Text, Some TypeMap)]
    forall t h (args :: Ctx BaseType).
    WriterConn t h
    -> Assignment TypeMap args -> IO [(Text, Some TypeMap)]
    createTypeMapArgsForArray WriterConn t h
    conn Assignment TypeMap (idxl ::> idx)
    idx_types
                  -- Get list of terms for arguments.
                  let idx_terms = Text -> Term h
    forall v. SupportTermOps v => Text -> v
    fromText (Text -> Term h)
    -> ((Text, Some TypeMap) -> Text) -> (Text, Some TypeMap) -> Term h
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, Some TypeMap) -> Text
    forall a b. (a, b) -> a
    fst ((Text, Some TypeMap) -> Term h)
    -> [(Text, Some TypeMap)] -> [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Some TypeMap)]
    args
                  -- Return value at index in base_array.
                  let base_lookup = Term h -> [Term h] -> Term h
    forall v. SupportTermOps v => v -> [v] -> v
    smtFnApp (SMTExpr h ('BaseArrayType (i ::> itp) tp1) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseArrayType (i ::> itp) tp1)
    base_array) [Term h]
    idx_terms
                  -- Return if-then-else structure for next elements.
                  let set_at_index Term h
    prev_value (Assignment IndexLit (i ::> itp)
    idx_lits, Term h
    elt) =
                        let update_idx :: [Term h]
    update_idx = (forall (x :: BaseType). IndexLit x -> Term h)
    -> forall (x :: Ctx BaseType). Assignment IndexLit x -> [Term h]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC IndexLit x -> Term h
    forall v (tp :: BaseType). SupportTermOps v => IndexLit tp -> v
    forall (x :: BaseType). IndexLit x -> Term h
    mkIndexLitTerm Assignment IndexLit (i ::> itp)
    idx_lits
                            cond :: Term h
    cond = [Term h] -> Term h
    forall v. SupportTermOps v => [v] -> v
    andAll ((Term h -> Term h -> Term h) -> [Term h] -> [Term h] -> [Term h]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    (.==) [Term h]
    update_idx [Term h]
    idx_terms)
                         in Term h -> Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v -> v
    ite Term h
    cond Term h
    elt Term h
    prev_value
                  -- Get final expression for definition.
                  let expr = (Term h -> (Assignment IndexLit (i ::> itp), Term h) -> Term h)
    -> Term h -> [(Assignment IndexLit (i ::> itp), Term h)] -> Term h
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Term h -> (Assignment IndexLit (i ::> itp), Term h) -> Term h
    set_at_index Term h
    base_lookup [(Assignment IndexLit (i ::> itp), Term h)]
    elt_exprs
                  -- Add command
                  SMTName array_type <$> freshBoundFn args resType expr

        ConstantArray Assignment BaseTypeRepr (i ::> tp1)
    idxRepr BaseTypeRepr b
    _bRepr Expr t b
    ve -> do
          v <- Expr t b -> SMTCollector t h (SMTExpr h b)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t b
    ve
          let value_type = SMTExpr h b -> TypeMap b
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h b
    v
              feat = WriterConn t h -> ProblemFeatures
    forall t h. WriterConn t h -> ProblemFeatures
    supportedFeatures WriterConn t h
    conn
              mkArray = if ProblemFeatures
    feat ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useSymbolicArrays
                        then Assignment TypeMap (i ::> tp1)
    -> TypeMap b -> TypeMap ('BaseArrayType (i ::> tp1) b)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    PrimArrayTypeMap
                        else Assignment TypeMap (i ::> tp1)
    -> TypeMap b -> TypeMap ('BaseArrayType (i ::> tp1) b)
    forall (idx :: Ctx BaseType) (idx :: BaseType) (tp :: BaseType).
    Assignment TypeMap (idx ::> idx)
    -> TypeMap tp -> TypeMap (BaseArrayType (idx ::> idx) tp)
    FnArrayTypeMap
          idx_types <- liftIO $
            traverseFC (evalFirstClassTypeRepr conn (eltSource i)) idxRepr
          let tp = Assignment TypeMap (i ::> tp1)
    -> TypeMap b -> TypeMap ('BaseArrayType (i ::> tp1) b)
    mkArray Assignment TypeMap (i ::> tp1)
    idx_types TypeMap b
    value_type
          -- make sure any referenced tuple types exist
          liftIO (declareTypes conn tp)

          case arrayConstant @h of
            Just ArrayConstantFn (Term h)
    constFn
              | Bool
    otherwise -> do
                let idx_smt_types :: [Some TypeMap]
    idx_smt_types = (forall (x :: BaseType). TypeMap x -> Some TypeMap)
    -> forall (x :: Ctx BaseType).
       Assignment TypeMap x -> [Some TypeMap]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC TypeMap x -> Some TypeMap
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    forall (x :: BaseType). TypeMap x -> Some TypeMap
    Some Assignment TypeMap (i ::> tp1)
    idx_types
                TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap ('BaseArrayType (i ::> tp1) b)
    tp (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $!
                  ArrayConstantFn (Term h)
    constFn [Some TypeMap]
    idx_smt_types (TypeMap b -> Some TypeMap
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some TypeMap b
    value_type) (SMTExpr h b -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h b
    v)
            Maybe (ArrayConstantFn (Term h))
    Nothing -> do
              Bool
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (WriterConn t h -> Bool
    forall t h. WriterConn t h -> Bool
    supportFunctionDefs WriterConn t h
    conn)) (ReaderT (SMTCollectorState t h) IO ()
     -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                String -> ReaderT (SMTCollectorState t h) IO ()
    forall a. String -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> ReaderT (SMTCollectorState t h) IO ())
    -> String -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc (ZonkAny 14) -> String
    forall a. Show a => a -> String
    show (Doc (ZonkAny 14) -> String) -> Doc (ZonkAny 14) -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc (ZonkAny 14)
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (WriterConn t h -> String
    forall t h. WriterConn t h -> String
    smtWriterName WriterConn t h
    conn) Doc (ZonkAny 14) -> Doc (ZonkAny 14) -> Doc (ZonkAny 14)
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
                  Doc (ZonkAny 14)
    "cannot encode constant arrays."
              -- Create names for index variables.
              args <- IO [(Text, Some TypeMap)]
    -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)]
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO [(Text, Some TypeMap)]
     -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)])
    -> IO [(Text, Some TypeMap)]
    -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)]
    forall a b. (a -> b) -> a -> b
    $ WriterConn t h
    -> Assignment TypeMap (i ::> tp1) -> IO [(Text, Some TypeMap)]
    forall t h (args :: Ctx BaseType).
    WriterConn t h
    -> Assignment TypeMap args -> IO [(Text, Some TypeMap)]
    createTypeMapArgsForArray WriterConn t h
    conn Assignment TypeMap (i ::> tp1)
    idx_types
              SMTName tp <$> freshBoundFn args value_type (asBase v)

        SelectArray BaseTypeRepr tp
    _bRepr Expr t (BaseArrayType (i ::> tp1) tp)
    a Assignment (Expr t) (i ::> tp1)
    idx -> do
          aexpr <- Expr t (BaseArrayType (i ::> tp1) tp)
    -> SMTCollector t h (SMTExpr h (BaseArrayType (i ::> tp1) tp))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t (BaseArrayType (i ::> tp1) tp)
    a
          idxl <- mkIndicesTerms idx
          freshBoundTerm' $ smt_array_select aexpr idxl

        UpdateArray BaseTypeRepr b
    _bRepr Assignment BaseTypeRepr (i ::> tp1)
    _ Expr t ('BaseArrayType (i ::> tp1) b)
    a_elt Assignment (Expr t) (i ::> tp1)
    idx Expr t b
    ve -> do
          a <- Expr t ('BaseArrayType (i ::> tp1) b)
    -> SMTCollector t h (SMTExpr h ('BaseArrayType (i ::> tp1) b))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t ('BaseArrayType (i ::> tp1) b)
    a_elt
          updated_idx <- mkIndicesTerms idx
          value <- asBase <$> mkExpr ve
          let array_type = SMTExpr h ('BaseArrayType (i ::> tp1) b)
    -> TypeMap ('BaseArrayType (i ::> tp1) b)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h ('BaseArrayType (i ::> tp1) b)
    a
          case array_type of
            PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    _ TypeMap tp
    _ -> do
                TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap ('BaseArrayType (i ::> tp1) b)
    array_type (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $
                  forall h. SMTWriter h => Term h -> [Term h] -> Term h -> Term h
    arrayUpdate @h (SMTExpr h ('BaseArrayType (i ::> tp1) b) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseArrayType (i ::> tp1) b)
    a) [Term h]
    updated_idx Term h
    value
            FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    idxTypes TypeMap tp
    resType  -> do
              case Maybe (Term h -> [Term h] -> Term h -> Term h)
    forall v. SupportTermOps v => Maybe (v -> [v] -> v -> v)
    smtFnUpdate of
                Just Term h -> [Term h] -> Term h -> Term h
    updateFn -> do
                  TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap ('BaseArrayType (i ::> tp1) b)
    array_type (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ Term h -> [Term h] -> Term h -> Term h
    updateFn (SMTExpr h ('BaseArrayType (i ::> tp1) b) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseArrayType (i ::> tp1) b)
    a) [Term h]
    updated_idx Term h
    value
                Maybe (Term h -> [Term h] -> Term h -> Term h)
    Nothing -> do
                  -- Return value at index in base_array.
                  args <- IO [(Text, Some TypeMap)]
    -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)]
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO [(Text, Some TypeMap)]
     -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)])
    -> IO [(Text, Some TypeMap)]
    -> ReaderT (SMTCollectorState t h) IO [(Text, Some TypeMap)]
    forall a b. (a -> b) -> a -> b
    $ WriterConn t h
    -> Assignment TypeMap (idxl ::> idx) -> IO [(Text, Some TypeMap)]
    forall t h (args :: Ctx BaseType).
    WriterConn t h
    -> Assignment TypeMap args -> IO [(Text, Some TypeMap)]
    createTypeMapArgsForArray WriterConn t h
    conn Assignment TypeMap (idxl ::> idx)
    idxTypes

                  let idx_terms = Text -> Term h
    forall v. SupportTermOps v => Text -> v
    fromText (Text -> Term h)
    -> ((Text, Some TypeMap) -> Text) -> (Text, Some TypeMap) -> Term h
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, Some TypeMap) -> Text
    forall a b. (a, b) -> a
    fst ((Text, Some TypeMap) -> Term h)
    -> [(Text, Some TypeMap)] -> [Term h]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Some TypeMap)]
    args
                  let base_array_value = Term h -> [Term h] -> Term h
    forall v. SupportTermOps v => v -> [v] -> v
    smtFnApp (SMTExpr h ('BaseArrayType (i ::> tp1) b) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h ('BaseArrayType (i ::> tp1) b)
    a) [Term h]
    idx_terms
                  let cond = [Term h] -> Term h
    forall v. SupportTermOps v => [v] -> v
    andAll ((Term h -> Term h -> Term h) -> [Term h] -> [Term h] -> [Term h]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    (.==) [Term h]
    updated_idx [Term h]
    idx_terms)
                  let expr = Term h -> Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v -> v
    ite Term h
    cond Term h
    value Term h
    base_array_value
                  SMTName array_type <$> freshBoundFn args resType expr

        CopyArray NatRepr w
    _w_repr BaseTypeRepr a
    _a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    dest_arr Expr t (BaseBVType w)
    dest_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    src_arr Expr t (BaseBVType w)
    src_idx Expr t (BaseBVType w)
    len Expr t (BaseBVType w)
    _dest_end_idx Expr t (BaseBVType w)
    _src_end_idx -> do
          dest_arr_typed_expr <- Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    -> SMTCollector
         t h (SMTExpr h ('BaseArrayType (SingleCtx (BaseBVType w)) a))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    dest_arr
          let arr_type = SMTExpr h ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    -> TypeMap ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    dest_arr_typed_expr
          dest_idx_typed_expr <- mkExpr dest_idx
          let dest_idx_expr = SMTExpr h (BaseBVType w) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h (BaseBVType w)
    dest_idx_typed_expr
          let idx_type = SMTExpr h (BaseBVType w) -> TypeMap (BaseBVType w)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h (BaseBVType w)
    dest_idx_typed_expr
          src_arr_typed_expr <- mkExpr src_arr
          src_idx_expr <- mkBaseExpr src_idx
          len_expr <- mkBaseExpr len

          res <- freshConstant "array_copy" arr_type

          cr <- liftIO $ withConnEntryStack conn $ runInSandbox conn $ do
            i_expr <- asBase <$> freshConstant "i" idx_type
            return $ asBase (smt_array_select res [i_expr]) .==
              ite ((bvULe dest_idx_expr i_expr) .&& (bvULt i_expr (bvAdd dest_idx_expr len_expr)))
                (asBase (smt_array_select src_arr_typed_expr [bvAdd src_idx_expr (bvSub i_expr dest_idx_expr)]))
                (asBase (smt_array_select dest_arr_typed_expr [i_expr]))
          addSideCondition "array copy" $ forallResult cr
          addSideCondition "array copy" $ bvULt dest_idx_expr (bvAdd dest_idx_expr len_expr)
          addSideCondition "array copy" $ bvULt src_idx_expr (bvAdd src_idx_expr len_expr)

          return res

        SetArray NatRepr w
    _w_repr BaseTypeRepr a
    _a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    arr Expr t (BaseBVType w)
    idx Expr t a
    val Expr t (BaseBVType w)
    len Expr t (BaseBVType w)
    _end_idx -> do
          arr_typed_expr <- Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    -> SMTCollector
         t h (SMTExpr h ('BaseArrayType (SingleCtx (BaseBVType w)) a))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    arr
          let arr_type = SMTExpr h ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    -> TypeMap ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h ('BaseArrayType (SingleCtx (BaseBVType w)) a)
    arr_typed_expr
          idx_typed_expr <- mkExpr idx
          let idx_expr = SMTExpr h (BaseBVType w) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h (BaseBVType w)
    idx_typed_expr
          let idx_type = SMTExpr h (BaseBVType w) -> TypeMap (BaseBVType w)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h (BaseBVType w)
    idx_typed_expr
          val_expr <- mkBaseExpr val
          len_expr <- mkBaseExpr len

          res <- freshConstant "array_set" arr_type
          cr <- liftIO $ withConnEntryStack conn $ runInSandbox conn $ do
            i_expr <- asBase <$> freshConstant "i" idx_type
            return $ asBase (smt_array_select res [i_expr]) .==
              ite ((bvULe idx_expr i_expr) .&& (bvULt i_expr (bvAdd idx_expr len_expr)))
                val_expr
                (asBase (smt_array_select arr_typed_expr [i_expr]))
          addSideCondition "array set" $ forallResult cr
          addSideCondition "array set" $ bvULt idx_expr (bvAdd idx_expr len_expr)

          return res

        EqualArrayRange NatRepr w
    _w_repr BaseTypeRepr a
    _a_repr Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
    x_arr Expr t (BaseBVType w)
    x_idx Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
    y_arr Expr t (BaseBVType w)
    y_idx Expr t (BaseBVType w)
    len Expr t (BaseBVType w)
    _x_end_idx Expr t (BaseBVType w)
    _y_end_idx -> do
          x_arr_typed_expr <- Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
    -> SMTCollector
         t h (SMTExpr h (BaseArrayType (SingleCtx (BaseBVType w)) a))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
    x_arr
          x_idx_typed_expr <- mkExpr x_idx
          let x_idx_expr = SMTExpr h (BaseBVType w) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h (BaseBVType w)
    x_idx_typed_expr
          let idx_type = SMTExpr h (BaseBVType w) -> TypeMap (BaseBVType w)
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    smtExprType SMTExpr h (BaseBVType w)
    x_idx_typed_expr
          y_arr_typed_expr <- mkExpr y_arr
          y_idx_expr <- mkBaseExpr y_idx
          len_expr <- mkBaseExpr len

          cr <- liftIO $ withConnEntryStack conn $ runInSandbox conn $ do
            i_expr <- asBase <$> freshConstant "i" idx_type
            return $ impliesExpr ((bvULe x_idx_expr i_expr) .&& (bvULt i_expr (bvAdd x_idx_expr len_expr)))
              ((asBase (smt_array_select x_arr_typed_expr [i_expr])) .==
                (asBase (smt_array_select y_arr_typed_expr [bvAdd y_idx_expr (bvSub i_expr x_idx_expr)])))
          addSideCondition "array range equal" $ bvULt x_idx_expr (bvAdd x_idx_expr len_expr)
          addSideCondition "array range equal" $ bvULt y_idx_expr (bvAdd y_idx_expr len_expr)

          freshBoundTerm BoolTypeMap $ forallResult cr

        ------------------------------------------------------------------------
        -- Conversions.

        IntegerToReal Expr t 'BaseIntegerType
    xe -> do
          x <- Expr t 'BaseIntegerType
    -> SMTCollector t h (SMTExpr h 'BaseIntegerType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t 'BaseIntegerType
    xe
          return $ SMTExpr RealTypeMap (termIntegerToReal (asBase x))
        RealToInteger Expr t 'BaseRealType
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr t tp
    i
          x <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          return $ SMTExpr IntegerTypeMap (termRealToInteger x)

        RoundReal Expr t 'BaseRealType
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr t tp
    i
          x <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          nm <- freshConstant "round" IntegerTypeMap
          let r = Term h -> Term h
    forall v. SupportTermOps v => v -> v
    termIntegerToReal (SMTExpr h 'BaseIntegerType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseIntegerType
    nm)
          -- Round always rounds away from zero, so we
          -- first split "r = round(x)" into two cases
          -- depending on if "x" is non-negative.
          let posExpr = (Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    x Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    - Term h
    1 Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<  Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    r) Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .&& (Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    r Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    x Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    + Term h
    1)
          let negExpr = (Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    x Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    - Term h
    1 Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<= Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    r) Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .&& (Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    r Term h -> Term h -> Term h
    forall v. SupportTermOps v => v -> v -> v
    .<  Term h
    2Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    *Term h
    x Term h -> Term h -> Term h
    forall a. Num a => a -> a -> a
    + Term h
    1)
          -- Add formula
          addSideCondition "round" $ x .<  0 .|| posExpr
          addSideCondition "round" $ x .>= 0 .|| negExpr
          return nm

        RoundEvenReal Expr t 'BaseRealType
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr t tp
    i
          x <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          nm <- asBase <$> freshConstant "roundEven" IntegerTypeMap
          r <- asBase <$> freshBoundTerm RealTypeMap (termIntegerToReal nm)
          -- Assert that `x` is in the interval `[r, r+1]`
          addSideCondition "roundEven" $ (r .<= x) .&& (x .<= r+1)
          diff <- asBase <$> freshBoundTerm RealTypeMap (x - r)
          freshBoundTerm IntegerTypeMap $
            ite (diff .< rationalTerm 0.5) nm $
              ite (diff .> rationalTerm 0.5) (nm+1) $
                ite (intDivisible nm 2) nm (nm+1)

        FloorReal Expr t 'BaseRealType
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr t tp
    i
          x <- Expr t 'BaseRealType -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t 'BaseRealType
    xe
          nm <- freshConstant "floor" IntegerTypeMap
          let floor_r = Term h -> Term h
    forall v. SupportTermOps v => v -> v
    termIntegerToReal (SMTExpr h 'BaseIntegerType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseIntegerType
    nm)
          addSideCondition "floor" $ (floor_r .<= x) .&& (x .< floor_r + 1)
          return nm

        CeilReal Expr t 'BaseRealType
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkIntegerSupport Expr t tp
    i
          x <- SMTExpr h 'BaseRealType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase (SMTExpr h 'BaseRealType -> Term h)
    -> SMTCollector t h (SMTExpr h 'BaseRealType)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr t 'BaseRealType -> SMTCollector t h (SMTExpr h 'BaseRealType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t 'BaseRealType
    xe
          nm <- freshConstant "ceiling" IntegerTypeMap
          let r = Term h -> Term h
    forall v. SupportTermOps v => v -> v
    termIntegerToReal (SMTExpr h 'BaseIntegerType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseIntegerType
    nm)
          addSideCondition "ceiling" $ (x .<= r) .&& (r .< x + 1)
          return nm

        BVToInteger Expr t (BaseBVType w)
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr t tp
    i
          x <- Expr t (BaseBVType w)
    -> SMTCollector t h (SMTExpr h (BaseBVType w))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t (BaseBVType w)
    xe
          freshBoundTerm IntegerTypeMap $ bvIntTerm (bvWidth xe) (asBase x)

        SBVToInteger Expr t (BaseBVType w)
    xe -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr t tp
    i
          x <- Expr t (BaseBVType w)
    -> SMTCollector t h (SMTExpr h (BaseBVType w))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t (BaseBVType w)
    xe
          freshBoundTerm IntegerTypeMap $ sbvIntTerm (bvWidth xe) (asBase x)

        IntegerToBV Expr t 'BaseIntegerType
    xe NatRepr w
    w -> do
          Expr t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall t (tp :: BaseType) h. Expr t tp -> SMTCollector t h ()
    checkLinearSupport Expr t tp
    i

          x <- Expr t 'BaseIntegerType
    -> SMTCollector t h (SMTExpr h 'BaseIntegerType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t 'BaseIntegerType
    xe
          let xb = SMTExpr h 'BaseIntegerType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseIntegerType
    x

          res <- freshConstant "integerToBV" (BVTypeMap w)
          bvint <- freshBoundTerm IntegerTypeMap $ bvIntTerm w (asBase res)

          addSideCondition "integerToBV" $
             (intDivisible (xb - (asBase bvint)) (2^natValue w))
          return res

        Cplx Complex (Expr t 'BaseRealType)
    c -> do
          (rl :+ img) <- (Expr t 'BaseRealType
     -> SMTCollector t h (SMTExpr h 'BaseRealType))
    -> Complex (Expr t 'BaseRealType)
    -> ReaderT
         (SMTCollectorState t h) IO (Complex (SMTExpr h 'BaseRealType))
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Complex a -> f (Complex b)
    traverse Expr t 'BaseRealType -> SMTCollector t h (SMTExpr h 'BaseRealType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Complex (Expr t 'BaseRealType)
    c

          feat <- asks (supportedFeatures . scConn)
          case () of
            ()
    _ | ProblemFeatures
    feat ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useStructs -> do
                let tp :: TypeMap 'BaseComplexType
    tp = TypeMap 'BaseComplexType
    ComplexToStructTypeMap
                let tm :: Term h
    tm = forall h (args :: Ctx BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> [Term h] -> Term h
    structCtor @h (Assignment TypeMap EmptyCtx
    forall {k} (ctx :: Ctx k) (f :: k -> Type).
    (ctx ~ EmptyCtx) =>
    Assignment f ctx
    Ctx.Empty Assignment TypeMap EmptyCtx
    -> TypeMap 'BaseRealType
    -> Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap Assignment TypeMap (EmptyCtx ::> 'BaseRealType)
    -> TypeMap 'BaseRealType
    -> Assignment
         TypeMap ((EmptyCtx ::> 'BaseRealType) ::> 'BaseRealType)
    forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
           (tp :: k).
    (ctx' ~ (ctx ::> tp)) =>
    Assignment f ctx -> f tp -> Assignment f ctx'
    Ctx.:> TypeMap 'BaseRealType
    RealTypeMap) [SMTExpr h 'BaseRealType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseRealType
    rl, SMTExpr h 'BaseRealType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseRealType
    img]
                TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseComplexType
    tp Term h
    tm

              | ProblemFeatures
    feat ProblemFeatures -> ProblemFeatures -> Bool
    `hasProblemFeature` ProblemFeatures
    useSymbolicArrays -> do
                let tp :: TypeMap 'BaseComplexType
    tp = TypeMap 'BaseComplexType
    ComplexToArrayTypeMap
                let r' :: Term h
    r' = SMTExpr h 'BaseRealType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseRealType
    rl
                let i' :: Term h
    i' = SMTExpr h 'BaseRealType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseRealType
    img
                ra <-
                  case forall h. SMTWriter h => Maybe (ArrayConstantFn (Term h))
    arrayConstant @h of
                    Just ArrayConstantFn (Term h)
    constFn  ->
                      Term h -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (ArrayConstantFn (Term h)
    constFn [TypeMap BaseBoolType -> Some TypeMap
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some TypeMap BaseBoolType
    BoolTypeMap] (TypeMap 'BaseRealType -> Some TypeMap
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some TypeMap 'BaseRealType
    RealTypeMap) Term h
    r')
                    Maybe (ArrayConstantFn (Term h))
    Nothing -> do
                      a <- SMTExpr h 'BaseComplexType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase (SMTExpr h 'BaseComplexType -> Term h)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h 'BaseComplexType)
    -> ReaderT (SMTCollectorState t h) IO (Term h)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> String
    -> TypeMap 'BaseComplexType
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h 'BaseComplexType)
    forall (tp :: BaseType) t h.
    String -> TypeMap tp -> SMTCollector t h (SMTExpr h tp)
    freshConstant String
    "complex lit" TypeMap 'BaseComplexType
    tp
                      return $! arrayUpdate @h a [boolExpr False] r'
                freshBoundTerm tp $! arrayUpdate @h ra [boolExpr True] i'

              | Bool
    otherwise ->
                WriterConn t h
    -> String
    -> Expr t tp
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (m :: Type -> Type) t h (tp :: BaseType) a.
    MonadFail m =>
    WriterConn t h -> String -> Expr t tp -> m a
    theoryUnsupported WriterConn t h
    conn String
    "complex literals" Expr t tp
    i

        RealPart Expr t 'BaseComplexType
    e -> do
          c <- Expr t 'BaseComplexType
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h 'BaseComplexType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t 'BaseComplexType
    e
          case smtExprType c of
            TypeMap 'BaseComplexType
    ComplexToStructTypeMap ->
              do let prj :: Term h
    prj = forall h. SMTWriter h => Term h -> Term h
    structComplexRealPart @h (SMTExpr h 'BaseComplexType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseComplexType
    c)
                 TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap Term h
    prj
            TypeMap 'BaseComplexType
    ComplexToArrayTypeMap ->
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ forall h. SMTWriter h => Term h -> Term h
    arrayComplexRealPart @h (SMTExpr h 'BaseComplexType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseComplexType
    c)
        ImagPart Expr t 'BaseComplexType
    e -> do
          c <- Expr t 'BaseComplexType
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h 'BaseComplexType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t 'BaseComplexType
    e
          case smtExprType c of
            TypeMap 'BaseComplexType
    ComplexToStructTypeMap ->
              do let prj :: Term h
    prj = forall h. SMTWriter h => Term h -> Term h
    structComplexImagPart @h (SMTExpr h 'BaseComplexType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseComplexType
    c)
                 TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap Term h
    prj
            TypeMap 'BaseComplexType
    ComplexToArrayTypeMap ->
              TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    TypeMap 'BaseRealType
    RealTypeMap (Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ forall h. SMTWriter h => Term h -> Term h
    arrayComplexImagPart @h (SMTExpr h 'BaseComplexType -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h 'BaseComplexType
    c)

        --------------------------------------------------------------------
        -- Structures

        StructCtor Assignment BaseTypeRepr flds
    _ Assignment (Expr t) flds
    vals -> do
          -- Make sure a struct with the given number of elements has been declared.
          exprs <- (forall (x :: BaseType).
     Expr t x -> ReaderT (SMTCollectorState t h) IO (SMTExpr h x))
    -> forall (x :: Ctx BaseType).
       Assignment (Expr t) x
       -> ReaderT (SMTCollectorState t h) IO (Assignment (SMTExpr h) x)
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type) (m :: Type -> Type).
    (TraversableFC t, Applicative m) =>
    (forall (x :: k). f x -> m (g x))
    -> forall (x :: l). t f x -> m (t g x)
    forall (f :: BaseType -> Type) (g :: BaseType -> Type)
           (m :: Type -> Type).
    Applicative m =>
    (forall (x :: BaseType). f x -> m (g x))
    -> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
    traverseFC Expr t x -> SMTCollector t h (SMTExpr h x)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    forall (x :: BaseType).
    Expr t x -> ReaderT (SMTCollectorState t h) IO (SMTExpr h x)
    mkExpr Assignment (Expr t) flds
    vals
          let fld_types = (forall (x :: BaseType). SMTExpr h x -> TypeMap x)
    -> forall (x :: Ctx BaseType).
       Assignment (SMTExpr h) x -> Assignment TypeMap x
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
           (g :: k -> Type).
    FunctorFC t =>
    (forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
    forall (f :: BaseType -> Type) (g :: BaseType -> Type).
    (forall (x :: BaseType). f x -> g x)
    -> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
    fmapFC SMTExpr h x -> TypeMap x
    forall h (tp :: BaseType). SMTExpr h tp -> TypeMap tp
    forall (x :: BaseType). SMTExpr h x -> TypeMap x
    smtExprType Assignment (SMTExpr h) flds
    exprs

          liftIO $ declareStructDatatype conn fld_types
          let tm = forall h (args :: Ctx BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> [Term h] -> Term h
    structCtor @h Assignment TypeMap flds
    fld_types ((forall (x :: BaseType). SMTExpr h x -> Term h)
    -> forall (x :: Ctx BaseType). Assignment (SMTExpr h) x -> [Term h]
    forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
    FoldableFC t =>
    (forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
    forall (f :: BaseType -> Type) a.
    (forall (x :: BaseType). f x -> a)
    -> forall (x :: Ctx BaseType). Assignment f x -> [a]
    toListFC SMTExpr h x -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    forall (x :: BaseType). SMTExpr h x -> Term h
    asBase Assignment (SMTExpr h) flds
    exprs)
          freshBoundTerm (StructTypeMap fld_types) tm

        StructField Expr t (BaseStructType flds)
    s Index flds tp
    idx BaseTypeRepr tp
    _tp -> do
          expr <- Expr t (BaseStructType flds)
    -> SMTCollector t h (SMTExpr h (BaseStructType flds))
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t (BaseStructType flds)
    s
          case smtExprType expr of
           StructTypeMap Assignment TypeMap idx
    flds -> do
             let tp :: TypeMap tp
    tp = Assignment TypeMap idx
    flds Assignment TypeMap idx -> Index idx tp -> TypeMap tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index flds tp
    Index idx tp
    idx
             let tm :: Term h
    tm = forall h (args :: Ctx BaseType) (tp :: BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> Index args tp -> Term h -> Term h
    structProj @h Assignment TypeMap idx
    flds Index flds tp
    Index idx tp
    idx (SMTExpr h (BaseStructType flds) -> Term h
    forall h (tp :: BaseType).
    SupportTermOps (Term h) =>
    SMTExpr h tp -> Term h
    asBase SMTExpr h (BaseStructType flds)
    expr)
             TypeMap tp
    -> Term h -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall (tp :: BaseType) h t.
    TypeMap tp -> Term h -> SMTCollector t h (SMTExpr h tp)
    freshBoundTerm TypeMap tp
    tp Term h
    tm

    defineFn :: SMTWriter h
             => WriterConn t h
             -> Text
             -> Ctx.Assignment (ExprBoundVar t) a
             -> Expr t r
             -> Ctx.Assignment TypeMap a
             -> IO (TypeMap r)
    defineFn :: forall h t (a :: Ctx BaseType) (r :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Text
    -> Assignment (ExprBoundVar t) a
    -> Expr t r
    -> Assignment TypeMap a
    -> IO (TypeMap r)
    defineFn WriterConn t h
    conn Text
    nm Assignment (ExprBoundVar t) a
    arg_vars Expr t r
    return_value Assignment TypeMap a
    arg_types =
      -- Define the SMT function
      WriterConn t h
    -> Text
    -> (FreshVarFn h -> SMTCollector t h (SMTExpr h r))
    -> IO (TypeMap r)
    forall h t (ret :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Text
    -> (FreshVarFn h -> SMTCollector t h (SMTExpr h ret))
    -> IO (TypeMap ret)
    defineSMTFunction WriterConn t h
    conn Text
    nm ((FreshVarFn h -> SMTCollector t h (SMTExpr h r))
     -> IO (TypeMap r))
    -> (FreshVarFn h -> SMTCollector t h (SMTExpr h r))
    -> IO (TypeMap r)
    forall a b. (a -> b) -> a -> b
    $ \(FreshVarFn forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp)
    freshVar) -> do
        -- Create SMT expressions and bind them to vars
        Size a
    -> (forall (tp :: BaseType).
        Index a tp -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    forall {k} (ctx :: Ctx k) (m :: Type -> Type).
    Applicative m =>
    Size ctx -> (forall (tp :: k). Index ctx tp -> m ()) -> m ()
    Ctx.forIndexM (Assignment (ExprBoundVar t) a -> Size a
    forall {k} (f :: k -> Type) (ctx :: Ctx k).
    Assignment f ctx -> Size ctx
    Ctx.size Assignment (ExprBoundVar t) a
    arg_vars) ((forall (tp :: BaseType).
      Index a tp -> ReaderT (SMTCollectorState t h) IO ())
     -> ReaderT (SMTCollectorState t h) IO ())
    -> (forall (tp :: BaseType).
        Index a tp -> ReaderT (SMTCollectorState t h) IO ())
    -> ReaderT (SMTCollectorState t h) IO ()
    forall a b. (a -> b) -> a -> b
    $ \Index a tp
    i -> do
          let v :: ExprBoundVar t tp
    v = Assignment (ExprBoundVar t) a
    arg_vars Assignment (ExprBoundVar t) a -> Index a tp -> ExprBoundVar t tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index a tp
    i
          let smtType :: TypeMap tp
    smtType = Assignment TypeMap a
    arg_types Assignment TypeMap a -> Index a tp -> TypeMap tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index a tp
    i
          ExprBoundVar t tp -> ReaderT (SMTCollectorState t h) IO ()
    forall n (tp :: BaseType) h.
    ExprBoundVar n tp -> SMTCollector n h ()
    checkVarTypeSupport ExprBoundVar t tp
    v
          x <- IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a. IO a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (SMTExpr h tp)
     -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp))
    -> IO (SMTExpr h tp)
    -> ReaderT (SMTCollectorState t h) IO (SMTExpr h tp)
    forall a b. (a -> b) -> a -> b
    $ TypeMap tp -> IO (SMTExpr h tp)
    forall (tp :: BaseType). TypeMap tp -> IO (SMTExpr h tp)
    freshVar TypeMap tp
    smtType
          bindVar v x
        -- Evaluate return value
        Expr t r -> SMTCollector t h (SMTExpr h r)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr Expr t r
    return_value

    -- | Create a SMT symbolic function from the ExprSymFn.
    --
    -- Returns the return type of the function.
    --
    -- This is only called by 'getSMTSymFn'.
    mkSMTSymFn :: SMTWriter h
               => WriterConn t h
               -> Text
               -> ExprSymFn t args ret
               -> Ctx.Assignment TypeMap args
               -> IO (TypeMap ret)
    mkSMTSymFn :: forall h t (args :: Ctx BaseType) (ret :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Text
    -> ExprSymFn t args ret
    -> Assignment TypeMap args
    -> IO (TypeMap ret)
    mkSMTSymFn WriterConn t h
    conn Text
    nm ExprSymFn t args ret
    f Assignment TypeMap args
    arg_types =
      case ExprSymFn t args ret -> SymFnInfo t args ret
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SymFnInfo t args ret
    symFnInfo ExprSymFn t args ret
    f of
        UninterpFnInfo Assignment BaseTypeRepr args
    _ BaseTypeRepr ret
    return_type -> do
          let fnm :: SolverSymbol
    fnm = ExprSymFn t args ret -> SolverSymbol
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SolverSymbol
    symFnName ExprSymFn t args ret
    f
          let l :: ProgramLoc
    l = ExprSymFn t args ret -> ProgramLoc
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> ProgramLoc
    symFnLoc ExprSymFn t args ret
    f
          smt_ret <- WriterConn t h
    -> SMTSource (ZonkAny 8) -> BaseTypeRepr ret -> IO (TypeMap ret)
    forall (m :: Type -> Type) t h ann (tp :: BaseType).
    MonadFail m =>
    WriterConn t h
    -> SMTSource ann -> BaseTypeRepr tp -> m (TypeMap tp)
    evalFirstClassTypeRepr WriterConn t h
    conn (SolverSymbol -> ProgramLoc -> SMTSource (ZonkAny 8)
    forall ann. SolverSymbol -> ProgramLoc -> SMTSource ann
    fnSource SolverSymbol
    fnm ProgramLoc
    l) BaseTypeRepr ret
    return_type
          traverseFC_ (declareTypes conn) arg_types
          declareTypes conn smt_ret
          addCommand conn $
            declareCommand conn nm arg_types smt_ret
          return $! smt_ret
        DefinedFnInfo Assignment (ExprBoundVar t) args
    arg_vars Expr t ret
    return_value UnfoldPolicy
    _ -> do
          WriterConn t h
    -> Text
    -> Assignment (ExprBoundVar t) args
    -> Expr t ret
    -> Assignment TypeMap args
    -> IO (TypeMap ret)
    forall h t (a :: Ctx BaseType) (r :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Text
    -> Assignment (ExprBoundVar t) a
    -> Expr t r
    -> Assignment TypeMap a
    -> IO (TypeMap r)
    defineFn WriterConn t h
    conn Text
    nm Assignment (ExprBoundVar t) args
    arg_vars Expr t ret
    return_value Assignment TypeMap args
    arg_types
        MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
    _ Assignment (ExprBoundVar t) args
    arg_vars Expr t ret
    return_value -> do
          WriterConn t h
    -> Text
    -> Assignment (ExprBoundVar t) args
    -> Expr t ret
    -> Assignment TypeMap args
    -> IO (TypeMap ret)
    forall h t (a :: Ctx BaseType) (r :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> Text
    -> Assignment (ExprBoundVar t) a
    -> Expr t r
    -> Assignment TypeMap a
    -> IO (TypeMap r)
    defineFn WriterConn t h
    conn Text
    nm Assignment (ExprBoundVar t) args
    arg_vars Expr t ret
    return_value Assignment TypeMap args
    arg_types

    -- | Generate a SMTLIB function for a ExprBuilder function.
    --
    -- Since SimpleBuilder different simple builder values with the same type may
    -- have different SMTLIB types (particularly arrays), getSMTSymFn requires the
    -- argument types to call the function with.  This is enforced to be compatible
    -- with the argument types expected by the simplebuilder.
    --
    -- This function caches the result, and we currently generate the function based
    -- on the argument types provided the first time getSMTSymFn is called with a
    -- particular simple builder function.  In subsequent calls, we validate that
    -- the same argument types are provided.  In principal, a function could be
    -- called with one type of arguments, and then be called with a different type
    -- and this check would fail.  However, due to limitations in the solvers we
    -- expect to support, this should never happen as the only time these may differ
    -- when arrays are used and one array is encoded using the theory of arrays, while
    -- the other uses a defined function.  However, SMTLIB2 does not allow functions
    -- to be passed to other functions; yices does, but always encodes arrays as functions.
    --
    -- Returns the name of the function and the type of the result.
    getSMTSymFn :: SMTWriter h
                => WriterConn t h
                -> ExprSymFn t args ret -- ^ Function to
                -> Ctx.Assignment TypeMap args
                -> IO (Text, TypeMap ret)
    getSMTSymFn :: forall h t (args :: Ctx BaseType) (ret :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> ExprSymFn t args ret
    -> Assignment TypeMap args
    -> IO (Text, TypeMap ret)
    getSMTSymFn WriterConn t h
    conn ExprSymFn t args ret
    fn Assignment TypeMap args
    arg_types = do
      let n :: Nonce t (args ::> ret)
    n = ExprSymFn t args ret -> Nonce t (args ::> ret)
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> Nonce t (args ::> ret)
    symFnId ExprSymFn t args ret
    fn
      WriterConn t h
    -> Nonce t (args ::> ret) -> IO (Maybe (SMTSymFn (args ::> ret)))
    forall t h (ctx :: Ctx BaseType).
    WriterConn t h -> Nonce t ctx -> IO (Maybe (SMTSymFn ctx))
    cacheLookupFn WriterConn t h
    conn Nonce t (args ::> ret)
    n IO (Maybe (SMTSymFn (args ::> ret)))
    -> (Maybe (SMTSymFn (args ::> ret)) -> IO (Text, TypeMap ret))
    -> IO (Text, TypeMap ret)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just (SMTSymFn Text
    nm Assignment TypeMap args
    param_types TypeMap ret
    ret) -> do
          Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Assignment TypeMap args
    arg_types Assignment TypeMap args -> Assignment TypeMap args -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Assignment TypeMap args
    Assignment TypeMap args
    param_types) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            String -> IO ()
    forall a. String -> IO a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Illegal arguments to function " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    Text.unpack Text
    nm String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".\n"
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\tExpected arguments: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Assignment TypeMap args -> String
    forall a. Show a => a -> String
    show Assignment TypeMap args
    param_types String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\n"
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\tActual arguments: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Assignment TypeMap args -> String
    forall a. Show a => a -> String
    show Assignment TypeMap args
    arg_types
          (Text, TypeMap ret) -> IO (Text, TypeMap ret)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Text
    nm, TypeMap ret
    TypeMap ret
    ret)
        Maybe (SMTSymFn (args ::> ret))
    Nothing -> do
          -- Check argument types can be passed to a function.
          WriterConn t h -> Assignment TypeMap args -> IO ()
    forall t h (args :: Ctx BaseType).
    WriterConn t h -> Assignment TypeMap args -> IO ()
    checkArgumentTypes WriterConn t h
    conn Assignment TypeMap args
    arg_types
          -- Generate name.
          nm <- WriterConn t h -> SymbolBinding t -> IO Text
    forall t h. WriterConn t h -> SymbolBinding t -> IO Text
    getSymbolName WriterConn t h
    conn (ExprSymFn t args ret -> SymbolBinding t
    forall t (args :: Ctx BaseType) (ret :: BaseType).
    ExprSymFn t args ret -> SymbolBinding t
    FnSymbolBinding ExprSymFn t args ret
    fn)
          ret_type <- mkSMTSymFn conn nm fn arg_types
          cacheValueFn conn n DeleteNever $! SMTSymFn nm arg_types ret_type
          return (nm, ret_type)

    ------------------------------------------------------------------------
    -- Writer high-level interface.

    -- | Write a expression to SMT
    mkSMTTerm :: SMTWriter h => WriterConn t h -> Expr t tp -> IO (Term h)
    mkSMTTerm :: forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> Expr t tp -> IO (Term h)
    mkSMTTerm WriterConn t h
    conn Expr t tp
    p = WriterConn t h -> SMTCollector t h (Term h) -> IO (Term h)
    forall h t a.
    SMTWriter h =>
    WriterConn t h -> SMTCollector t h a -> IO a
    runOnLiveConnection WriterConn t h
    conn (SMTCollector t h (Term h) -> IO (Term h))
    -> SMTCollector t h (Term h) -> IO (Term h)
    forall a b. (a -> b) -> a -> b
    $ Expr t tp -> SMTCollector t h (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (Term h)
    mkBaseExpr Expr t tp
    p

    -- | Write a logical expression.
    mkFormula :: SMTWriter h => WriterConn t h -> BoolExpr t -> IO (Term h)
    mkFormula :: forall h t.
    SMTWriter h =>
    WriterConn t h -> BoolExpr t -> IO (Term h)
    mkFormula = WriterConn t h -> Expr t BaseBoolType -> IO (Term h)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h -> Expr t tp -> IO (Term h)
    mkSMTTerm

    mkAtomicFormula :: SMTWriter h => WriterConn t h -> BoolExpr t -> IO Text
    mkAtomicFormula :: forall h t. SMTWriter h => WriterConn t h -> BoolExpr t -> IO Text
    mkAtomicFormula WriterConn t h
    conn BoolExpr t
    p = WriterConn t h -> SMTCollector t h Text -> IO Text
    forall h t a.
    SMTWriter h =>
    WriterConn t h -> SMTCollector t h a -> IO a
    runOnLiveConnection WriterConn t h
    conn (SMTCollector t h Text -> IO Text)
    -> SMTCollector t h Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $
      BoolExpr t -> SMTCollector t h (SMTExpr h BaseBoolType)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    Expr t tp -> SMTCollector t h (SMTExpr h tp)
    mkExpr BoolExpr t
    p SMTCollector t h (SMTExpr h BaseBoolType)
    -> (SMTExpr h BaseBoolType -> SMTCollector t h Text)
    -> SMTCollector t h Text
    forall a b.
    ReaderT (SMTCollectorState t h) IO a
    -> (a -> ReaderT (SMTCollectorState t h) IO b)
    -> ReaderT (SMTCollectorState t h) IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        SMTName TypeMap BaseBoolType
    _ Text
    nm  -> Text -> SMTCollector t h Text
    forall a. a -> ReaderT (SMTCollectorState t h) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Text
    nm
        SMTExpr TypeMap BaseBoolType
    ty Term h
    tm -> [(Text, Some TypeMap)]
    -> TypeMap BaseBoolType -> Term h -> SMTCollector t h Text
    forall (rtp :: BaseType) h t.
    [(Text, Some TypeMap)]
    -> TypeMap rtp -> Term h -> SMTCollector t h Text
    freshBoundFn [] TypeMap BaseBoolType
    ty Term h
    tm

    -- | Write assume formula predicates for asserting predicate holds.
    assume :: SMTWriter h => WriterConn t h -> BoolExpr t -> IO ()
    assume :: forall h t. SMTWriter h => WriterConn t h -> BoolExpr t -> IO ()
    assume WriterConn t h
    c BoolExpr t
    p = do
      [(BoolExpr t, Polarity)]
    -> ((BoolExpr t, Polarity) -> IO ()) -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (BoolExpr t -> [(BoolExpr t, Polarity)]
    forall t. Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
    asConjunction BoolExpr t
    p) (((BoolExpr t, Polarity) -> IO ()) -> IO ())
    -> ((BoolExpr t, Polarity) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(BoolExpr t
    v,Polarity
    pl) -> do
        f <- WriterConn t h -> BoolExpr t -> IO (Term h)
    forall h t.
    SMTWriter h =>
    WriterConn t h -> BoolExpr t -> IO (Term h)
    mkFormula WriterConn t h
    c BoolExpr t
    v
        updateProgramLoc c (exprLoc v)
        case pl of
          Polarity
    BM.Positive -> WriterConn t h -> Term h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Term h -> IO ()
    assumeFormula WriterConn t h
    c Term h
    f
          Polarity
    BM.Negative -> WriterConn t h -> Term h -> IO ()
    forall h t. SMTWriter h => WriterConn t h -> Term h -> IO ()
    assumeFormula WriterConn t h
    c (Term h -> Term h
    forall v. SupportTermOps v => v -> v
    notExpr Term h
    f)

    type SMTEvalBVArrayFn h w v =
        (1 <= w,
         1 <= v)
      => NatRepr w
      -> NatRepr v
      -> Term h
      -> IO (Maybe (GroundArray (Ctx.SingleCtx (BaseBVType w)) (BaseBVType v)))

    newtype SMTEvalBVArrayWrapper h =
      SMTEvalBVArrayWrapper { forall h.
    SMTEvalBVArrayWrapper h
    -> forall (w :: Natural) (v :: Natural). SMTEvalBVArrayFn h w v
    unEvalBVArrayWrapper :: forall w v. SMTEvalBVArrayFn h w v }

    data SMTEvalFunctions h
       = SMTEvalFunctions { forall h. SMTEvalFunctions h -> Term h -> IO Bool
    smtEvalBool :: Term h -> IO Bool
                            -- ^ Given a SMT term for a Boolean value, this should
                            -- return an indication of whether the term is assigned
                            -- true or false.
                          , forall h.
    SMTEvalFunctions h
    -> forall (w :: Natural). NatRepr w -> Term h -> IO (BV w)
    smtEvalBV   :: forall w . NatRepr w -> Term h -> IO (BV.BV w)
                            -- ^ Given a bitwidth, and a SMT term for a bitvector
                            -- with that bitwidth, this should return an unsigned
                            -- integer with the value of that bitvector.
                          , forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal :: Term h -> IO Rational
                            -- ^ Given a SMT term for real value, this should
                            -- return a rational value for that term.
                          , forall h.
    SMTEvalFunctions h
    -> forall (fpp :: FloatPrecision).
       FloatPrecisionRepr fpp
       -> Term h -> IO (BV (FloatPrecisionBits fpp))
    smtEvalFloat :: forall fpp . FloatPrecisionRepr fpp -> Term h -> IO (BV.BV (FloatPrecisionBits fpp))
                            -- ^ Given floating point format, and an SMT
                            -- term for a floating-point value in that
                            -- format, this returns an unsigned integer
                            -- with the bits of the IEEE-754
                            -- representation.
                          , forall h. SMTEvalFunctions h -> Maybe (SMTEvalBVArrayWrapper h)
    smtEvalBvArray :: Maybe (SMTEvalBVArrayWrapper h)
                            -- ^ If 'Just', a function to read arrays whose domain
                            -- and codomain are both bitvectors. If 'Nothing',
                            -- signifies that we should fall back to index-selection
                            -- representation of arrays.
                          , forall h. SMTEvalFunctions h -> Term h -> IO Text
    smtEvalString :: Term h -> IO Text
                            -- ^ Given a SMT term representing as sequence of bytes,
                            -- return the value as a bytestring.
                          }

    -- | Used when we need two way communication with the solver.
    class SMTWriter h => SMTReadWriter h where
      -- | Get functions for parsing values out of the solver.
      smtEvalFuns ::
        WriterConn t h -> Streams.InputStream Text -> SMTEvalFunctions h

      -- | Parse a set result from the solver's response.
      smtSatResult :: f h -> WriterConn t h -> IO (SatResult () ())

      -- | Parse a list of names of assumptions that form an unsatisfiable core.
      --   These correspond to previously-named assertions.
      smtUnsatCoreResult :: f h -> WriterConn t h -> IO [Text]

      -- | Parse an abduct returned by the get-abduct command
      smtAbductResult :: f h -> WriterConn t h -> Text -> Term h -> IO String

      -- | Parse an abduct returned by the get-abduct-next command
      smtAbductNextResult :: f h -> WriterConn t h -> IO String

      -- | Parse a list of names of assumptions that form an unsatisfiable core.
      --   The boolean indicates the polarity of the atom: true for an ordinary
      --   atom, false for a negated atom.
      smtUnsatAssumptionsResult :: f h -> WriterConn t h -> IO [(Bool,Text)]

    -- | Return the terms associated with the given ground index variables.
    smtIndicesTerms :: forall v idx
                    .  SupportTermOps v
                    => Ctx.Assignment TypeMap idx
                    -> Ctx.Assignment GroundValueWrapper  idx
                    -> [v]
    smtIndicesTerms :: forall v (idx :: Ctx BaseType).
    SupportTermOps v =>
    Assignment TypeMap idx -> Assignment GroundValueWrapper idx -> [v]
    smtIndicesTerms Assignment TypeMap idx
    tps Assignment GroundValueWrapper idx
    vals = Int
    -> Size idx
    -> (forall (tp :: BaseType). Index idx tp -> [v] -> [v])
    -> [v]
    -> [v]
    forall {k} (ctx :: Ctx k) r.
    Int
    -> Size ctx -> (forall (tp :: k). Index ctx tp -> r -> r) -> r -> r
    Ctx.forIndexRange Int
    0 Size idx
    sz Index idx tp -> [v] -> [v]
    forall (tp :: BaseType). Index idx tp -> [v] -> [v]
    f []
      where sz :: Size idx
    sz = Assignment TypeMap idx -> Size idx
    forall {k} (f :: k -> Type) (ctx :: Ctx k).
    Assignment f ctx -> Size ctx
    Ctx.size Assignment TypeMap idx
    tps
            f :: Ctx.Index idx tp -> [v] -> [v]
            f :: forall (tp :: BaseType). Index idx tp -> [v] -> [v]
    f Index idx tp
    i [v]
    l = (v
    rv -> [v] -> [v]
    forall a. a -> [a] -> [a]
    :[v]
    l)
             where GVW GroundValue tp
    v = Assignment GroundValueWrapper idx
    vals Assignment GroundValueWrapper idx
    -> Index idx tp -> GroundValueWrapper tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index idx tp
    i
                   r :: v
    r = case Assignment TypeMap idx
    tps Assignment TypeMap idx -> Index idx tp -> TypeMap tp
    forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
    Assignment f ctx -> Index ctx tp -> f tp
    Ctx.! Index idx tp
    i of
                          TypeMap tp
    IntegerTypeMap -> Integer -> v
    forall v. SupportTermOps v => Integer -> v
    integerTerm Integer
    GroundValue tp
    v
                          BVTypeMap NatRepr w
    w -> NatRepr w -> BV w -> v
    forall (w :: Natural). NatRepr w -> BV w -> v
    forall v (w :: Natural). SupportTermOps v => NatRepr w -> BV w -> v
    bvTerm NatRepr w
    w BV w
    GroundValue tp
    v
                          TypeMap tp
    _ -> String -> v
    forall a. HasCallStack => String -> a
    error String
    "Do not yet support other index types."

    getSolverVal :: forall h t tp
                 .  SMTWriter h
                 => WriterConn t h
                 -> SMTEvalFunctions h
                 -> TypeMap tp
                 -> Term h
                 -> IO (GroundValue tp)
    getSolverVal :: forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns TypeMap tp
    BoolTypeMap   Term h
    tm = SMTEvalFunctions h -> Term h -> IO Bool
    forall h. SMTEvalFunctions h -> Term h -> IO Bool
    smtEvalBool SMTEvalFunctions h
    smtFns Term h
    tm
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns (BVTypeMap NatRepr w
    w) Term h
    tm = SMTEvalFunctions h
    -> forall (w :: Natural). NatRepr w -> Term h -> IO (BV w)
    forall h.
    SMTEvalFunctions h
    -> forall (w :: Natural). NatRepr w -> Term h -> IO (BV w)
    smtEvalBV SMTEvalFunctions h
    smtFns NatRepr w
    w Term h
    tm
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns TypeMap tp
    RealTypeMap   Term h
    tm = SMTEvalFunctions h -> Term h -> IO Rational
    forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal SMTEvalFunctions h
    smtFns Term h
    tm
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns (FloatTypeMap FloatPrecisionRepr fpp
    fpp) Term h
    tm =
      BFOpts -> Integer -> BigFloat
    bfFromBits (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
    forall (fpp :: FloatPrecision).
    FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
    fppOpts FloatPrecisionRepr fpp
    fpp RoundingMode
    RNE) (Integer -> BigFloat)
    -> (BV (FloatPrecisionBits fpp) -> Integer)
    -> BV (FloatPrecisionBits fpp)
    -> BigFloat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BV (FloatPrecisionBits fpp) -> Integer
    forall (w :: Natural). BV w -> Integer
    BV.asUnsigned (BV (FloatPrecisionBits fpp) -> BigFloat)
    -> IO (BV (FloatPrecisionBits fpp)) -> IO BigFloat
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> SMTEvalFunctions h
    -> forall (fpp :: FloatPrecision).
       FloatPrecisionRepr fpp
       -> Term h -> IO (BV (FloatPrecisionBits fpp))
    forall h.
    SMTEvalFunctions h
    -> forall (fpp :: FloatPrecision).
       FloatPrecisionRepr fpp
       -> Term h -> IO (BV (FloatPrecisionBits fpp))
    smtEvalFloat SMTEvalFunctions h
    smtFns FloatPrecisionRepr fpp
    fpp Term h
    tm
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns TypeMap tp
    UnicodeTypeMap Term h
    tm = Text -> StringLiteral Unicode
    UnicodeLiteral (Text -> StringLiteral Unicode)
    -> IO Text -> IO (StringLiteral Unicode)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> SMTEvalFunctions h -> Term h -> IO Text
    forall h. SMTEvalFunctions h -> Term h -> IO Text
    smtEvalString SMTEvalFunctions h
    smtFns Term h
    tm
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns TypeMap tp
    IntegerTypeMap Term h
    tm = do
      r <- SMTEvalFunctions h -> Term h -> IO Rational
    forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal SMTEvalFunctions h
    smtFns Term h
    tm
      when (denominator r /= 1) $ fail "Expected integer value."
      return (numerator r)
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns TypeMap tp
    ComplexToStructTypeMap Term h
    tm =
      Rational -> Rational -> Complex Rational
    forall a. a -> a -> Complex a
    (:+) (Rational -> Rational -> Complex Rational)
    -> IO Rational -> IO (Rational -> Complex Rational)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> SMTEvalFunctions h -> Term h -> IO Rational
    forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal SMTEvalFunctions h
    smtFns (forall h. SMTWriter h => Term h -> Term h
    structComplexRealPart @h Term h
    tm)
           IO (Rational -> Complex Rational)
    -> IO Rational -> IO (Complex Rational)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> SMTEvalFunctions h -> Term h -> IO Rational
    forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal SMTEvalFunctions h
    smtFns (forall h. SMTWriter h => Term h -> Term h
    structComplexImagPart @h Term h
    tm)
    getSolverVal WriterConn t h
    _ SMTEvalFunctions h
    smtFns TypeMap tp
    ComplexToArrayTypeMap Term h
    tm =
      Rational -> Rational -> Complex Rational
    forall a. a -> a -> Complex a
    (:+) (Rational -> Rational -> Complex Rational)
    -> IO Rational -> IO (Rational -> Complex Rational)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> SMTEvalFunctions h -> Term h -> IO Rational
    forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal SMTEvalFunctions h
    smtFns (forall h. SMTWriter h => Term h -> Term h
    arrayComplexRealPart @h Term h
    tm)
           IO (Rational -> Complex Rational)
    -> IO Rational -> IO (Complex Rational)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> SMTEvalFunctions h -> Term h -> IO Rational
    forall h. SMTEvalFunctions h -> Term h -> IO Rational
    smtEvalReal SMTEvalFunctions h
    smtFns (forall h. SMTWriter h => Term h -> Term h
    arrayComplexImagPart @h Term h
    tm)
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns (PrimArrayTypeMap Assignment TypeMap (idxl ::> idx)
    idx_types TypeMap tp
    eltTp) Term h
    tm
      | Just (SMTEvalBVArrayWrapper forall (w :: Natural) (v :: Natural). SMTEvalBVArrayFn h w v
    evalBVArray) <- SMTEvalFunctions h -> Maybe (SMTEvalBVArrayWrapper h)
    forall h. SMTEvalFunctions h -> Maybe (SMTEvalBVArrayWrapper h)
    smtEvalBvArray SMTEvalFunctions h
    smtFns
      , Assignment TypeMap ctx
    Ctx.Empty Ctx.:> (BVTypeMap NatRepr w
    w) <- Assignment TypeMap (idxl ::> idx)
    idx_types
      , BVTypeMap NatRepr w
    v <- TypeMap tp
    eltTp =
          GroundArray (idxl ::> idx) tp
    -> Maybe (GroundArray (idxl ::> idx) tp)
    -> GroundArray (idxl ::> idx) tp
    forall a. a -> Maybe a -> a
    fromMaybe GroundArray (idxl ::> idx) tp
    byIndex (Maybe (GroundArray (idxl ::> idx) tp)
     -> GroundArray (idxl ::> idx) tp)
    -> IO (Maybe (GroundArray (idxl ::> idx) tp))
    -> IO (GroundArray (idxl ::> idx) tp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatRepr w
    -> NatRepr w
    -> Term h
    -> IO
         (Maybe (GroundArray (SingleCtx ('BaseBVType w)) ('BaseBVType w)))
    forall (w :: Natural) (v :: Natural). SMTEvalBVArrayFn h w v
    evalBVArray NatRepr w
    w NatRepr w
    v Term h
    tm
      | Bool
    otherwise = GroundArray (idxl ::> idx) tp -> IO (GroundArray (idxl ::> idx) tp)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return GroundArray (idxl ::> idx) tp
    byIndex
      where byIndex :: GroundArray (idxl ::> idx) tp
    byIndex = (Assignment GroundValueWrapper (idxl ::> idx)
     -> IO (GroundValue tp))
    -> GroundArray (idxl ::> idx) tp
    forall (idx :: Ctx BaseType) (b :: BaseType).
    (Assignment GroundValueWrapper idx -> IO (GroundValue b))
    -> GroundArray idx b
    ArrayMapping ((Assignment GroundValueWrapper (idxl ::> idx)
      -> IO (GroundValue tp))
     -> GroundArray (idxl ::> idx) tp)
    -> (Assignment GroundValueWrapper (idxl ::> idx)
        -> IO (GroundValue tp))
    -> GroundArray (idxl ::> idx) tp
    forall a b. (a -> b) -> a -> b
    $ \Assignment GroundValueWrapper (idxl ::> idx)
    i -> do
              let res :: Term h
    res = forall h. SMTWriter h => Term h -> [Term h] -> Term h
    arraySelect @h Term h
    tm (Assignment TypeMap (idxl ::> idx)
    -> Assignment GroundValueWrapper (idxl ::> idx) -> [Term h]
    forall v (idx :: Ctx BaseType).
    SupportTermOps v =>
    Assignment TypeMap idx -> Assignment GroundValueWrapper idx -> [v]
    smtIndicesTerms Assignment TypeMap (idxl ::> idx)
    idx_types Assignment GroundValueWrapper (idxl ::> idx)
    i)
              WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns TypeMap tp
    eltTp Term h
    res
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns (FnArrayTypeMap Assignment TypeMap (idxl ::> idx)
    idx_types TypeMap tp
    eltTp) Term h
    tm = GroundValue tp -> IO (GroundValue tp)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (GroundValue tp -> IO (GroundValue tp))
    -> GroundValue tp -> IO (GroundValue tp)
    forall a b. (a -> b) -> a -> b
    $ (Assignment GroundValueWrapper (idxl ::> idx)
     -> IO (GroundValue tp))
    -> GroundArray (idxl ::> idx) tp
    forall (idx :: Ctx BaseType) (b :: BaseType).
    (Assignment GroundValueWrapper idx -> IO (GroundValue b))
    -> GroundArray idx b
    ArrayMapping ((Assignment GroundValueWrapper (idxl ::> idx)
      -> IO (GroundValue tp))
     -> GroundArray (idxl ::> idx) tp)
    -> (Assignment GroundValueWrapper (idxl ::> idx)
        -> IO (GroundValue tp))
    -> GroundArray (idxl ::> idx) tp
    forall a b. (a -> b) -> a -> b
    $ \Assignment GroundValueWrapper (idxl ::> idx)
    i -> do
      let term :: Term h
    term = Term h -> [Term h] -> Term h
    forall v. SupportTermOps v => v -> [v] -> v
    smtFnApp Term h
    tm (Assignment TypeMap (idxl ::> idx)
    -> Assignment GroundValueWrapper (idxl ::> idx) -> [Term h]
    forall v (idx :: Ctx BaseType).
    SupportTermOps v =>
    Assignment TypeMap idx -> Assignment GroundValueWrapper idx -> [v]
    smtIndicesTerms Assignment TypeMap (idxl ::> idx)
    idx_types Assignment GroundValueWrapper (idxl ::> idx)
    i)
      WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns TypeMap tp
    eltTp Term h
    term
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns (StructTypeMap Assignment TypeMap idx
    flds0) Term h
    tm =
              (forall (tp :: BaseType).
     Index idx tp -> TypeMap tp -> IO (GroundValueWrapper tp))
    -> Assignment TypeMap idx -> IO (Assignment GroundValueWrapper idx)
    forall {k} (m :: Type -> Type) (ctx :: Ctx k) (f :: k -> Type)
           (g :: k -> Type).
    Applicative m =>
    (forall (tp :: k). Index ctx tp -> f tp -> m (g tp))
    -> Assignment f ctx -> m (Assignment g ctx)
    Ctx.traverseWithIndex (Assignment TypeMap idx
    -> Index idx tp -> TypeMap tp -> IO (GroundValueWrapper tp)
    forall (ctx :: Ctx BaseType) (utp :: BaseType).
    Assignment TypeMap ctx
    -> Index ctx utp -> TypeMap utp -> IO (GroundValueWrapper utp)
    f Assignment TypeMap idx
    flds0) Assignment TypeMap idx
    flds0
            where f :: Ctx.Assignment TypeMap ctx
                    -> Ctx.Index ctx utp
                    -> TypeMap utp
                    -> IO (GroundValueWrapper utp)
                  f :: forall (ctx :: Ctx BaseType) (utp :: BaseType).
    Assignment TypeMap ctx
    -> Index ctx utp -> TypeMap utp -> IO (GroundValueWrapper utp)
    f Assignment TypeMap ctx
    flds Index ctx utp
    i TypeMap utp
    tp = GroundValue utp -> GroundValueWrapper utp
    forall (tp :: BaseType). GroundValue tp -> GroundValueWrapper tp
    GVW (GroundValue utp -> GroundValueWrapper utp)
    -> IO (GroundValue utp) -> IO (GroundValueWrapper utp)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap utp
    -> Term h
    -> IO (GroundValue utp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns TypeMap utp
    tp Term h
    v
                    where v :: Term h
    v = forall h (args :: Ctx BaseType) (tp :: BaseType).
    SMTWriter h =>
    Assignment TypeMap args -> Index args tp -> Term h -> Term h
    structProj @h Assignment TypeMap ctx
    flds Index ctx utp
    i Term h
    tm

    -- | The function creates a function for evaluating elts to concrete values
    -- given a connection to an SMT solver along with some functions for evaluating
    -- different types of terms to concrete values.
    smtExprGroundEvalFn :: forall t h
                         . SMTWriter h
                        => WriterConn t h
                           -- ^ Connection to SMT solver.
                        -> SMTEvalFunctions h
                        -> IO (GroundEvalFn t)
    smtExprGroundEvalFn :: forall t h.
    SMTWriter h =>
    WriterConn t h -> SMTEvalFunctions h -> IO (GroundEvalFn t)
    smtExprGroundEvalFn WriterConn t h
    conn SMTEvalFunctions h
    smtFns = do
      -- Get solver features
      groundCache <- IO (IdxCache t GroundValueWrapper)
    forall (m :: Type -> Type) t (f :: BaseType -> Type).
    MonadIO m =>
    m (IdxCache t f)
    newIdxCache

      let cachedEval :: Expr t tp -> IO (GroundValue tp)
          cachedEval Expr t tp
    e =
            case Expr t tp -> Maybe (Nonce t tp)
    forall t (tp :: BaseType). Expr t tp -> Maybe (Nonce t tp)
    exprMaybeId Expr t tp
    e of
              Maybe (Nonce t tp)
    Nothing -> (forall (tp :: BaseType). Expr t tp -> IO (GroundValue tp))
    -> Expr t tp -> IO (GroundValue tp)
    forall t (tp :: BaseType).
    (forall (u :: BaseType). Expr t u -> IO (GroundValue u))
    -> Expr t tp -> IO (GroundValue tp)
    evalGroundExpr Expr t u -> IO (GroundValue u)
    forall (tp :: BaseType). Expr t tp -> IO (GroundValue tp)
    cachedEval Expr t tp
    e
              Just Nonce t tp
    e_id -> (GroundValueWrapper tp -> GroundValue tp)
    -> IO (GroundValueWrapper tp) -> IO (GroundValue tp)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap GroundValueWrapper tp -> GroundValue tp
    forall (tp :: BaseType). GroundValueWrapper tp -> GroundValue tp
    unGVW (IO (GroundValueWrapper tp) -> IO (GroundValue tp))
    -> IO (GroundValueWrapper tp) -> IO (GroundValue tp)
    forall a b. (a -> b) -> a -> b
    $ IdxCache t GroundValueWrapper
    -> Nonce t tp
    -> IO (GroundValueWrapper tp)
    -> IO (GroundValueWrapper tp)
    forall (m :: Type -> Type) t (f :: BaseType -> Type)
           (tp :: BaseType).
    MonadIO m =>
    IdxCache t f -> Nonce t tp -> m (f tp) -> m (f tp)
    idxCacheEval' IdxCache t GroundValueWrapper
    groundCache Nonce t tp
    e_id (IO (GroundValueWrapper tp) -> IO (GroundValueWrapper tp))
    -> IO (GroundValueWrapper tp) -> IO (GroundValueWrapper tp)
    forall a b. (a -> b) -> a -> b
    $ (GroundValue tp -> GroundValueWrapper tp)
    -> IO (GroundValue tp) -> IO (GroundValueWrapper tp)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap GroundValue tp -> GroundValueWrapper tp
    forall (tp :: BaseType). GroundValue tp -> GroundValueWrapper tp
    GVW (IO (GroundValue tp) -> IO (GroundValueWrapper tp))
    -> IO (GroundValue tp) -> IO (GroundValueWrapper tp)
    forall a b. (a -> b) -> a -> b
    $ do
                -- See if we have bound the Expr e to a SMT expression.
                me <- WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    forall t h (tp :: BaseType).
    WriterConn t h -> Nonce t tp -> IO (Maybe (SMTExpr h tp))
    cacheLookupExpr WriterConn t h
    conn Nonce t tp
    e_id
                case me of
                  -- Otherwise, try the evalGroundExpr function to evaluate a ground element.
                  Maybe (SMTExpr h tp)
    Nothing -> (forall (tp :: BaseType). Expr t tp -> IO (GroundValue tp))
    -> Expr t tp -> IO (GroundValue tp)
    forall t (tp :: BaseType).
    (forall (u :: BaseType). Expr t u -> IO (GroundValue u))
    -> Expr t tp -> IO (GroundValue tp)
    evalGroundExpr Expr t u -> IO (GroundValue u)
    forall (tp :: BaseType). Expr t tp -> IO (GroundValue tp)
    cachedEval Expr t tp
    e

                  -- If so, try asking the solver for the value of SMT expression.
                  Just (SMTName TypeMap tp
    tp Text
    nm) ->
                    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns TypeMap tp
    tp (Text -> Term h
    forall v. SupportTermOps v => Text -> v
    fromText Text
    nm)

                  Just (SMTExpr TypeMap tp
    tp Term h
    expr) ->
                    MaybeT IO (GroundValue tp) -> IO (Maybe (GroundValue tp))
    forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
    runMaybeT ((forall (u :: BaseType). Expr t u -> MaybeT IO (GroundValue u))
    -> Expr t tp -> MaybeT IO (GroundValue tp)
    forall t (tp :: BaseType).
    (forall (u :: BaseType). Expr t u -> MaybeT IO (GroundValue u))
    -> Expr t tp -> MaybeT IO (GroundValue tp)
    tryEvalGroundExpr (IO (GroundValue u) -> MaybeT IO (GroundValue u)
    forall (m :: Type -> Type) a. Monad m => m a -> MaybeT m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (GroundValue u) -> MaybeT IO (GroundValue u))
    -> (Expr t u -> IO (GroundValue u))
    -> Expr t u
    -> MaybeT IO (GroundValue u)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Expr t u -> IO (GroundValue u)
    forall (tp :: BaseType). Expr t tp -> IO (GroundValue tp)
    cachedEval) Expr t tp
    e) IO (Maybe (GroundValue tp))
    -> (Maybe (GroundValue tp) -> IO (GroundValue tp))
    -> IO (GroundValue tp)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                      Just GroundValue tp
    x  -> GroundValue tp -> IO (GroundValue tp)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return GroundValue tp
    x
                      -- If we cannot compute the value ourself, query the
                      -- value from the solver directly instead.
                      Maybe (GroundValue tp)
    Nothing -> WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    forall h t (tp :: BaseType).
    SMTWriter h =>
    WriterConn t h
    -> SMTEvalFunctions h
    -> TypeMap tp
    -> Term h
    -> IO (GroundValue tp)
    getSolverVal WriterConn t h
    conn SMTEvalFunctions h
    smtFns TypeMap tp
    tp Term h
    expr

      return $ GroundEvalFn cachedEval