    -----------------------------------------------------------------------------
    -- |
    -- Module    : Data.SBV.Control.Utils
    -- Copyright : (c) Levent Erkok
    -- License   : BSD3
    -- Maintainer: erkokl@gmail.com
    -- Stability : experimental
    --
    -- Query related utils.
    -----------------------------------------------------------------------------

    {-# LANGUAGE BangPatterns           #-}
    {-# LANGUAGE FlexibleContexts       #-}
    {-# LANGUAGE FlexibleInstances      #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE LambdaCase             #-}
    {-# LANGUAGE NamedFieldPuns         #-}
    {-# LANGUAGE OverloadedStrings      #-}
    {-# LANGUAGE ScopedTypeVariables    #-}
    {-# LANGUAGE TupleSections          #-}
    {-# LANGUAGE TypeApplications       #-}
    {-# LANGUAGE TypeFamilies           #-}
    {-# LANGUAGE ViewPatterns           #-}
    {-# LANGUAGE UndecidableInstances   #-}

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

    module Data.SBV.Control.Utils (
           io
         , ask, send, getValue, getFunction, getUninterpretedValue
         , getValueCV, getUICVal, getUIFunCVAssoc, getUnsatAssumptions
         , SMTFunction(..), registerUISMTFunction
         , getQueryState, modifyQueryState, getConfig, getObjectives, getUIs
         , getSBVAssertions, getSBVPgm, getObservables
         , checkSat, checkSatUsing, getAllSatResult
         , inNewContext, freshVar, freshVar_, freshArray, freshArray_, freshLambdaArray, freshLambdaArray_
         , getTopLevelInputs, parse, unexpected
         , timeout, queryDebug, retrieveResponse, recoverKindedValue, runProofOn, executeQuery
         ) where

    import Data.List  (sortBy, sortOn, elemIndex, partition, groupBy, tails, intercalate, nub, sort, isPrefixOf)

    import Data.Char      (isPunctuation, isSpace, isDigit)
    import Data.Function  (on)
    import Data.Bifunctor (first)

    import Data.Proxy

    import qualified Data.Foldable      as F (toList)
    import qualified Data.Map.Strict    as Map
    import qualified Data.IntMap.Strict as IMap
    import qualified Data.Sequence      as S
    import qualified Data.Text          as T

    import Control.Monad            (join, unless, zipWithM, when, replicateM, forM_)
    import Control.Monad.IO.Class   (MonadIO, liftIO)
    import Control.Monad.Trans      (lift)
    import Control.Monad.Reader     (runReaderT)

    import Data.Maybe (isNothing, isJust, mapMaybe)

    import Data.IORef (readIORef, writeIORef, IORef, newIORef, modifyIORef')

    import Data.Time (getZonedTime)
    import Data.Ratio

    import Data.SBV.Core.Data     ( SV(..), trueSV, falseSV, CV(..), trueCV, falseCV, SBV, sbvToSV, kindOf, Kind(..)
                                  , HasKind(..), mkConstCV, CVal(..), SMTResult(..)
                                  , NamedSymVar, SMTConfig(..), SMTModel(..)
                                  , QueryState(..), SVal(..), cache
                                  , newExpr, SBVExpr(..), Op(..), FPOp(..), SBV(..), SymArray(..)
                                  , SolverContext(..), SBool, Objective(..), SolverCapabilities(..), capabilities
                                  , Result(..), SMTProblem(..), trueSV, SymVal(..), SBVPgm(..), SMTSolver(..), SBVRunMode(..)
                                  , SBVType(..), forceSVArg, RoundingMode(RoundNearestTiesToEven), (.=>)
                                  , RCSet(..), Lambda(..), QuantifiedBool(..)
                                  )

    import Data.SBV.Core.Symbolic ( IncState(..), withNewIncState, State(..), svToSV, symbolicEnv, SymbolicT
                                  , MonadQuery(..), QueryContext(..), Queriable(..), Fresh(..), VarContext(..)
                                  , registerLabel, svMkSymVar, validationRequested
                                  , isSafetyCheckingIStage, isSetupIStage, isRunIStage, IStage(..), QueryT(..)
                                  , extractSymbolicSimulationState, MonadSymbolic(..), newUninterpreted
                                  , UserInputs, getSV, NamedSymVar(..), lookupInput, getUserName'
                                  , Name, CnstMap, UICodeKind(UINone), smtDefGivenName, Inputs(..), ProgInfo(..)
                                  , mustIgnoreVar
                                  )

    import Data.SBV.Core.AlgReals    (mergeAlgReals, AlgReal(..), RealPoint(..))
    import Data.SBV.Core.SizedFloats (fpZero, fpFromInteger, fpFromFloat, fpFromDouble)
    import Data.SBV.Core.Kind        (smtType, hasUninterpretedSorts)
    import Data.SBV.Core.Operations  (svNot, svNotEqual, svOr, svEqual)

    import Data.SBV.SMT.SMT     (showModel, parseCVs, SatModel, AllSatResult(..))
    import Data.SBV.SMT.SMTLib  (toIncSMTLib, toSMTLib)
    import Data.SBV.SMT.Utils   (showTimeoutValue, addAnnotations, alignPlain, debug, mergeSExpr, SBVException(..))

    import Data.SBV.Utils.ExtractIO
    import Data.SBV.Utils.Lib       (qfsToString)
    import Data.SBV.Utils.SExpr
    import Data.SBV.Utils.PrettyNum (cvToSMTLib)

    import Data.SBV.Lambda

    import Data.SBV.Control.Types

    import qualified Data.Set as Set (empty, fromList, toAscList)

    import qualified Control.Exception as C

    import GHC.Stack

    -- | 'Data.SBV.Trans.Control.QueryT' as a 'SolverContext'.
    instance MonadIO m => SolverContext (QueryT m) where
       constrain :: forall a. QuantifiedBool a => a -> QueryT m ()
    constrain                   = Bool -> [([Char], [Char])] -> SBool -> QueryT m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [([Char], [Char])] -> SBool -> m ()
    addQueryConstraint Bool
    False []                (SBool -> QueryT m ()) -> (a -> SBool) -> a -> QueryT m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> SBool
    forall a. QuantifiedBool a => a -> SBool
    quantifiedBool
       softConstrain :: forall a. QuantifiedBool a => a -> QueryT m ()
    softConstrain               = Bool -> [([Char], [Char])] -> SBool -> QueryT m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [([Char], [Char])] -> SBool -> m ()
    addQueryConstraint Bool
    True  []                (SBool -> QueryT m ()) -> (a -> SBool) -> a -> QueryT m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> SBool
    forall a. QuantifiedBool a => a -> SBool
    quantifiedBool
       namedConstraint :: forall a. QuantifiedBool a => [Char] -> a -> QueryT m ()
    namedConstraint [Char]
    nm          = Bool -> [([Char], [Char])] -> SBool -> QueryT m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [([Char], [Char])] -> SBool -> m ()
    addQueryConstraint Bool
    False [([Char]
    ":named", [Char]
    nm)]  (SBool -> QueryT m ()) -> (a -> SBool) -> a -> QueryT m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> SBool
    forall a. QuantifiedBool a => a -> SBool
    quantifiedBool
       constrainWithAttribute :: forall a.
    QuantifiedBool a =>
    [([Char], [Char])] -> a -> QueryT m ()
    constrainWithAttribute [([Char], [Char])]
    attr = Bool -> [([Char], [Char])] -> SBool -> QueryT m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [([Char], [Char])] -> SBool -> m ()
    addQueryConstraint Bool
    False [([Char], [Char])]
    attr              (SBool -> QueryT m ()) -> (a -> SBool) -> a -> QueryT m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> SBool
    forall a. QuantifiedBool a => a -> SBool
    quantifiedBool

       contextState :: QueryT m State
    contextState = QueryT m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState

       setOption :: SMTOption -> QueryT m ()
    setOption SMTOption
    o
         | SMTOption -> Bool
    isStartModeOption SMTOption
    o = [Char] -> QueryT m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> QueryT m ()) -> [Char] -> QueryT m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                                 , [Char]
    "*** Data.SBV: '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SMTOption -> [Char]
    forall a. Show a => a -> [Char]
    show SMTOption
    o [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "' can only be set at start-up time."
                                                 , [Char]
    "*** Hint: Move the call to 'setOption' before the query."
                                                 ]
         | Bool
    True                = Bool -> [Char] -> QueryT m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True ([Char] -> QueryT m ()) -> [Char] -> QueryT m ()
    forall a b. (a -> b) -> a -> b
    $ SMTOption -> [Char]
    setSMTOption SMTOption
    o

    -- | Adding a constraint, possibly with attributes and possibly soft. Only used internally.
    -- Use 'constrain' and 'namedConstraint' from user programs.
    addQueryConstraint :: (MonadIO m, MonadQuery m) => Bool -> [(String, String)] -> SBool -> m ()
    addQueryConstraint :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [([Char], [Char])] -> SBool -> m ()
    addQueryConstraint Bool
    isSoft [([Char], [Char])]
    atts SBool
    b = do SV
    sv <- (State -> IO SV) -> m SV
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext (\State
    st -> IO SV -> IO SV
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO SV -> IO SV) -> IO SV -> IO SV
    forall a b. (a -> b) -> a -> b
    $ do ([Char] -> IO ()) -> [[Char]] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ([Char] -> State -> [Char] -> IO ()
    registerLabel [Char]
    "Constraint" State
    st) [[Char]
    nm | ([Char]
    ":named", [Char]
    nm) <- [([Char], [Char])]
    atts]
                                                                                 State -> SBool -> IO SV
    forall a. State -> SBV a -> IO SV
    sbvToSV State
    st SBool
    b)

                                          Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([([Char], [Char])] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [([Char], [Char])]
    atts Bool -> Bool -> Bool
    && SV
    sv SV -> SV -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV
    trueSV) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                                                 Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "(" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    asrt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [([Char], [Char])] -> [Char] -> [Char]
    addAnnotations [([Char], [Char])]
    atts (SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    sv)  [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
       where asrt :: [Char]
    asrt | Bool
    isSoft = [Char]
    "assert-soft"
                  | Bool
    True   = [Char]
    "assert"

    -- | Get the current configuration
    getConfig :: (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig = QueryState -> SMTConfig
    queryConfig (QueryState -> SMTConfig) -> m QueryState -> m SMTConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m QueryState
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState

    -- | Get the objectives
    getObjectives :: (MonadIO m, MonadQuery m) => m [Objective (SV, SV)]
    getObjectives :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    m [Objective (SV, SV)]
    getObjectives = do State{IORef [Objective (SV, SV)]
    rOptGoals :: IORef [Objective (SV, SV)]
    rOptGoals :: State -> IORef [Objective (SV, SV)]
    rOptGoals} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                       IO [Objective (SV, SV)] -> m [Objective (SV, SV)]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Objective (SV, SV)] -> m [Objective (SV, SV)])
    -> IO [Objective (SV, SV)] -> m [Objective (SV, SV)]
    forall a b. (a -> b) -> a -> b
    $ [Objective (SV, SV)] -> [Objective (SV, SV)]
    forall a. [a] -> [a]
    reverse ([Objective (SV, SV)] -> [Objective (SV, SV)])
    -> IO [Objective (SV, SV)] -> IO [Objective (SV, SV)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [Objective (SV, SV)] -> IO [Objective (SV, SV)]
    forall a. IORef a -> IO a
    readIORef IORef [Objective (SV, SV)]
    rOptGoals

    -- | Get the program
    getSBVPgm :: (MonadIO m, MonadQuery m) => m SBVPgm
    getSBVPgm :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SBVPgm
    getSBVPgm = do State{IORef SBVPgm
    spgm :: IORef SBVPgm
    spgm :: State -> IORef SBVPgm
    spgm} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                   IO SBVPgm -> m SBVPgm
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO SBVPgm -> m SBVPgm) -> IO SBVPgm -> m SBVPgm
    forall a b. (a -> b) -> a -> b
    $ IORef SBVPgm -> IO SBVPgm
    forall a. IORef a -> IO a
    readIORef IORef SBVPgm
    spgm

    -- | Get the assertions put in via 'Data.SBV.sAssert'
    getSBVAssertions :: (MonadIO m, MonadQuery m) => m [(String, Maybe CallStack, SV)]
    getSBVAssertions :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    m [([Char], Maybe CallStack, SV)]
    getSBVAssertions = do State{IORef [([Char], Maybe CallStack, SV)]
    rAsserts :: IORef [([Char], Maybe CallStack, SV)]
    rAsserts :: State -> IORef [([Char], Maybe CallStack, SV)]
    rAsserts} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                          IO [([Char], Maybe CallStack, SV)]
    -> m [([Char], Maybe CallStack, SV)]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [([Char], Maybe CallStack, SV)]
     -> m [([Char], Maybe CallStack, SV)])
    -> IO [([Char], Maybe CallStack, SV)]
    -> m [([Char], Maybe CallStack, SV)]
    forall a b. (a -> b) -> a -> b
    $ [([Char], Maybe CallStack, SV)] -> [([Char], Maybe CallStack, SV)]
    forall a. [a] -> [a]
    reverse ([([Char], Maybe CallStack, SV)]
     -> [([Char], Maybe CallStack, SV)])
    -> IO [([Char], Maybe CallStack, SV)]
    -> IO [([Char], Maybe CallStack, SV)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [([Char], Maybe CallStack, SV)]
    -> IO [([Char], Maybe CallStack, SV)]
    forall a. IORef a -> IO a
    readIORef IORef [([Char], Maybe CallStack, SV)]
    rAsserts

    -- | Generalization of 'Data.SBV.Control.io'
    io :: MonadIO m => IO a -> m a
    io :: forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO

    -- | Sync-up the external solver with new context we have generated
    syncUpSolver :: (MonadIO m, MonadQuery m) => ProgInfo -> IORef CnstMap -> IncState -> m ()
    syncUpSolver :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    ProgInfo -> IORef CnstMap -> IncState -> m ()
    syncUpSolver ProgInfo
    progInfo IORef CnstMap
    rGlobalConsts IncState
    is = do
            SMTConfig
    cfg <- m SMTConfig
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig

            -- update global consts to have the new ones
            (CnstMap
    newConsts, CnstMap
    allConsts) <- IO (CnstMap, CnstMap) -> m (CnstMap, CnstMap)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (CnstMap, CnstMap) -> m (CnstMap, CnstMap))
    -> IO (CnstMap, CnstMap) -> m (CnstMap, CnstMap)
    forall a b. (a -> b) -> a -> b
    $ do CnstMap
    nc <- IORef CnstMap -> IO CnstMap
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef CnstMap
    rNewConsts IncState
    is)
                                                  CnstMap
    oc <- IORef CnstMap -> IO CnstMap
    forall a. IORef a -> IO a
    readIORef IORef CnstMap
    rGlobalConsts
                                                  let allConsts :: CnstMap
    allConsts = CnstMap -> CnstMap -> CnstMap
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union CnstMap
    nc CnstMap
    oc
                                                  IORef CnstMap -> CnstMap -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef CnstMap
    rGlobalConsts CnstMap
    allConsts
                                                  (CnstMap, CnstMap) -> IO (CnstMap, CnstMap)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CnstMap
    nc, CnstMap
    allConsts)

            [[Char]]
    ls  <- IO [[Char]] -> m [[Char]]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [[Char]] -> m [[Char]]) -> IO [[Char]] -> m [[Char]]
    forall a b. (a -> b) -> a -> b
    $ do let swap :: (b, a) -> (a, b)
    swap  (b
    a, a
    b)        = (a
    b, b
    a)
                               cmp :: (a, b) -> (a, b) -> Ordering
    cmp   (a
    a, b
    _) (a
    b, b
    _) = a
    a a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` a
    b
                               arrange :: (a, (b, c, b)) -> ((a, b, c), b)
    arrange (a
    i, (b
    at, c
    rt, b
    es)) = ((a
    i, b
    at, c
    rt), b
    es)
                           [NamedSymVar]
    inps        <- [NamedSymVar] -> [NamedSymVar]
    forall a. [a] -> [a]
    reverse ([NamedSymVar] -> [NamedSymVar])
    -> IO [NamedSymVar] -> IO [NamedSymVar]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [NamedSymVar] -> IO [NamedSymVar]
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef [NamedSymVar]
    rNewInps IncState
    is)
                           KindSet
    ks          <- IORef KindSet -> IO KindSet
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef KindSet
    rNewKinds IncState
    is)
                           [(Int, ArrayInfo)]
    arrs        <- IntMap ArrayInfo -> [(Int, ArrayInfo)]
    forall a. IntMap a -> [(Int, a)]
    IMap.toAscList (IntMap ArrayInfo -> [(Int, ArrayInfo)])
    -> IO (IntMap ArrayInfo) -> IO [(Int, ArrayInfo)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (IntMap ArrayInfo) -> IO (IntMap ArrayInfo)
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef (IntMap ArrayInfo)
    rNewArrs IncState
    is)
                           [((Int, Kind, Kind), [SV])]
    tbls        <- ((Int, (Kind, Kind, [SV])) -> ((Int, Kind, Kind), [SV]))
    -> [(Int, (Kind, Kind, [SV]))] -> [((Int, Kind, Kind), [SV])]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, (Kind, Kind, [SV])) -> ((Int, Kind, Kind), [SV])
    forall {a} {b} {c} {b}. (a, (b, c, b)) -> ((a, b, c), b)
    arrange ([(Int, (Kind, Kind, [SV]))] -> [((Int, Kind, Kind), [SV])])
    -> (Map (Kind, Kind, [SV]) Int -> [(Int, (Kind, Kind, [SV]))])
    -> Map (Kind, Kind, [SV]) Int
    -> [((Int, Kind, Kind), [SV])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, (Kind, Kind, [SV]))
     -> (Int, (Kind, Kind, [SV])) -> Ordering)
    -> [(Int, (Kind, Kind, [SV]))] -> [(Int, (Kind, Kind, [SV]))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Int, (Kind, Kind, [SV])) -> (Int, (Kind, Kind, [SV])) -> Ordering
    forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
    cmp ([(Int, (Kind, Kind, [SV]))] -> [(Int, (Kind, Kind, [SV]))])
    -> (Map (Kind, Kind, [SV]) Int -> [(Int, (Kind, Kind, [SV]))])
    -> Map (Kind, Kind, [SV]) Int
    -> [(Int, (Kind, Kind, [SV]))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((Kind, Kind, [SV]), Int) -> (Int, (Kind, Kind, [SV])))
    -> [((Kind, Kind, [SV]), Int)] -> [(Int, (Kind, Kind, [SV]))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Kind, Kind, [SV]), Int) -> (Int, (Kind, Kind, [SV]))
    forall {b} {a}. (b, a) -> (a, b)
    swap ([((Kind, Kind, [SV]), Int)] -> [(Int, (Kind, Kind, [SV]))])
    -> (Map (Kind, Kind, [SV]) Int -> [((Kind, Kind, [SV]), Int)])
    -> Map (Kind, Kind, [SV]) Int
    -> [(Int, (Kind, Kind, [SV]))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map (Kind, Kind, [SV]) Int -> [((Kind, Kind, [SV]), Int)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map (Kind, Kind, [SV]) Int -> [((Int, Kind, Kind), [SV])])
    -> IO (Map (Kind, Kind, [SV]) Int)
    -> IO [((Int, Kind, Kind), [SV])]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Map (Kind, Kind, [SV]) Int)
    -> IO (Map (Kind, Kind, [SV]) Int)
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef (Map (Kind, Kind, [SV]) Int)
    rNewTbls IncState
    is)
                           [([Char], (Maybe [[Char]], SBVType))]
    uis         <- Map [Char] (Maybe [[Char]], SBVType)
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall k a. Map k a -> [(k, a)]
    Map.toAscList (Map [Char] (Maybe [[Char]], SBVType)
     -> [([Char], (Maybe [[Char]], SBVType))])
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    -> IO [([Char], (Maybe [[Char]], SBVType))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Map [Char] (Maybe [[Char]], SBVType))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef (Map [Char] (Maybe [[Char]], SBVType))
    rNewUIs IncState
    is)
                           SBVPgm
    as          <- IORef SBVPgm -> IO SBVPgm
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef SBVPgm
    rNewAsgns IncState
    is)
                           Seq (Bool, [([Char], [Char])], SV)
    constraints <- IORef (Seq (Bool, [([Char], [Char])], SV))
    -> IO (Seq (Bool, [([Char], [Char])], SV))
    forall a. IORef a -> IO a
    readIORef (IncState -> IORef (Seq (Bool, [([Char], [Char])], SV))
    rNewConstraints IncState
    is)

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

                           [[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
    forall a b. (a -> b) -> a -> b
    $ SMTConfig -> SMTLibIncConverter [[Char]]
    toIncSMTLib SMTConfig
    cfg ProgInfo
    progInfo [NamedSymVar]
    inps KindSet
    ks (CnstMap
    allConsts, [(SV, CV)]
    cnsts) [(Int, ArrayInfo)]
    arrs [((Int, Kind, Kind), [SV])]
    tbls [([Char], (Maybe [[Char]], SBVType))]
    uis SBVPgm
    as Seq (Bool, [([Char], [Char])], SV)
    constraints SMTConfig
    cfg
            ([Char] -> m ()) -> [[Char]] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True) ([[Char]] -> m ()) -> [[Char]] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [[Char]]
    mergeSExpr [[Char]]
    ls

    -- | Retrieve the query context
    getQueryState :: (MonadIO m, MonadQuery m) => m QueryState
    getQueryState :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState = do State
    state <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                       Maybe QueryState
    mbQS  <- IO (Maybe QueryState) -> m (Maybe QueryState)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe QueryState) -> m (Maybe QueryState))
    -> IO (Maybe QueryState) -> m (Maybe QueryState)
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe QueryState) -> IO (Maybe QueryState)
    forall a. IORef a -> IO a
    readIORef (State -> IORef (Maybe QueryState)
    rQueryState State
    state)
                       case Maybe QueryState
    mbQS of
                         Maybe QueryState
    Nothing -> [Char] -> m QueryState
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m QueryState) -> [Char] -> m QueryState
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                                    , [Char]
    "*** Data.SBV: Impossible happened: Query context required in a non-query mode."
                                                    , [Char]
    "Please report this as a bug!"
                                                    ]
                         Just QueryState
    qs -> QueryState -> m QueryState
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QueryState
    qs

    -- | Generalization of 'Data.SBV.Control.modifyQueryState'
    modifyQueryState :: (MonadIO m, MonadQuery m) => (QueryState -> QueryState) -> m ()
    modifyQueryState :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    (QueryState -> QueryState) -> m ()
    modifyQueryState QueryState -> QueryState
    f = do State
    state <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                            Maybe QueryState
    mbQS  <- IO (Maybe QueryState) -> m (Maybe QueryState)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe QueryState) -> m (Maybe QueryState))
    -> IO (Maybe QueryState) -> m (Maybe QueryState)
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe QueryState) -> IO (Maybe QueryState)
    forall a. IORef a -> IO a
    readIORef (State -> IORef (Maybe QueryState)
    rQueryState State
    state)
                            case Maybe QueryState
    mbQS of
                              Maybe QueryState
    Nothing -> [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                                         , [Char]
    "*** Data.SBV: Impossible happened: Query context required in a non-query mode."
                                                         , [Char]
    "Please report this as a bug!"
                                                         ]
                              Just QueryState
    qs -> let fqs :: QueryState
    fqs = QueryState -> QueryState
    f QueryState
    qs
                                         in QueryState
    fqs QueryState -> m () -> m ()
    forall a b. a -> b -> b
    `seq` IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe QueryState) -> Maybe QueryState -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (State -> IORef (Maybe QueryState)
    rQueryState State
    state) (Maybe QueryState -> IO ()) -> Maybe QueryState -> IO ()
    forall a b. (a -> b) -> a -> b
    $ QueryState -> Maybe QueryState
    forall a. a -> Maybe a
    Just QueryState
    fqs

    -- | Generalization of 'Data.SBV.Control.inNewContext'
    inNewContext :: (MonadIO m, MonadQuery m) => (State -> IO a) -> m a
    inNewContext :: forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext State -> IO a
    act = do st :: State
    st@State{IORef CnstMap
    rconstMap :: IORef CnstMap
    rconstMap :: State -> IORef CnstMap
    rconstMap, IORef ProgInfo
    rProgInfo :: IORef ProgInfo
    rProgInfo :: State -> IORef ProgInfo
    rProgInfo} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                          (IncState
    is, a
    r)  <- IO (IncState, a) -> m (IncState, a)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (IncState, a) -> m (IncState, a))
    -> IO (IncState, a) -> m (IncState, a)
    forall a b. (a -> b) -> a -> b
    $ State -> (State -> IO a) -> IO (IncState, a)
    forall a. State -> (State -> IO a) -> IO (IncState, a)
    withNewIncState State
    st State -> IO a
    act
                          ProgInfo
    progInfo <- IO ProgInfo -> m ProgInfo
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO ProgInfo -> m ProgInfo) -> IO ProgInfo -> m ProgInfo
    forall a b. (a -> b) -> a -> b
    $ IORef ProgInfo -> IO ProgInfo
    forall a. IORef a -> IO a
    readIORef IORef ProgInfo
    rProgInfo
                          ProgInfo -> IORef CnstMap -> IncState -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    ProgInfo -> IORef CnstMap -> IncState -> m ()
    syncUpSolver ProgInfo
    progInfo IORef CnstMap
    rconstMap IncState
    is
                          a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r

    -- | Generic 'Queriable' instance for 'SymVal' values
    instance (MonadIO m, SymVal a) => Queriable m (SBV a) where
      type QueryResult (SBV a) = a
      create :: QueryT m (SBV a)
    create  = QueryT m (SBV a)
    forall a (m :: * -> *).
    (MonadIO m, MonadQuery m, SymVal a) =>
    m (SBV a)
    freshVar_
      project :: SBV a -> QueryT m (QueryResult (SBV a))
    project = SBV a -> QueryT m a
    SBV a -> QueryT m (QueryResult (SBV a))
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m, SymVal a) =>
    SBV a -> m a
    getValue
      embed :: QueryResult (SBV a) -> QueryT m (SBV a)
    embed   = SBV a -> QueryT m (SBV a)
    forall a. a -> QueryT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SBV a -> QueryT m (SBV a))
    -> (a -> SBV a) -> a -> QueryT m (SBV a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> SBV a
    forall a. SymVal a => a -> SBV a
    literal

    -- | Generic 'Queriable' instance for things that are 'Fresh' and look like containers:
    instance (MonadIO m, SymVal a, Foldable t, Traversable t, Fresh m (t (SBV a))) => Queriable m (t (SBV a)) where
      type QueryResult (t (SBV a)) = t a
      create :: QueryT m (t (SBV a))
    create  = QueryT m (t (SBV a))
    forall (m :: * -> *) a. Fresh m a => QueryT m a
    fresh
      project :: t (SBV a) -> QueryT m (QueryResult (t (SBV a)))
    project = (SBV a -> QueryT m a) -> t (SBV a) -> QueryT m (t a)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
    mapM SBV a -> QueryT m a
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m, SymVal a) =>
    SBV a -> m a
    getValue
      embed :: QueryResult (t (SBV a)) -> QueryT m (t (SBV a))
    embed   = t (SBV a) -> QueryT m (t (SBV a))
    forall a. a -> QueryT m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (t (SBV a) -> QueryT m (t (SBV a)))
    -> (t a -> t (SBV a)) -> t a -> QueryT m (t (SBV a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> SBV a) -> t a -> t (SBV a)
    forall a b. (a -> b) -> t a -> t b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> SBV a
    forall a. SymVal a => a -> SBV a
    literal

    -- | Generalization of 'Data.SBV.Control.freshVar_'
    freshVar_ :: forall a m. (MonadIO m, MonadQuery m, SymVal a) => m (SBV a)
    freshVar_ :: forall a (m :: * -> *).
    (MonadIO m, MonadQuery m, SymVal a) =>
    m (SBV a)
    freshVar_ = (State -> IO (SBV a)) -> m (SBV a)
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext ((State -> IO (SBV a)) -> m (SBV a))
    -> (State -> IO (SBV a)) -> m (SBV a)
    forall a b. (a -> b) -> a -> b
    $ (SVal -> SBV a) -> IO SVal -> IO (SBV a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SVal -> SBV a
    forall a. SVal -> SBV a
    SBV (IO SVal -> IO (SBV a))
    -> (State -> IO SVal) -> State -> IO (SBV a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
    svMkSymVar VarContext
    QueryVar Kind
    k Maybe [Char]
    forall a. Maybe a
    Nothing
      where k :: Kind
    k = Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)

    -- | Generalization of 'Data.SBV.Control.freshVar'
    freshVar :: forall a m. (MonadIO m, MonadQuery m, SymVal a) => String -> m (SBV a)
    freshVar :: forall a (m :: * -> *).
    (MonadIO m, MonadQuery m, SymVal a) =>
    [Char] -> m (SBV a)
    freshVar [Char]
    nm = (State -> IO (SBV a)) -> m (SBV a)
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext ((State -> IO (SBV a)) -> m (SBV a))
    -> (State -> IO (SBV a)) -> m (SBV a)
    forall a b. (a -> b) -> a -> b
    $ (SVal -> SBV a) -> IO SVal -> IO (SBV a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SVal -> SBV a
    forall a. SVal -> SBV a
    SBV (IO SVal -> IO (SBV a))
    -> (State -> IO SVal) -> State -> IO (SBV a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarContext -> Kind -> Maybe [Char] -> State -> IO SVal
    svMkSymVar VarContext
    QueryVar Kind
    k ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    nm)
      where k :: Kind
    k = Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)

    -- | Generalization of 'Data.SBV.Control.freshArray_'
    freshArray_ :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) => Maybe (SBV b) -> m (array a b)
    freshArray_ :: forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) =>
    Maybe (SBV b) -> m (array a b)
    freshArray_ = Maybe [Char] -> Maybe (SBV b) -> m (array a b)
    forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) =>
    Maybe [Char] -> Maybe (SBV b) -> m (array a b)
    mkFreshArray Maybe [Char]
    forall a. Maybe a
    Nothing

    -- | Generalization of 'Data.SBV.Control.freshArray'
    freshArray :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) => String -> Maybe (SBV b) -> m (array a b)
    freshArray :: forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) =>
    [Char] -> Maybe (SBV b) -> m (array a b)
    freshArray [Char]
    nm = Maybe [Char] -> Maybe (SBV b) -> m (array a b)
    forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) =>
    Maybe [Char] -> Maybe (SBV b) -> m (array a b)
    mkFreshArray ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    nm)

    -- | Creating arrays, internal use only.
    mkFreshArray :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) => Maybe String -> Maybe (SBV b) -> m (array a b)
    mkFreshArray :: forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) =>
    Maybe [Char] -> Maybe (SBV b) -> m (array a b)
    mkFreshArray Maybe [Char]
    mbNm Maybe (SBV b)
    mbVal = (State -> IO (array a b)) -> m (array a b)
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext ((State -> IO (array a b)) -> m (array a b))
    -> (State -> IO (array a b)) -> m (array a b)
    forall a b. (a -> b) -> a -> b
    $ Maybe [Char]
    -> Either (Maybe (SBV b)) [Char] -> State -> IO (array a b)
    forall a b.
    (HasKind a, HasKind b) =>
    Maybe [Char]
    -> Either (Maybe (SBV b)) [Char] -> State -> IO (array a b)
    forall (array :: * -> * -> *) a b.
    (SymArray array, HasKind a, HasKind b) =>
    Maybe [Char]
    -> Either (Maybe (SBV b)) [Char] -> State -> IO (array a b)
    newArrayInState Maybe [Char]
    mbNm (Maybe (SBV b) -> Either (Maybe (SBV b)) [Char]
    forall a b. a -> Either a b
    Left Maybe (SBV b)
    mbVal)

    -- | Generalization of 'Data.SBV.Control.freshLambdaArray_'
    freshLambdaArray_ :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b, Lambda (SymbolicT IO) (a -> b)) => (a -> b) -> m (array a b)
    freshLambdaArray_ :: forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b,
     Lambda (SymbolicT IO) (a -> b)) =>
    (a -> b) -> m (array a b)
    freshLambdaArray_ = Maybe [Char] -> (a -> b) -> m (array a b)
    forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b,
     Lambda (SymbolicT IO) (a -> b)) =>
    Maybe [Char] -> (a -> b) -> m (array a b)
    mkFreshLambdaArray Maybe [Char]
    forall a. Maybe a
    Nothing

    -- | Generalization of 'Data.SBV.Control.freshLambdaArray'
    freshLambdaArray :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b, Lambda (SymbolicT IO) (a -> b)) => String -> (a -> b) -> m (array a b)
    freshLambdaArray :: forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b,
     Lambda (SymbolicT IO) (a -> b)) =>
    [Char] -> (a -> b) -> m (array a b)
    freshLambdaArray [Char]
    nm = Maybe [Char] -> (a -> b) -> m (array a b)
    forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b,
     Lambda (SymbolicT IO) (a -> b)) =>
    Maybe [Char] -> (a -> b) -> m (array a b)
    mkFreshLambdaArray ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    nm)

    -- | Creating arrays, internal use only.
    mkFreshLambdaArray :: forall m array a b. (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b, Lambda (SymbolicT IO) (a -> b)) => Maybe String -> (a -> b) -> m (array a b)
    mkFreshLambdaArray :: forall (m :: * -> *) (array :: * -> * -> *) a b.
    (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b,
     Lambda (SymbolicT IO) (a -> b)) =>
    Maybe [Char] -> (a -> b) -> m (array a b)
    mkFreshLambdaArray Maybe [Char]
    mbNm a -> b
    f = (State -> IO (array a b)) -> m (array a b)
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext ((State -> IO (array a b)) -> m (array a b))
    -> (State -> IO (array a b)) -> m (array a b)
    forall a b. (a -> b) -> a -> b
    $ \State
    st -> do
                                    [Char]
    lam <- State -> Kind -> (a -> b) -> IO [Char]
    forall (m :: * -> *) a.
    (MonadIO m, Lambda (SymbolicT m) a) =>
    State -> Kind -> a -> m [Char]
    lambdaStr State
    st (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)) a -> b
    f
                                    Maybe [Char]
    -> Either (Maybe (SBV b)) [Char] -> State -> IO (array a b)
    forall a b.
    (HasKind a, HasKind b) =>
    Maybe [Char]
    -> Either (Maybe (SBV b)) [Char] -> State -> IO (array a b)
    forall (array :: * -> * -> *) a b.
    (SymArray array, HasKind a, HasKind b) =>
    Maybe [Char]
    -> Either (Maybe (SBV b)) [Char] -> State -> IO (array a b)
    newArrayInState Maybe [Char]
    mbNm ([Char] -> Either (Maybe (SBV b)) [Char]
    forall a b. b -> Either a b
    Right [Char]
    lam) State
    st

    -- | Generalization of 'Data.SBV.Control.queryDebug'
    queryDebug :: (MonadIO m, MonadQuery m) => [String] -> m ()
    queryDebug :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]]
    msgs = do QueryState{SMTConfig
    queryConfig :: QueryState -> SMTConfig
    queryConfig :: SMTConfig
    queryConfig} <- m QueryState
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState
                         IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ SMTConfig -> [[Char]] -> IO ()
    forall (m :: * -> *). MonadIO m => SMTConfig -> [[Char]] -> m ()
    debug SMTConfig
    queryConfig [[Char]]
    msgs

    -- | Generalization of 'Data.SBV.Control.ask'
    ask :: (MonadIO m, MonadQuery m) => String -> m String
    ask :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    s = do QueryState{Maybe Int -> [Char] -> IO [Char]
    queryAsk :: Maybe Int -> [Char] -> IO [Char]
    queryAsk :: QueryState -> Maybe Int -> [Char] -> IO [Char]
    queryAsk, Maybe Int
    queryTimeOutValue :: Maybe Int
    queryTimeOutValue :: QueryState -> Maybe Int
    queryTimeOutValue} <- m QueryState
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState

               case Maybe Int
    queryTimeOutValue of
                 Maybe Int
    Nothing -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[SEND] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
                 Just Int
    i  -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[SEND, TimeOut: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    showTimeoutValue Int
    i [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
               [Char]
    r <- IO [Char] -> m [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> [Char] -> IO [Char]
    queryAsk Maybe Int
    queryTimeOutValue [Char]
    s
               [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[RECV] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    r]

               [Char] -> m [Char]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    r

    -- | Send a string to the solver, and return the response. Except, if the response
    -- is one of the "ignore" ones, keep querying.
    askIgnoring :: (MonadIO m, MonadQuery m) => String -> [String] -> m String
    askIgnoring :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> [[Char]] -> m [Char]
    askIgnoring [Char]
    s [[Char]]
    ignoreList = do

               QueryState{Maybe Int -> [Char] -> IO [Char]
    queryAsk :: QueryState -> Maybe Int -> [Char] -> IO [Char]
    queryAsk :: Maybe Int -> [Char] -> IO [Char]
    queryAsk, Maybe Int -> IO [Char]
    queryRetrieveResponse :: Maybe Int -> IO [Char]
    queryRetrieveResponse :: QueryState -> Maybe Int -> IO [Char]
    queryRetrieveResponse, Maybe Int
    queryTimeOutValue :: QueryState -> Maybe Int
    queryTimeOutValue :: Maybe Int
    queryTimeOutValue} <- m QueryState
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState

               case Maybe Int
    queryTimeOutValue of
                 Maybe Int
    Nothing -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[SEND] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
                 Just Int
    i  -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[SEND, TimeOut: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    showTimeoutValue Int
    i [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
               [Char]
    r <- IO [Char] -> m [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> [Char] -> IO [Char]
    queryAsk Maybe Int
    queryTimeOutValue [Char]
    s
               [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[RECV] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    r]

               let loop :: [Char] -> m [Char]
    loop [Char]
    currentResponse
                     | [Char]
    currentResponse [Char] -> [[Char]] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [[Char]]
    ignoreList
                     = [Char] -> m [Char]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    currentResponse
                     | Bool
    True
                     = do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[WARN] Previous response is explicitly ignored, beware!"]
                          [Char]
    newResponse <- IO [Char] -> m [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> IO [Char]
    queryRetrieveResponse Maybe Int
    queryTimeOutValue
                          [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[RECV] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    newResponse]
                          [Char] -> m [Char]
    loop [Char]
    newResponse

               [Char] -> m [Char]
    loop [Char]
    r

    -- | Generalization of 'Data.SBV.Control.send'
    send :: (MonadIO m, MonadQuery m) => Bool -> String -> m ()
    send :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    requireSuccess [Char]
    s = do

                QueryState{Maybe Int -> [Char] -> IO [Char]
    queryAsk :: QueryState -> Maybe Int -> [Char] -> IO [Char]
    queryAsk :: Maybe Int -> [Char] -> IO [Char]
    queryAsk, Maybe Int -> [Char] -> IO ()
    querySend :: Maybe Int -> [Char] -> IO ()
    querySend :: QueryState -> Maybe Int -> [Char] -> IO ()
    querySend, SMTConfig
    queryConfig :: QueryState -> SMTConfig
    queryConfig :: SMTConfig
    queryConfig, Maybe Int
    queryTimeOutValue :: QueryState -> Maybe Int
    queryTimeOutValue :: Maybe Int
    queryTimeOutValue} <- m QueryState
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState

                if Bool
    requireSuccess Bool -> Bool -> Bool
    && SolverCapabilities -> Bool
    supportsCustomQueries (SMTSolver -> SolverCapabilities
    capabilities (SMTConfig -> SMTSolver
    solver SMTConfig
    queryConfig))
                   then do [Char]
    r <- IO [Char] -> m [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> [Char] -> IO [Char]
    queryAsk Maybe Int
    queryTimeOutValue [Char]
    s

                           case [Char] -> [[Char]]
    words [Char]
    r of
                             [[Char]
    "success"] -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[GOOD] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
                             [[Char]]
    _           -> do case Maybe Int
    queryTimeOutValue of
                                                 Maybe Int
    Nothing -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[FAIL] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
                                                 Just Int
    i  -> [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [([Char]
    "[FAIL, TimeOut: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    showTimeoutValue Int
    i [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]  ") [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]

                                               let cmd :: [Char]
    cmd = case [Char] -> [[Char]]
    words ((Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\Char
    c -> Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isPunctuation Char
    c) [Char]
    s) of
                                                           ([Char]
    c:[[Char]]
    _) -> [Char]
    c
                                                           [[Char]]
    _     -> [Char]
    "Command"

                                               [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m ()
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    cmd [Char]
    s [Char]
    "success" Maybe [[Char]]
    forall a. Maybe a
    Nothing [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

                   else do -- fire and forget. if you use this, you're on your own!
                           [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[FIRE] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
                           IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> [Char] -> IO ()
    querySend Maybe Int
    queryTimeOutValue [Char]
    s

    -- | Generalization of 'Data.SBV.Control.retrieveResponse'
    retrieveResponse :: (MonadIO m, MonadQuery m) => String -> Maybe Int -> m [String]
    retrieveResponse :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> Maybe Int -> m [[Char]]
    retrieveResponse [Char]
    userTag Maybe Int
    mbTo = do
                 [Char]
    ts  <- IO [Char] -> m [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (ZonedTime -> [Char]
    forall a. Show a => a -> [Char]
    show (ZonedTime -> [Char]) -> IO ZonedTime -> IO [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO ZonedTime
    getZonedTime)

                 let synchTag :: [Char]
    synchTag = [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    userTag [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " (at: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ts [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                     cmd :: [Char]
    cmd = [Char]
    "(echo " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    synchTag [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"

                 [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[SYNC] Attempting to synchronize with tag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    synchTag]

                 Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    False [Char]
    cmd

                 QueryState{Maybe Int -> IO [Char]
    queryRetrieveResponse :: QueryState -> Maybe Int -> IO [Char]
    queryRetrieveResponse :: Maybe Int -> IO [Char]
    queryRetrieveResponse} <- m QueryState
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m QueryState
    getQueryState

                 let loop :: [[Char]] -> m [[Char]]
    loop [[Char]]
    sofar = do
                      [Char]
    s <- IO [Char] -> m [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> IO [Char]
    queryRetrieveResponse Maybe Int
    mbTo

                      -- strictly speaking SMTLib requires solvers to print quotes around
                      -- echo'ed strings, but they don't always do. Accommodate for that
                      -- here, though I wish we didn't have to.
                      if [Char]
    s [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    synchTag Bool -> Bool -> Bool
    || [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    s [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    synchTag
                         then do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[SYNC] Synchronization achieved using tag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    synchTag]
                                 [[Char]] -> m [[Char]]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse [[Char]]
    sofar
                         else do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "[RECV] " [Char] -> [Char] -> [Char]
    `alignPlain` [Char]
    s]
                                 [[Char]] -> m [[Char]]
    loop ([Char]
    s [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    sofar)

                 [[Char]] -> m [[Char]]
    loop []

    -- | Generalization of 'Data.SBV.Control.getValue'
    getValue :: (MonadIO m, MonadQuery m, SymVal a) => SBV a -> m a
    getValue :: forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m, SymVal a) =>
    SBV a -> m a
    getValue SBV a
    s = do SV
    sv <- (State -> IO SV) -> m SV
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext (State -> SBV a -> IO SV
    forall a. State -> SBV a -> IO SV
    `sbvToSV` SBV a
    s)
                    CV
    cv <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    forall a. Maybe a
    Nothing SV
    sv
                    a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> m a) -> a -> m a
    forall a b. (a -> b) -> a -> b
    $ CV -> a
    forall a. SymVal a => CV -> a
    fromCV CV
    cv

    -- | A class which allows for sexpr-conversion to functions
    class (HasKind r, SatModel r) => SMTFunction fun a r | fun -> a r where
      sexprToArg     :: fun -> [SExpr] -> Maybe a
      smtFunName     :: (MonadIO m, SolverContext m, MonadSymbolic m) => fun -> m (String, Maybe [String])
      smtFunSaturate :: fun -> SBV r
      smtFunType     :: fun -> SBVType
      smtFunDefault  :: fun -> Maybe r
      sexprToFun     :: (MonadIO m, SolverContext m, MonadQuery m, MonadSymbolic m, SymVal r) => fun -> (String, SExpr) -> m (Either String ([(a, r)], r))

      {-# MINIMAL sexprToArg, smtFunSaturate, smtFunType  #-}

      -- Given the function, figure out a default "return value"
      smtFunDefault fun
    _
        | let v :: CV
    v = Kind -> CV
    defaultKindedValue (Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)), Just (r
    res, []) <- [CV] -> Maybe (r, [CV])
    forall a. SatModel a => [CV] -> Maybe (a, [CV])
    parseCVs [CV
    v]
        = r -> Maybe r
    forall a. a -> Maybe a
    Just r
    res
        | Bool
    True
        = Maybe r
    forall a. Maybe a
    Nothing

      -- Given the function, determine what its name is and do some sanity checks
      smtFunName fun
    f = do st :: State
    st@State{IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap :: IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap :: State -> IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap} <- m State
    forall (m :: * -> *). SolverContext m => m State
    contextState
                        Map [Char] (Maybe [[Char]], SBVType)
    uiMap <- IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Map [Char] (Maybe [[Char]], SBVType))
     -> m (Map [Char] (Maybe [[Char]], SBVType)))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall a b. (a -> b) -> a -> b
    $ IORef (Map [Char] (Maybe [[Char]], SBVType))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IORef a -> IO a
    readIORef IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap
                        [Char]
    nm    <- State -> Map [Char] (Maybe [[Char]], SBVType) -> m [Char]
    findName State
    st Map [Char] (Maybe [[Char]], SBVType)
    uiMap

                        -- Read the uiMap again here. Why? Because the act of finding the name might've
                        -- introduced it as an uninterperted name!
                        Map [Char] (Maybe [[Char]], SBVType)
    newUIMap <- IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Map [Char] (Maybe [[Char]], SBVType))
     -> m (Map [Char] (Maybe [[Char]], SBVType)))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall a b. (a -> b) -> a -> b
    $ IORef (Map [Char] (Maybe [[Char]], SBVType))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IORef a -> IO a
    readIORef IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap
                        case [Char]
    nm [Char]
    -> Map [Char] (Maybe [[Char]], SBVType)
    -> Maybe (Maybe [[Char]], SBVType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map [Char] (Maybe [[Char]], SBVType)
    newUIMap of
                          Maybe (Maybe [[Char]], SBVType)
    Nothing          -> Map [Char] (Maybe [[Char]], SBVType) -> m ([Char], Maybe [[Char]])
    forall {b} {a}. Map [Char] b -> a
    cantFind Map [Char] (Maybe [[Char]], SBVType)
    newUIMap
                          Just (Maybe [[Char]]
    mbArgs, SBVType
    _) -> ([Char], Maybe [[Char]]) -> m ([Char], Maybe [[Char]])
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Char]
    nm, Maybe [[Char]]
    mbArgs)
        where cantFind :: Map [Char] b -> a
    cantFind Map [Char] b
    uiMap = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $    [ [Char]
    ""
                                                    , [Char]
    "*** Data.SBV.getFunction: Must be called on an uninterpreted function!"
                                                    , [Char]
    "***"
                                                    , [Char]
    "***    Expected to receive a function created by \"uninterpret\""
                                                    ]
                                                 [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]]
    tag
                                                 [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [ [Char]
    "***"
                                                    , [Char]
    "*** Make sure to call getFunction on uninterpreted functions only!"
                                                    , [Char]
    "*** If that is already the case, please report this as a bug."
                                                    ]
                 where tag :: [[Char]]
    tag = case (([Char], b) -> [Char]) -> [([Char], b)] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char], b) -> [Char]
    forall a b. (a, b) -> a
    fst (Map [Char] b -> [([Char], b)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map [Char] b
    uiMap) of
                                   []    -> [ [Char]
    "***    But, there are no matching uninterpreted functions in the context." ]
                                   [[Char]
    x]   -> [ [Char]
    "***    The only possible candidate is: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    x ]
                                   [[Char]]
    cands -> [ [Char]
    "***    Candidates are:"
                                            , [Char]
    "***        " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " [[Char]]
    cands
                                            ]

              findName :: State -> Map [Char] (Maybe [[Char]], SBVType) -> m [Char]
    findName st :: State
    st@State{IORef SBVPgm
    spgm :: State -> IORef SBVPgm
    spgm :: IORef SBVPgm
    spgm} Map [Char] (Maybe [[Char]], SBVType)
    uiMap = do
                 SV
    r <- IO SV -> m SV
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO SV -> m SV) -> IO SV -> m SV
    forall a b. (a -> b) -> a -> b
    $ State -> SBV r -> IO SV
    forall a. State -> SBV a -> IO SV
    sbvToSV State
    st (fun -> SBV r
    forall fun a r. SMTFunction fun a r => fun -> SBV r
    smtFunSaturate fun
    f)
                 IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ SV -> IO ()
    forceSVArg SV
    r
                 SBVPgm Seq (SV, SBVExpr)
    asgns <- IO SBVPgm -> m SBVPgm
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO SBVPgm -> m SBVPgm) -> IO SBVPgm -> m SBVPgm
    forall a b. (a -> b) -> a -> b
    $ IORef SBVPgm -> IO SBVPgm
    forall a. IORef a -> IO a
    readIORef IORef SBVPgm
    spgm

                 case ((SV, SBVExpr) -> Bool) -> Seq (SV, SBVExpr) -> Maybe Int
    forall a. (a -> Bool) -> Seq a -> Maybe Int
    S.findIndexR ((SV -> SV -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV
    r) (SV -> Bool) -> ((SV, SBVExpr) -> SV) -> (SV, SBVExpr) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SV, SBVExpr) -> SV
    forall a b. (a, b) -> a
    fst) Seq (SV, SBVExpr)
    asgns of
                   Maybe Int
    Nothing -> Map [Char] (Maybe [[Char]], SBVType) -> m [Char]
    forall {b} {a}. Map [Char] b -> a
    cantFind Map [Char] (Maybe [[Char]], SBVType)
    uiMap
                   Just Int
    i  -> case Seq (SV, SBVExpr)
    asgns Seq (SV, SBVExpr) -> Int -> (SV, SBVExpr)
    forall a. Seq a -> Int -> a
    `S.index` Int
    i of
                                (SV
    sv, SBVApp (Uninterpreted [Char]
    nm) [SV]
    _) | SV
    r SV -> SV -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV
    sv -> [Char] -> m [Char]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    nm
                                (SV, SBVExpr)
    _                                           -> Map [Char] (Maybe [[Char]], SBVType) -> m [Char]
    forall {b} {a}. Map [Char] b -> a
    cantFind Map [Char] (Maybe [[Char]], SBVType)
    uiMap

      sexprToFun fun
    f ([Char]
    s, SExpr
    e) = do [Char]
    nm <- ([Char], Maybe [[Char]]) -> [Char]
    forall a b. (a, b) -> a
    fst (([Char], Maybe [[Char]]) -> [Char])
    -> m ([Char], Maybe [[Char]]) -> m [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> fun -> m ([Char], Maybe [[Char]])
    forall fun a r (m :: * -> *).
    (SMTFunction fun a r, MonadIO m, SolverContext m,
     MonadSymbolic m) =>
    fun -> m ([Char], Maybe [[Char]])
    forall (m :: * -> *).
    (MonadIO m, SolverContext m, MonadSymbolic m) =>
    fun -> m ([Char], Maybe [[Char]])
    smtFunName fun
    f
                               Maybe ([(a, r)], r)
    mbRes <- case SExpr -> Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    parseSExprFunction SExpr
    e of
                                          Just (Left [Char]
    nm') -> case ([Char]
    nm [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    nm', fun -> Maybe r
    forall fun a r. SMTFunction fun a r => fun -> Maybe r
    smtFunDefault fun
    f) of
                                                               (Bool
    True, Just r
    v)  -> Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r)))
    -> Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ ([(a, r)], r) -> Maybe ([(a, r)], r)
    forall a. a -> Maybe a
    Just ([], r
    v)
                                                               (Bool, Maybe r)
    _               -> [Char] -> m (Maybe ([(a, r)], r))
    forall {a} {a}. Show a => a -> a
    bailOut [Char]
    nm
                                          Just (Right ([([SExpr], SExpr)], SExpr)
    v)  -> Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r)))
    -> Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ ([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r)
    convert ([([SExpr], SExpr)], SExpr)
    v
                                          Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    Nothing         -> do Maybe ([([SExpr], SExpr)], SExpr)
    mbPVS <- [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    pointWiseExtract [Char]
    nm (fun -> SBVType
    forall fun a r. SMTFunction fun a r => fun -> SBVType
    smtFunType fun
    f)
                                                                Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r)))
    -> Maybe ([(a, r)], r) -> m (Maybe ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ Maybe ([([SExpr], SExpr)], SExpr)
    mbPVS Maybe ([([SExpr], SExpr)], SExpr)
    -> (([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r))
    -> Maybe ([(a, r)], r)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r)
    convert
                               Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r)))
    -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ Either [Char] ([(a, r)], r)
    -> (([(a, r)], r) -> Either [Char] ([(a, r)], r))
    -> Maybe ([(a, r)], r)
    -> Either [Char] ([(a, r)], r)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> Either [Char] ([(a, r)], r)
    forall a b. a -> Either a b
    Left [Char]
    s) ([(a, r)], r) -> Either [Char] ([(a, r)], r)
    forall a b. b -> Either a b
    Right Maybe ([(a, r)], r)
    mbRes
        where convert :: ([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r)
    convert    ([([SExpr], SExpr)]
    vs, SExpr
    d) = (,) ([(a, r)] -> r -> ([(a, r)], r))
    -> Maybe [(a, r)] -> Maybe (r -> ([(a, r)], r))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([SExpr], SExpr) -> Maybe (a, r))
    -> [([SExpr], SExpr)] -> Maybe [(a, r)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([SExpr], SExpr) -> Maybe (a, r)
    sexprPoint [([SExpr], SExpr)]
    vs Maybe (r -> ([(a, r)], r)) -> Maybe r -> Maybe ([(a, r)], r)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe r
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    d
              sexprPoint :: ([SExpr], SExpr) -> Maybe (a, r)
    sexprPoint ([SExpr]
    as, SExpr
    v) = (,) (a -> r -> (a, r)) -> Maybe a -> Maybe (r -> (a, r))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> fun -> [SExpr] -> Maybe a
    forall fun a r. SMTFunction fun a r => fun -> [SExpr] -> Maybe a
    sexprToArg fun
    f [SExpr]
    as    Maybe (r -> (a, r)) -> Maybe r -> Maybe (a, r)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe r
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    v

              bailOut :: a -> a
    bailOut a
    nm = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                           , [Char]
    "*** Data.SBV.getFunction: Unable to extract an interpretation for function " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    nm
                                           , [Char]
    "***"
                                           , [Char]
    "*** Failed while trying to extract a pointwise interpretation."
                                           , [Char]
    "***"
                                           , [Char]
    "*** This could be a bug with SBV or the backend solver. Please report!"
                                           ]

    -- | Registering an uninterpreted SMT function. This is typically not necessary as uses of the UI
    -- function itself will register it automatically. But there are cases where doing this explicitly can
    -- come in handy.
    registerUISMTFunction :: (MonadIO m, SolverContext m, MonadSymbolic m) => SMTFunction fun a r => fun -> m ()
    registerUISMTFunction :: forall (m :: * -> *) fun a r.
    (MonadIO m, SolverContext m, MonadSymbolic m,
     SMTFunction fun a r) =>
    fun -> m ()
    registerUISMTFunction fun
    f = do State
    st   <- m State
    forall (m :: * -> *). SolverContext m => m State
    contextState
                                 ([Char], Maybe [[Char]])
    nmas <- fun -> m ([Char], Maybe [[Char]])
    forall fun a r (m :: * -> *).
    (SMTFunction fun a r, MonadIO m, SolverContext m,
     MonadSymbolic m) =>
    fun -> m ([Char], Maybe [[Char]])
    forall (m :: * -> *).
    (MonadIO m, SolverContext m, MonadSymbolic m) =>
    fun -> m ([Char], Maybe [[Char]])
    smtFunName fun
    f
                                 IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ State -> ([Char], Maybe [[Char]]) -> SBVType -> UICodeKind -> IO ()
    newUninterpreted State
    st ([Char], Maybe [[Char]])
    nmas (fun -> SBVType
    forall fun a r. SMTFunction fun a r => fun -> SBVType
    smtFunType fun
    f) UICodeKind
    UINone

    -- | Pointwise function value extraction. If we get unlucky and can't parse z3's output (happens
    -- when we have all booleans and z3 decides to spit out an expression), just brute force our
    -- way out of it. Note that we only do this if we have a pure boolean type, as otherwise we'd blow
    -- up. And I think it'll only be necessary then, I haven't seen z3 try anything smarter in other scenarios.
    pointWiseExtract ::  forall m. (MonadIO m, MonadQuery m) => String -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    pointWiseExtract :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    pointWiseExtract [Char]
    nm SBVType
    typ = m (Maybe ([([SExpr], SExpr)], SExpr))
    tryPointWise
      where trueSExpr :: SExpr
    trueSExpr  = (Integer, Maybe Int) -> SExpr
    ENum (Integer
    1, Maybe Int
    forall a. Maybe a
    Nothing)
            falseSExpr :: SExpr
    falseSExpr = (Integer, Maybe Int) -> SExpr
    ENum (Integer
    0, Maybe Int
    forall a. Maybe a
    Nothing)

            isTrueSExpr :: SExpr -> Bool
    isTrueSExpr (ENum (Integer
    1, Maybe Int
    Nothing)) = Bool
    True
            isTrueSExpr (ENum (Integer
    0, Maybe Int
    Nothing)) = Bool
    False
            isTrueSExpr SExpr
    s                   = [Char] -> Bool
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Bool) -> [Char] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV.pointWiseExtract: Impossible happened: Received: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    s

            (Int
    nArgs, Bool
    isBoolFunc) = case SBVType
    typ of
                                    SBVType [Kind]
    ts -> ([Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    ts Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, (Kind -> Bool) -> [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Kind -> Kind -> Bool
    forall a. Eq a => a -> a -> Bool
    == Kind
    KBool) [Kind]
    ts)

            getBVal :: [SExpr] -> m ([SExpr], SExpr)
            getBVal :: [SExpr] -> m ([SExpr], SExpr)
    getBVal [SExpr]
    args = do let shc :: SExpr -> a
    shc SExpr
    c | SExpr -> Bool
    isTrueSExpr SExpr
    c = a
    "true"
                                        | Bool
    True          = a
    "false"

                                  as :: [Char]
    as = [[Char]] -> [Char]
    unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ (SExpr -> [Char]) -> [SExpr] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map SExpr -> [Char]
    forall {a}. IsString a => SExpr -> a
    shc [SExpr]
    args

                                  cmd :: [Char]
    cmd   = [Char]
    "(get-value ((" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    as [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")))"

                                  bad :: [Char] -> Maybe [[Char]] -> m ([SExpr], SExpr)
    bad   = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m ([SExpr], SExpr)
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "get-value" [Char]
    cmd ([Char]
    "pointwise value of boolean function " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " on " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    as) Maybe [[Char]]
    forall a. Maybe a
    Nothing

                              [Char]
    r <- [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    cmd

                              [Char]
    -> ([Char] -> Maybe [[Char]] -> m ([SExpr], SExpr))
    -> (SExpr -> m ([SExpr], SExpr))
    -> m ([SExpr], SExpr)
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m ([SExpr], SExpr)
    bad ((SExpr -> m ([SExpr], SExpr)) -> m ([SExpr], SExpr))
    -> (SExpr -> m ([SExpr], SExpr)) -> m ([SExpr], SExpr)
    forall a b. (a -> b) -> a -> b
    $ \case EApp [EApp [SExpr
    _, SExpr
    e]] -> ([SExpr], SExpr) -> m ([SExpr], SExpr)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SExpr]
    args, SExpr
    e)
                                                  SExpr
    _                  -> [Char] -> Maybe [[Char]] -> m ([SExpr], SExpr)
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

            getBVals :: m [([SExpr], SExpr)]
            getBVals :: m [([SExpr], SExpr)]
    getBVals = ([SExpr] -> m ([SExpr], SExpr))
    -> [[SExpr]] -> m [([SExpr], SExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM [SExpr] -> m ([SExpr], SExpr)
    getBVal ([[SExpr]] -> m [([SExpr], SExpr)])
    -> [[SExpr]] -> m [([SExpr], SExpr)]
    forall a b. (a -> b) -> a -> b
    $ Int -> [SExpr] -> [[SExpr]]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    nArgs [SExpr
    falseSExpr, SExpr
    trueSExpr]

            tryPointWise :: m (Maybe ([([SExpr], SExpr)], SExpr))
    tryPointWise
              | Bool -> Bool
    not Bool
    isBoolFunc
              = Maybe ([([SExpr], SExpr)], SExpr)
    -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ([([SExpr], SExpr)], SExpr)
    forall a. Maybe a
    Nothing
              | Int
    nArgs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1
              = [Char] -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m (Maybe ([([SExpr], SExpr)], SExpr)))
    -> [Char] -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV.pointWiseExtract: Impossible happened, nArgs < 1: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    nArgs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SBVType -> [Char]
    forall a. Show a => a -> [Char]
    show SBVType
    typ
              | Bool
    True
              = do [([SExpr], SExpr)]
    vs <- m [([SExpr], SExpr)]
    getBVals
                   -- Pick the value that will give us the fewer entries
                   let ([([SExpr], SExpr)]
    trues, [([SExpr], SExpr)]
    falses) = (([SExpr], SExpr) -> Bool)
    -> [([SExpr], SExpr)] -> ([([SExpr], SExpr)], [([SExpr], SExpr)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\([SExpr]
    _, SExpr
    v) -> SExpr -> Bool
    isTrueSExpr SExpr
    v) [([SExpr], SExpr)]
    vs
                   Maybe ([([SExpr], SExpr)], SExpr)
    -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([([SExpr], SExpr)], SExpr)
     -> m (Maybe ([([SExpr], SExpr)], SExpr)))
    -> Maybe ([([SExpr], SExpr)], SExpr)
    -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall a b. (a -> b) -> a -> b
    $ ([([SExpr], SExpr)], SExpr) -> Maybe ([([SExpr], SExpr)], SExpr)
    forall a. a -> Maybe a
    Just (([([SExpr], SExpr)], SExpr) -> Maybe ([([SExpr], SExpr)], SExpr))
    -> ([([SExpr], SExpr)], SExpr) -> Maybe ([([SExpr], SExpr)], SExpr)
    forall a b. (a -> b) -> a -> b
    $ if [([SExpr], SExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [([SExpr], SExpr)]
    trues Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [([SExpr], SExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [([SExpr], SExpr)]
    falses
                                   then ([([SExpr], SExpr)]
    trues,  SExpr
    falseSExpr)
                                   else ([([SExpr], SExpr)]
    falses, SExpr
    trueSExpr)

    -- | For saturation purposes, get a proper argument. The forall quantification
    -- is safe here since we only use in smtFunSaturate calls, which looks at the
    -- kind stored inside only.
    mkSaturatingArg :: forall a. Kind -> SBV a
    mkSaturatingArg :: forall a. Kind -> SBV a
    mkSaturatingArg Kind
    k = SVal -> SBV a
    forall a. SVal -> SBV a
    SBV (SVal -> SBV a) -> SVal -> SBV a
    forall a b. (a -> b) -> a -> b
    $ Kind -> Either CV (Cached SV) -> SVal
    SVal Kind
    k (CV -> Either CV (Cached SV)
    forall a b. a -> Either a b
    Left (Kind -> CV
    defaultKindedValue Kind
    k))

    -- | Functions of arity 1
    instance ( SymVal a, HasKind a
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV r) a r
             where
      sexprToArg :: (SBV a -> SBV r) -> [SExpr] -> Maybe a
    sexprToArg SBV a -> SBV r
    _ [SExpr
    a0] = SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0
      sexprToArg SBV a -> SBV r
    _ [SExpr]
    _    = Maybe a
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a -> SBV r) -> SBVType
    smtFunType SBV a -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a -> SBV r) -> SBV r
    smtFunSaturate SBV a -> SBV r
    f = SBV a -> SBV r
    f (SBV a -> SBV r) -> SBV a -> SBV r
    forall a b. (a -> b) -> a -> b
    $ Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a))

    -- | Functions of arity 2
    instance ( SymVal a,  HasKind a
             , SymVal b,  HasKind b
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV r) (a, b) r
             where
      sexprToArg :: (SBV a -> SBV b -> SBV r) -> [SExpr] -> Maybe (a, b)
    sexprToArg SBV a -> SBV b -> SBV r
    _ [SExpr
    a0, SExpr
    a1] = (,) (a -> b -> (a, b)) -> Maybe a -> Maybe (b -> (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> (a, b)) -> Maybe b -> Maybe (a, b)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1
      sexprToArg SBV a -> SBV b -> SBV r
    _ [SExpr]
    _        = Maybe (a, b)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a -> SBV b -> SBV r) -> SBVType
    smtFunType SBV a -> SBV b -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a -> SBV b -> SBV r) -> SBV r
    smtFunSaturate SBV a -> SBV b -> SBV r
    f = SBV a -> SBV b -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))

    -- | Functions of arity 3
    instance ( SymVal a,   HasKind a
             , SymVal b,   HasKind b
             , SymVal c,   HasKind c
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV c -> SBV r) (a, b, c) r
             where
      sexprToArg :: (SBV a -> SBV b -> SBV c -> SBV r) -> [SExpr] -> Maybe (a, b, c)
    sexprToArg SBV a -> SBV b -> SBV c -> SBV r
    _ [SExpr
    a0, SExpr
    a1, SExpr
    a2] = (,,) (a -> b -> c -> (a, b, c))
    -> Maybe a -> Maybe (b -> c -> (a, b, c))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1 Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe c
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a2
      sexprToArg SBV a -> SBV b -> SBV c -> SBV r
    _ [SExpr]
    _            = Maybe (a, b, c)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a -> SBV b -> SBV c -> SBV r) -> SBVType
    smtFunType SBV a -> SBV b -> SBV c -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a -> SBV b -> SBV c -> SBV r) -> SBV r
    smtFunSaturate SBV a -> SBV b -> SBV c -> SBV r
    f = SBV a -> SBV b -> SBV c -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))
                           (Kind -> SBV c
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c)))

    -- | Functions of arity 4
    instance ( SymVal a,   HasKind a
             , SymVal b,   HasKind b
             , SymVal c,   HasKind c
             , SymVal d,   HasKind d
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV c -> SBV d -> SBV r) (a, b, c, d) r
             where
      sexprToArg :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV r)
    -> [SExpr] -> Maybe (a, b, c, d)
    sexprToArg SBV a -> SBV b -> SBV c -> SBV d -> SBV r
    _ [SExpr
    a0, SExpr
    a1, SExpr
    a2, SExpr
    a3] = (,,,) (a -> b -> c -> d -> (a, b, c, d))
    -> Maybe a -> Maybe (b -> c -> d -> (a, b, c, d))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> c -> d -> (a, b, c, d))
    -> Maybe b -> Maybe (c -> d -> (a, b, c, d))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1 Maybe (c -> d -> (a, b, c, d))
    -> Maybe c -> Maybe (d -> (a, b, c, d))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe c
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a2 Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe d
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a3
      sexprToArg SBV a -> SBV b -> SBV c -> SBV d -> SBV r
    _ [SExpr]
    _               = Maybe (a, b, c, d)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV r) -> SBVType
    smtFunType SBV a -> SBV b -> SBV c -> SBV d -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c), Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV r) -> SBV r
    smtFunSaturate SBV a -> SBV b -> SBV c -> SBV d -> SBV r
    f = SBV a -> SBV b -> SBV c -> SBV d -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))
                           (Kind -> SBV c
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c)))
                           (Kind -> SBV d
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d)))

    -- | Functions of arity 5
    instance ( SymVal a,   HasKind a
             , SymVal b,   HasKind b
             , SymVal c,   HasKind c
             , SymVal d,   HasKind d
             , SymVal e,   HasKind e
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r) (a, b, c, d, e) r
             where
      sexprToArg :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r)
    -> [SExpr] -> Maybe (a, b, c, d, e)
    sexprToArg SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r
    _ [SExpr
    a0, SExpr
    a1, SExpr
    a2, SExpr
    a3, SExpr
    a4] = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
    -> Maybe a -> Maybe (b -> c -> d -> e -> (a, b, c, d, e))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> c -> d -> e -> (a, b, c, d, e))
    -> Maybe b -> Maybe (c -> d -> e -> (a, b, c, d, e))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1 Maybe (c -> d -> e -> (a, b, c, d, e))
    -> Maybe c -> Maybe (d -> e -> (a, b, c, d, e))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe c
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a2 Maybe (d -> e -> (a, b, c, d, e))
    -> Maybe d -> Maybe (e -> (a, b, c, d, e))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe d
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a3 Maybe (e -> (a, b, c, d, e)) -> Maybe e -> Maybe (a, b, c, d, e)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe e
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a4
      sexprToArg SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r
    _ [SExpr]
    _                    = Maybe (a, b, c, d, e)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r) -> SBVType
    smtFunType SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c), Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d), Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r) -> SBV r
    smtFunSaturate SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r
    f = SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))
                           (Kind -> SBV c
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c)))
                           (Kind -> SBV d
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d)))
                           (Kind -> SBV e
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e)))

    -- | Functions of arity 6
    instance ( SymVal a,   HasKind a
             , SymVal b,   HasKind b
             , SymVal c,   HasKind c
             , SymVal d,   HasKind d
             , SymVal e,   HasKind e
             , SymVal f,   HasKind f
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r) (a, b, c, d, e, f) r
             where
      sexprToArg :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r)
    -> [SExpr] -> Maybe (a, b, c, d, e, f)
    sexprToArg SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r
    _ [SExpr
    a0, SExpr
    a1, SExpr
    a2, SExpr
    a3, SExpr
    a4, SExpr
    a5] = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
    -> Maybe a -> Maybe (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
    -> Maybe b -> Maybe (c -> d -> e -> f -> (a, b, c, d, e, f))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1 Maybe (c -> d -> e -> f -> (a, b, c, d, e, f))
    -> Maybe c -> Maybe (d -> e -> f -> (a, b, c, d, e, f))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe c
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a2 Maybe (d -> e -> f -> (a, b, c, d, e, f))
    -> Maybe d -> Maybe (e -> f -> (a, b, c, d, e, f))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe d
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a3 Maybe (e -> f -> (a, b, c, d, e, f))
    -> Maybe e -> Maybe (f -> (a, b, c, d, e, f))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe e
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a4 Maybe (f -> (a, b, c, d, e, f))
    -> Maybe f -> Maybe (a, b, c, d, e, f)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe f
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a5
      sexprToArg SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r
    _ [SExpr]
    _                        = Maybe (a, b, c, d, e, f)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r)
    -> SBVType
    smtFunType SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c), Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d), Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e), Proxy f -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @f), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r)
    -> SBV r
    smtFunSaturate SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r
    f = SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))
                           (Kind -> SBV c
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c)))
                           (Kind -> SBV d
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d)))
                           (Kind -> SBV e
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e)))
                           (Kind -> SBV f
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy f -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @f)))

    -- | Functions of arity 7
    instance ( SymVal a,   HasKind a
             , SymVal b,   HasKind b
             , SymVal c,   HasKind c
             , SymVal d,   HasKind d
             , SymVal e,   HasKind e
             , SymVal f,   HasKind f
             , SymVal g,   HasKind g
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r) (a, b, c, d, e, f, g) r
             where
      sexprToArg :: (SBV a
     -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r)
    -> [SExpr] -> Maybe (a, b, c, d, e, f, g)
    sexprToArg SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r
    _ [SExpr
    a0, SExpr
    a1, SExpr
    a2, SExpr
    a3, SExpr
    a4, SExpr
    a5, SExpr
    a6] = (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
    -> Maybe a
    -> Maybe (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
    -> Maybe b
    -> Maybe (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1 Maybe (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
    -> Maybe c -> Maybe (d -> e -> f -> g -> (a, b, c, d, e, f, g))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe c
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a2 Maybe (d -> e -> f -> g -> (a, b, c, d, e, f, g))
    -> Maybe d -> Maybe (e -> f -> g -> (a, b, c, d, e, f, g))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe d
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a3 Maybe (e -> f -> g -> (a, b, c, d, e, f, g))
    -> Maybe e -> Maybe (f -> g -> (a, b, c, d, e, f, g))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe e
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a4 Maybe (f -> g -> (a, b, c, d, e, f, g))
    -> Maybe f -> Maybe (g -> (a, b, c, d, e, f, g))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe f
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a5 Maybe (g -> (a, b, c, d, e, f, g))
    -> Maybe g -> Maybe (a, b, c, d, e, f, g)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe g
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a6
      sexprToArg SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r
    _ [SExpr]
    _                            = Maybe (a, b, c, d, e, f, g)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a
     -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r)
    -> SBVType
    smtFunType SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c), Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d), Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e), Proxy f -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @f), Proxy g -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @g), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a
     -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r)
    -> SBV r
    smtFunSaturate SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r
    f = SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))
                           (Kind -> SBV c
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c)))
                           (Kind -> SBV d
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d)))
                           (Kind -> SBV e
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e)))
                           (Kind -> SBV f
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy f -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @f)))
                           (Kind -> SBV g
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy g -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @g)))

    -- | Functions of arity 8
    instance ( SymVal a,   HasKind a
             , SymVal b,   HasKind b
             , SymVal c,   HasKind c
             , SymVal d,   HasKind d
             , SymVal e,   HasKind e
             , SymVal f,   HasKind f
             , SymVal g,   HasKind g
             , SymVal h,   HasKind h
             , SatModel r, HasKind r
             ) => SMTFunction (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBV h -> SBV r) (a, b, c, d, e, f, g, h) r
             where
      sexprToArg :: (SBV a
     -> SBV b
     -> SBV c
     -> SBV d
     -> SBV e
     -> SBV f
     -> SBV g
     -> SBV h
     -> SBV r)
    -> [SExpr] -> Maybe (a, b, c, d, e, f, g, h)
    sexprToArg SBV a
    -> SBV b
    -> SBV c
    -> SBV d
    -> SBV e
    -> SBV f
    -> SBV g
    -> SBV h
    -> SBV r
    _ [SExpr
    a0, SExpr
    a1, SExpr
    a2, SExpr
    a3, SExpr
    a4, SExpr
    a5, SExpr
    a6, SExpr
    a7] = (,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe a
    -> Maybe
         (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SExpr -> Maybe a
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a0 Maybe (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe b
    -> Maybe (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe b
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a1 Maybe (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe c
    -> Maybe (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe c
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a2 Maybe (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe d -> Maybe (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe d
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a3 Maybe (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe e -> Maybe (f -> g -> h -> (a, b, c, d, e, f, g, h))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe e
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a4 Maybe (f -> g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe f -> Maybe (g -> h -> (a, b, c, d, e, f, g, h))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe f
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a5 Maybe (g -> h -> (a, b, c, d, e, f, g, h))
    -> Maybe g -> Maybe (h -> (a, b, c, d, e, f, g, h))
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe g
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a6 Maybe (h -> (a, b, c, d, e, f, g, h))
    -> Maybe h -> Maybe (a, b, c, d, e, f, g, h)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe h
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    a7
      sexprToArg SBV a
    -> SBV b
    -> SBV c
    -> SBV d
    -> SBV e
    -> SBV f
    -> SBV g
    -> SBV h
    -> SBV r
    _ [SExpr]
    _                                = Maybe (a, b, c, d, e, f, g, h)
    forall a. Maybe a
    Nothing

      smtFunType :: (SBV a
     -> SBV b
     -> SBV c
     -> SBV d
     -> SBV e
     -> SBV f
     -> SBV g
     -> SBV h
     -> SBV r)
    -> SBVType
    smtFunType SBV a
    -> SBV b
    -> SBV c
    -> SBV d
    -> SBV e
    -> SBV f
    -> SBV g
    -> SBV h
    -> SBV r
    _ = [Kind] -> SBVType
    SBVType [Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a), Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b), Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c), Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d), Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e), Proxy f -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @f), Proxy g -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @g), Proxy h -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @h), Proxy r -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @r)]

      smtFunSaturate :: (SBV a
     -> SBV b
     -> SBV c
     -> SBV d
     -> SBV e
     -> SBV f
     -> SBV g
     -> SBV h
     -> SBV r)
    -> SBV r
    smtFunSaturate SBV a
    -> SBV b
    -> SBV c
    -> SBV d
    -> SBV e
    -> SBV f
    -> SBV g
    -> SBV h
    -> SBV r
    f = SBV a
    -> SBV b
    -> SBV c
    -> SBV d
    -> SBV e
    -> SBV f
    -> SBV g
    -> SBV h
    -> SBV r
    f (Kind -> SBV a
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)))
                           (Kind -> SBV b
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy b -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @b)))
                           (Kind -> SBV c
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy c -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @c)))
                           (Kind -> SBV d
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy d -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @d)))
                           (Kind -> SBV e
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy e -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @e)))
                           (Kind -> SBV f
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy f -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @f)))
                           (Kind -> SBV g
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy g -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @g)))
                           (Kind -> SBV h
    forall a. Kind -> SBV a
    mkSaturatingArg (Proxy h -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @h)))

    -- Turn "((F (lambda ((x!1 Int)) (+ 3 (* 2 x!1)))))"
    -- into something more palatable.
    -- If we can't do that, we simply return the input unchanged
    trimFunctionResponse :: String -> String -> Maybe [String] -> String
    trimFunctionResponse :: [Char] -> [Char] -> Maybe [[Char]] -> [Char]
    trimFunctionResponse [Char]
    resp [Char]
    nm Maybe [[Char]]
    mbArgs
      | Just [Char]
    parsed <- [Char] -> [Char] -> Maybe [[Char]] -> Maybe [Char]
    makeHaskellFunction [Char]
    resp [Char]
    nm Maybe [[Char]]
    mbArgs
      = [Char]
    parsed
      | Bool
    True
      = [Char] -> [Char]
    def ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ case [Char] -> [Char]
    trim [Char]
    resp of
                Char
    '(':Char
    '(':[Char]
    rest | [Char]
    nm [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    rest -> [Char] -> [Char]
    forall a. [a] -> [a]
    butLast2 ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    trim (Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    nm) [Char]
    rest)
                [Char]
    _                                   -> [Char]
    resp
      where trim :: [Char] -> [Char]
    trim     = (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace
            butLast2 :: [a] -> [a]
    butLast2 = [a] -> [a]
    forall a. [a] -> [a]
    reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    2 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse
            def :: [Char] -> [Char]
    def [Char]
    x = [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " = fromSMTLib " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    x

    -- | Generalization of 'Data.SBV.Control.getFunction'
    getFunction :: (MonadIO m, MonadQuery m, SolverContext m, MonadSymbolic m, SymVal a, SymVal r, SMTFunction fun a r)
                => fun -> m (Either String ([(a, r)], r))
    getFunction :: forall (m :: * -> *) a r fun.
    (MonadIO m, MonadQuery m, SolverContext m, MonadSymbolic m,
     SymVal a, SymVal r, SMTFunction fun a r) =>
    fun -> m (Either [Char] ([(a, r)], r))
    getFunction fun
    f = do ([Char]
    nm, Maybe [[Char]]
    args) <- fun -> m ([Char], Maybe [[Char]])
    forall fun a r (m :: * -> *).
    (SMTFunction fun a r, MonadIO m, SolverContext m,
     MonadSymbolic m) =>
    fun -> m ([Char], Maybe [[Char]])
    forall (m :: * -> *).
    (MonadIO m, SolverContext m, MonadSymbolic m) =>
    fun -> m ([Char], Maybe [[Char]])
    smtFunName fun
    f

                       let cmd :: [Char]
    cmd = [Char]
    "(get-value (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "))"
                           bad :: [Char] -> Maybe [[Char]] -> m (Either [Char] ([(a, r)], r))
    bad = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m (Either [Char] ([(a, r)], r))
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "getFunction" [Char]
    cmd [Char]
    "a function value" Maybe [[Char]]
    forall a. Maybe a
    Nothing

                       [Char]
    r <- [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    cmd

                       [Char]
    -> ([Char] -> Maybe [[Char]] -> m (Either [Char] ([(a, r)], r)))
    -> (SExpr -> m (Either [Char] ([(a, r)], r)))
    -> m (Either [Char] ([(a, r)], r))
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m (Either [Char] ([(a, r)], r))
    bad ((SExpr -> m (Either [Char] ([(a, r)], r)))
     -> m (Either [Char] ([(a, r)], r)))
    -> (SExpr -> m (Either [Char] ([(a, r)], r)))
    -> m (Either [Char] ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ \case EApp [EApp [ECon [Char]
    o, SExpr
    e]] | [Char]
    o [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    nm -> do Either [Char] ([(a, r)], r)
    mbAssocs <- fun -> ([Char], SExpr) -> m (Either [Char] ([(a, r)], r))
    forall fun a r (m :: * -> *).
    (SMTFunction fun a r, MonadIO m, SolverContext m, MonadQuery m,
     MonadSymbolic m, SymVal r) =>
    fun -> ([Char], SExpr) -> m (Either [Char] ([(a, r)], r))
    forall (m :: * -> *).
    (MonadIO m, SolverContext m, MonadQuery m, MonadSymbolic m,
     SymVal r) =>
    fun -> ([Char], SExpr) -> m (Either [Char] ([(a, r)], r))
    sexprToFun fun
    f ([Char] -> [Char] -> Maybe [[Char]] -> [Char]
    trimFunctionResponse [Char]
    r [Char]
    nm Maybe [[Char]]
    args, SExpr
    e)
                                                                                   case Either [Char] ([(a, r)], r)
    mbAssocs of
                                                                                     Right ([(a, r)], r)
    assocs -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r)))
    -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ ([(a, r)], r) -> Either [Char] ([(a, r)], r)
    forall a b. b -> Either a b
    Right ([(a, r)], r)
    assocs
                                                                                     Left  [Char]
    raw    -> do Maybe ([([SExpr], SExpr)], SExpr)
    mbPVS <- [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    pointWiseExtract [Char]
    nm (fun -> SBVType
    forall fun a r. SMTFunction fun a r => fun -> SBVType
    smtFunType fun
    f)
                                                                                                        case Maybe ([([SExpr], SExpr)], SExpr)
    mbPVS Maybe ([([SExpr], SExpr)], SExpr)
    -> (([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r))
    -> Maybe ([(a, r)], r)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r)
    convert of
                                                                                                          Just ([(a, r)], r)
    x  -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r)))
    -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ ([(a, r)], r) -> Either [Char] ([(a, r)], r)
    forall a b. b -> Either a b
    Right ([(a, r)], r)
    x
                                                                                                          Maybe ([(a, r)], r)
    Nothing -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r)))
    -> Either [Char] ([(a, r)], r) -> m (Either [Char] ([(a, r)], r))
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Either [Char] ([(a, r)], r)
    forall a b. a -> Either a b
    Left [Char]
    raw
                                           SExpr
    _                                 -> [Char] -> Maybe [[Char]] -> m (Either [Char] ([(a, r)], r))
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing
        where convert :: ([([SExpr], SExpr)], SExpr) -> Maybe ([(a, r)], r)
    convert    ([([SExpr], SExpr)]
    vs, SExpr
    d) = (,) ([(a, r)] -> r -> ([(a, r)], r))
    -> Maybe [(a, r)] -> Maybe (r -> ([(a, r)], r))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([SExpr], SExpr) -> Maybe (a, r))
    -> [([SExpr], SExpr)] -> Maybe [(a, r)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([SExpr], SExpr) -> Maybe (a, r)
    sexprPoint [([SExpr], SExpr)]
    vs Maybe (r -> ([(a, r)], r)) -> Maybe r -> Maybe ([(a, r)], r)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe r
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    d
              sexprPoint :: ([SExpr], SExpr) -> Maybe (a, r)
    sexprPoint ([SExpr]
    as, SExpr
    v) = (,) (a -> r -> (a, r)) -> Maybe a -> Maybe (r -> (a, r))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> fun -> [SExpr] -> Maybe a
    forall fun a r. SMTFunction fun a r => fun -> [SExpr] -> Maybe a
    sexprToArg fun
    f [SExpr]
    as    Maybe (r -> (a, r)) -> Maybe r -> Maybe (a, r)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe r
    forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    v

    -- | Generalization of 'Data.SBV.Control.getUninterpretedValue'
    getUninterpretedValue :: (MonadIO m, MonadQuery m, HasKind a) => SBV a -> m String
    getUninterpretedValue :: forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m, HasKind a) =>
    SBV a -> m [Char]
    getUninterpretedValue SBV a
    s =
            case SBV a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SBV a
    s of
              KUserSort [Char]
    _ Maybe [[Char]]
    Nothing -> do SV
    sv <- (State -> IO SV) -> m SV
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    (State -> IO a) -> m a
    inNewContext (State -> SBV a -> IO SV
    forall a. State -> SBV a -> IO SV
    `sbvToSV` SBV a
    s)

                                        let nm :: [Char]
    nm  = SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    sv
                                            cmd :: [Char]
    cmd = [Char]
    "(get-value (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "))"
                                            bad :: [Char] -> Maybe [[Char]] -> m [Char]
    bad = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m [Char]
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "getValue" [Char]
    cmd [Char]
    "a model value" Maybe [[Char]]
    forall a. Maybe a
    Nothing

                                        [Char]
    r <- [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    cmd

                                        [Char]
    -> ([Char] -> Maybe [[Char]] -> m [Char])
    -> (SExpr -> m [Char])
    -> m [Char]
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m [Char]
    bad ((SExpr -> m [Char]) -> m [Char])
    -> (SExpr -> m [Char]) -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ \case EApp [EApp [ECon [Char]
    o,  ECon [Char]
    v]] | [Char]
    o [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    sv -> [Char] -> m [Char]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    v
                                                            SExpr
    _                                            -> [Char] -> Maybe [[Char]] -> m [Char]
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

              Kind
    k                   -> [Char] -> m [Char]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m [Char]) -> [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [[Char]
    ""
                                                     , [Char]
    "*** SBV.getUninterpretedValue: Called on an 'interpreted' kind"
                                                     , [Char]
    "*** "
                                                     , [Char]
    "***    Kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    k
                                                     , [Char]
    "***    Hint: Use 'getValue' to extract value for interpreted kinds."
                                                     , [Char]
    "*** "
                                                     , [Char]
    "*** Only truly uninterpreted sorts should be used with 'getUninterpretedValue.'"
                                                     ]

    -- | Get the value of a term, but in CV form. Used internally. The model-index, in particular is extremely Z3 specific!
    getValueCVHelper :: (MonadIO m, MonadQuery m) => Maybe Int -> SV -> m CV
    getValueCVHelper :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCVHelper Maybe Int
    mbi SV
    s
      | SV
    s SV -> SV -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV
    trueSV
      = CV -> m CV
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CV
    trueCV
      | SV
    s SV -> SV -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV
    falseSV
      = CV -> m CV
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CV
    falseCV
      | Bool
    True
      = Maybe Int -> [Char] -> Kind -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> [Char] -> Kind -> m CV
    extractValue Maybe Int
    mbi (SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    s) (SV -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SV
    s)

    -- | "Make up" a CV for this type. Like zero, but smarter.
    defaultKindedValue :: Kind -> CV
    defaultKindedValue :: Kind -> CV
    defaultKindedValue Kind
    k = Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal
    cvt Kind
    k
      where cvt :: Kind -> CVal
            cvt :: Kind -> CVal
    cvt Kind
    KBool            = Integer -> CVal
    CInteger Integer
    0
            cvt KBounded{}       = Integer -> CVal
    CInteger Integer
    0
            cvt Kind
    KUnbounded       = Integer -> CVal
    CInteger Integer
    0
            cvt Kind
    KReal            = AlgReal -> CVal
    CAlgReal AlgReal
    0
            cvt (KUserSort [Char]
    s Maybe [[Char]]
    ui) = [Char] -> Maybe [[Char]] -> CVal
    uninterp [Char]
    s Maybe [[Char]]
    ui
            cvt Kind
    KFloat           = Float -> CVal
    CFloat Float
    0
            cvt Kind
    KDouble          = Double -> CVal
    CDouble Double
    0
            cvt Kind
    KRational        = Rational -> CVal
    CRational Rational
    0
            cvt (KFP Int
    eb Int
    sb)      = FP -> CVal
    CFP (Bool -> Int -> Int -> FP
    fpZero Bool
    False Int
    eb Int
    sb)
            cvt Kind
    KChar            = Char -> CVal
    CChar Char
    '\NUL'                -- why not?
            cvt Kind
    KString          = [Char] -> CVal
    CString [Char]
    ""
            cvt (KList  Kind
    _)       = [CVal] -> CVal
    CList []
            cvt (KSet  Kind
    _)        = RCSet CVal -> CVal
    CSet (RCSet CVal -> CVal) -> RCSet CVal -> CVal
    forall a b. (a -> b) -> a -> b
    $ Set CVal -> RCSet CVal
    forall a. Set a -> RCSet a
    RegularSet Set CVal
    forall a. Set a
    Set.empty -- why not? Arguably, could be the universal set
            cvt (KTuple [Kind]
    ks)      = [CVal] -> CVal
    CTuple ([CVal] -> CVal) -> [CVal] -> CVal
    forall a b. (a -> b) -> a -> b
    $ (Kind -> CVal) -> [Kind] -> [CVal]
    forall a b. (a -> b) -> [a] -> [b]
    map Kind -> CVal
    cvt [Kind]
    ks
            cvt (KMaybe Kind
    _)       = Maybe CVal -> CVal
    CMaybe Maybe CVal
    forall a. Maybe a
    Nothing
            cvt (KEither Kind
    k1 Kind
    _)   = Either CVal CVal -> CVal
    CEither (Either CVal CVal -> CVal)
    -> (CVal -> Either CVal CVal) -> CVal -> CVal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CVal -> Either CVal CVal
    forall a b. a -> Either a b
    Left (CVal -> CVal) -> CVal -> CVal
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal
    cvt Kind
    k1     -- why not?

            -- Tricky case of uninterpreted
            uninterp :: [Char] -> Maybe [[Char]] -> CVal
    uninterp [Char]
    _ (Just ([Char]
    c:[[Char]]
    _)) = (Maybe Int, [Char]) -> CVal
    CUserSort (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    1, [Char]
    c)
            uninterp [Char]
    _ (Just [])    = [Char] -> CVal
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "defaultKindedValue: enumerated kind with no constructors!"

            -- A completely uninterpreted sort, i.e., no elements. Return the witness element for it.
            uninterp [Char]
    s Maybe [[Char]]
    Nothing      = (Maybe Int, [Char]) -> CVal
    CUserSort (Maybe Int
    forall a. Maybe a
    Nothing, [Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "_witness")

    -- | Go from an SExpr directly to a value
    sexprToVal :: forall a. SymVal a => SExpr -> Maybe a
    sexprToVal :: forall a. SymVal a => SExpr -> Maybe a
    sexprToVal SExpr
    e = CV -> a
    forall a. SymVal a => CV -> a
    fromCV (CV -> a) -> Maybe CV -> Maybe a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Kind -> SExpr -> Maybe CV
    recoverKindedValue (Proxy a -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)) SExpr
    e

    -- | Recover a given solver-printed value with a possible interpretation
    recoverKindedValue :: Kind -> SExpr -> Maybe CV
    recoverKindedValue :: Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    k SExpr
    e = case Kind
    k of
                               Kind
    KBool       | ENum (Integer
    i, Maybe Int
    _) <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> Integer -> CV
    forall a. Integral a => Kind -> a -> CV
    mkConstCV Kind
    k Integer
    i
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               KBounded{}  | ENum (Integer
    i, Maybe Int
    _) <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> Integer -> CV
    forall a. Integral a => Kind -> a -> CV
    mkConstCV Kind
    k Integer
    i
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KUnbounded  | ENum (Integer
    i, Maybe Int
    _) <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> Integer -> CV
    forall a. Integral a => Kind -> a -> CV
    mkConstCV Kind
    k Integer
    i
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KReal       | ENum (Integer
    i, Maybe Int
    _) <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> Integer -> CV
    forall a. Integral a => Kind -> a -> CV
    mkConstCV Kind
    k Integer
    i
                                           | EReal AlgReal
    i     <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KReal (AlgReal -> CVal
    CAlgReal AlgReal
    i)
                                           | Bool
    True                  -> SExpr -> Maybe CV
    interpretInterval SExpr
    e

                               KUserSort{} | ECon [Char]
    s <- SExpr
    e           -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ (Maybe Int, [Char]) -> CVal
    CUserSort (Kind -> [Char] -> Maybe Int
    getUIIndex Kind
    k [Char]
    s, [Char]
    s)
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KFloat      | ENum (Integer
    i, Maybe Int
    _) <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> Integer -> CV
    forall a. Integral a => Kind -> a -> CV
    mkConstCV Kind
    k Integer
    i
                                           | EFloat Float
    i    <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KFloat (Float -> CVal
    CFloat Float
    i)
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KDouble     | ENum (Integer
    i, Maybe Int
    _) <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> Integer -> CV
    forall a. Integral a => Kind -> a -> CV
    mkConstCV Kind
    k Integer
    i
                                           | EDouble Double
    i   <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KDouble (Double -> CVal
    CDouble Double
    i)
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               KFP Int
    eb Int
    sb   | ENum (Integer
    i, Maybe Int
    _)      <- SExpr
    e -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ FP -> CVal
    CFP (FP -> CVal) -> FP -> CVal
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Integer -> FP
    fpFromInteger Int
    eb Int
    sb Integer
    i
                                           | EFloat Float
    f         <- SExpr
    e -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ FP -> CVal
    CFP (FP -> CVal) -> FP -> CVal
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Float -> FP
    fpFromFloat   Int
    eb Int
    sb Float
    f
                                           | EDouble Double
    d        <- SExpr
    e -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ FP -> CVal
    CFP (FP -> CVal) -> FP -> CVal
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Double -> FP
    fpFromDouble  Int
    eb Int
    sb Double
    d
                                           | EFloatingPoint FP
    c <- SExpr
    e -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ FP -> CVal
    CFP FP
    c
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KChar       | ECon [Char]
    s      <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KChar (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ Char -> CVal
    CChar (Char -> CVal) -> Char -> CVal
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Char
    interpretChar [Char]
    s
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KString     | ECon [Char]
    s      <- SExpr
    e      -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KString (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ [Char] -> CVal
    CString ([Char] -> CVal) -> [Char] -> CVal
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    interpretString [Char]
    s
                                           | Bool
    True                  -> Maybe CV
    forall a. Maybe a
    Nothing

                               Kind
    KRational                           -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ Rational -> CVal
    CRational (Rational -> CVal) -> Rational -> CVal
    forall a b. (a -> b) -> a -> b
    $ SExpr -> Rational
    interpretRational SExpr
    e

                               KList Kind
    ek                            -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ [CVal] -> CVal
    CList ([CVal] -> CVal) -> [CVal] -> CVal
    forall a b. (a -> b) -> a -> b
    $ Kind -> SExpr -> [CVal]
    interpretList Kind
    ek SExpr
    e

                               KSet Kind
    ek                             -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ RCSet CVal -> CVal
    CSet (RCSet CVal -> CVal) -> RCSet CVal -> CVal
    forall a b. (a -> b) -> a -> b
    $ Kind -> SExpr -> RCSet CVal
    interpretSet Kind
    ek SExpr
    e

                               KTuple{}                            -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ [CVal] -> CVal
    CTuple ([CVal] -> CVal) -> [CVal] -> CVal
    forall a b. (a -> b) -> a -> b
    $ SExpr -> [CVal]
    interpretTuple SExpr
    e

                               KMaybe{}                            -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ Maybe CVal -> CVal
    CMaybe (Maybe CVal -> CVal) -> Maybe CVal -> CVal
    forall a b. (a -> b) -> a -> b
    $ Kind -> SExpr -> Maybe CVal
    interpretMaybe Kind
    k SExpr
    e

                               KEither{}                           -> CV -> Maybe CV
    forall a. a -> Maybe a
    Just (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    k (CVal -> CV) -> CVal -> CV
    forall a b. (a -> b) -> a -> b
    $ Either CVal CVal -> CVal
    CEither (Either CVal CVal -> CVal) -> Either CVal CVal -> CVal
    forall a b. (a -> b) -> a -> b
    $ Kind -> SExpr -> Either CVal CVal
    interpretEither Kind
    k SExpr
    e

      where getUIIndex :: Kind -> [Char] -> Maybe Int
    getUIIndex (KUserSort  [Char]
    _ (Just [[Char]]
    xs)) [Char]
    i = [Char]
    i [Char] -> [[Char]] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` [[Char]]
    xs
            getUIIndex Kind
    _                        [Char]
    _ = Maybe Int
    forall a. Maybe a
    Nothing

            stringLike :: [Char] -> Bool
    stringLike [Char]
    xs = [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    xs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 Bool -> Bool -> Bool
    && [Char] -> Char
    forall a. HasCallStack => [a] -> a
    head [Char]
    xs Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"' Bool -> Bool -> Bool
    && [Char] -> Char
    forall a. HasCallStack => [a] -> a
    last [Char]
    xs Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"'

            -- Make sure strings are really strings
            interpretString :: [Char] -> [Char]
    interpretString [Char]
    xs
              | Bool -> Bool
    not ([Char] -> Bool
    stringLike [Char]
    xs)
              = [Char] -> [Char]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Expected a string constant with quotes, received: <" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    xs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">"
              | Bool
    True
              = [Char] -> [Char]
    qfsToString ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    forall a. HasCallStack => [a] -> [a]
    tail ([Char] -> [Char]
    forall a. HasCallStack => [a] -> [a]
    init [Char]
    xs)

            interpretChar :: [Char] -> Char
    interpretChar [Char]
    xs = case [Char] -> [Char]
    interpretString [Char]
    xs of
                                 [Char
    c] -> Char
    c
                                 [Char]
    _   -> [Char] -> Char
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Char) -> [Char] -> Char
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Expected a singleton char constant, received: <" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    xs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">"

            interpretRational :: SExpr -> Rational
    interpretRational (EApp [ECon [Char]
    "SBV.Rational", SExpr
    v1, SExpr
    v2])
               | Just (CV Kind
    _ (CInteger Integer
    n)) <- Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    KUnbounded SExpr
    v1
               , Just (CV Kind
    _ (CInteger Integer
    d)) <- Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    KUnbounded SExpr
    v2
               = Integer
    n Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    d
            interpretRational SExpr
    xs = [Char] -> Rational
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Rational) -> [Char] -> Rational
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Expected a rational constant, received: <" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    xs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">"

            interpretList :: Kind -> SExpr -> [CVal]
    interpretList Kind
    ek SExpr
    topExpr = SExpr -> [CVal]
    walk SExpr
    topExpr
              where walk :: SExpr -> [CVal]
    walk (EApp [ECon [Char]
    "as", ECon [Char]
    "seq.empty", SExpr
    _]) = []
                    walk (EApp [ECon [Char]
    "seq.unit", SExpr
    v])             = case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    ek SExpr
    v of
                                                                     Just CV
    w -> [CV -> CVal
    cvVal CV
    w]
                                                                     Maybe CV
    Nothing -> [Char] -> [CVal]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [CVal]) -> [Char] -> [CVal]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot parse a sequence item of kind " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    ek [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " from: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    v [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    extra SExpr
    v
                    walk (EApp (ECon [Char]
    "seq.++" : [SExpr]
    rest))           = (SExpr -> [CVal]) -> [SExpr] -> [CVal]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SExpr -> [CVal]
    walk [SExpr]
    rest
                    walk SExpr
    cur                                     = [Char] -> [CVal]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [CVal]) -> [Char] -> [CVal]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Expected a sequence constant, but received: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    cur [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    extra SExpr
    cur

                    extra :: SExpr -> [Char]
    extra SExpr
    cur | SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    cur [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    t = [Char]
    ""
                              | Bool
    True          = [Char]
    "\nWhile parsing: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    t
                              where t :: [Char]
    t = SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    topExpr

            -- Essentially treat sets as functions, since we do allow for store associations
            interpretSet :: Kind -> SExpr -> RCSet CVal
    interpretSet Kind
    ke SExpr
    setExpr
                 | SExpr -> Bool
    isUniversal SExpr
    setExpr             = Set CVal -> RCSet CVal
    forall a. Set a -> RCSet a
    ComplementSet Set CVal
    forall a. Set a
    Set.empty
                 | SExpr -> Bool
    isEmpty     SExpr
    setExpr             = Set CVal -> RCSet CVal
    forall a. Set a -> RCSet a
    RegularSet    Set CVal
    forall a. Set a
    Set.empty
                 | Just (Right ([([SExpr], SExpr)], SExpr)
    assocs) <- Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    mbAssocs = ([([SExpr], SExpr)], SExpr) -> RCSet CVal
    decode ([([SExpr], SExpr)], SExpr)
    assocs
                 | Bool
    True                            = [Char] -> RCSet CVal
    forall a. [Char] -> a
    tbd [Char]
    "Expected a set value, but couldn't decipher the solver output."

               where tbd :: String -> a
                     tbd :: forall a. [Char] -> a
    tbd [Char]
    w = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                             , [Char]
    "*** Data.SBV.interpretSet: Unable to process solver output."
                                             , [Char]
    "***"
                                             , [Char]
    "*** Kind    : " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show (Kind -> Kind
    KSet Kind
    ke)
                                             , [Char]
    "*** Received: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    setExpr
                                             , [Char]
    "*** Reason  : " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    w
                                             , [Char]
    "***"
                                             , [Char]
    "*** This is either a bug or something SBV currently does not support."
                                             , [Char]
    "*** Please report this as a feature request!"
                                             ]

                     isTrue :: SExpr -> Bool
    isTrue (ENum (Integer
    1, Maybe Int
    Nothing)) = Bool
    True
                     isTrue (ENum (Integer
    0, Maybe Int
    Nothing)) = Bool
    False
                     isTrue SExpr
    bad                 = [Char] -> Bool
    forall a. [Char] -> a
    tbd ([Char] -> Bool) -> [Char] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Non-boolean membership value seen: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    bad

                     isUniversal :: SExpr -> Bool
    isUniversal (EApp [EApp [ECon [Char]
    "as", ECon [Char]
    "const", EApp [ECon [Char]
    "Array", SExpr
    _, ECon [Char]
    "Bool"]], SExpr
    r]) = SExpr -> Bool
    isTrue SExpr
    r
                     isUniversal SExpr
    _                                                                               = Bool
    False

                     isEmpty :: SExpr -> Bool
    isEmpty     (EApp [EApp [ECon [Char]
    "as", ECon [Char]
    "const", EApp [ECon [Char]
    "Array", SExpr
    _, ECon [Char]
    "Bool"]], SExpr
    r]) = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ SExpr -> Bool
    isTrue SExpr
    r
                     isEmpty     SExpr
    _                                                                               = Bool
    False

                     mbAssocs :: Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    mbAssocs = SExpr -> Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    parseSExprFunction SExpr
    setExpr

                     decode :: ([([SExpr], SExpr)], SExpr) -> RCSet CVal
    decode ([([SExpr], SExpr)]
    args, SExpr
    r) | SExpr -> Bool
    isTrue SExpr
    r = Set CVal -> RCSet CVal
    forall a. Set a -> RCSet a
    ComplementSet (Set CVal -> RCSet CVal) -> Set CVal -> RCSet CVal
    forall a b. (a -> b) -> a -> b
    $ [CVal] -> Set CVal
    forall a. Ord a => [a] -> Set a
    Set.fromList [CVal
    x | (CVal
    x, Bool
    False) <- (([SExpr], SExpr) -> [(CVal, Bool)])
    -> [([SExpr], SExpr)] -> [(CVal, Bool)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Bool -> ([SExpr], SExpr) -> [(CVal, Bool)]
    contents Bool
    True)  [([SExpr], SExpr)]
    args]  -- deletions from universal
                                      | Bool
    True     = Set CVal -> RCSet CVal
    forall a. Set a -> RCSet a
    RegularSet    (Set CVal -> RCSet CVal) -> Set CVal -> RCSet CVal
    forall a b. (a -> b) -> a -> b
    $ [CVal] -> Set CVal
    forall a. Ord a => [a] -> Set a
    Set.fromList [CVal
    x | (CVal
    x, Bool
    True)  <- (([SExpr], SExpr) -> [(CVal, Bool)])
    -> [([SExpr], SExpr)] -> [(CVal, Bool)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Bool -> ([SExpr], SExpr) -> [(CVal, Bool)]
    contents Bool
    False) [([SExpr], SExpr)]
    args]  -- additions to empty

                     contents :: Bool -> ([SExpr], SExpr) -> [(CVal, Bool)]
    contents Bool
    cvt ([SExpr
    v], SExpr
    r) = let t :: Bool
    t = SExpr -> Bool
    isTrue SExpr
    r in (CVal -> (CVal, Bool)) -> [CVal] -> [(CVal, Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map (, Bool
    t) (Bool -> SExpr -> [CVal]
    element Bool
    cvt SExpr
    v)
                     contents Bool
    _   ([SExpr], SExpr)
    bad      = [Char] -> [(CVal, Bool)]
    forall a. [Char] -> a
    tbd ([Char] -> [(CVal, Bool)]) -> [Char] -> [(CVal, Bool)]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Multi-valued set member seen: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([SExpr], SExpr) -> [Char]
    forall a. Show a => a -> [Char]
    show ([SExpr], SExpr)
    bad

                     element :: Bool -> SExpr -> [CVal]
    element Bool
    cvt SExpr
    x = case (Bool
    cvt, Kind
    ke) of
                                       (Bool
    True, Kind
    KChar) -> case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    KString SExpr
    x of
                                                          Just CV
    v  -> case CV -> CVal
    cvVal CV
    v of
                                                                      CString [Char
    c] -> [Char -> CVal
    CChar Char
    c]
                                                                      CString [Char]
    _   -> []
                                                                      CVal
    _           -> [Char] -> [CVal]
    forall a. [Char] -> a
    tbd ([Char] -> [CVal]) -> [Char] -> [CVal]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected value for kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (SExpr, Kind) -> [Char]
    forall a. Show a => a -> [Char]
    show (SExpr
    x, Kind
    ke)
                                                          Maybe CV
    Nothing -> [Char] -> [CVal]
    forall a. [Char] -> a
    tbd ([Char] -> [CVal]) -> [Char] -> [CVal]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected value for kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (SExpr, Kind) -> [Char]
    forall a. Show a => a -> [Char]
    show (SExpr
    x, Kind
    ke)
                                       (Bool, Kind)
    _             -> case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    ke SExpr
    x of
                                                          Just CV
    v  -> [CV -> CVal
    cvVal CV
    v]
                                                          Maybe CV
    Nothing -> [Char] -> [CVal]
    forall a. [Char] -> a
    tbd ([Char] -> [CVal]) -> [Char] -> [CVal]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected value for kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (SExpr, Kind) -> [Char]
    forall a. Show a => a -> [Char]
    show (SExpr
    x, Kind
    ke)

            interpretTuple :: SExpr -> [CVal]
    interpretTuple SExpr
    te = Int -> [Maybe CV] -> [CVal] -> [CVal]
    walk (Int
    1 :: Int) ((Kind -> SExpr -> Maybe CV) -> [Kind] -> [SExpr] -> [Maybe CV]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Kind -> SExpr -> Maybe CV
    recoverKindedValue [Kind]
    ks [SExpr]
    args) []
                    where ([Kind]
    ks, Int
    n) = case Kind
    k of
                                      KTuple [Kind]
    eks -> ([Kind]
    eks, [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    eks)
                                      Kind
    _          -> [Char] -> ([Kind], Int)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([Kind], Int)) -> [Char] -> ([Kind], Int)
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Impossible: Expected a tuple kind, but got: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    k
                                                                    , [Char]
    "While trying to parse: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    te
                                                                    ]

                          -- | Convert a sexpr of n-tuple to constituent sexprs. Z3 and CVC4 differ here on how they
                          -- present tuples, so we accommodate both:
                          args :: [SExpr]
    args = SExpr -> [SExpr]
    try SExpr
    te
                            where -- Z3 way
                                  try :: SExpr -> [SExpr]
    try (EApp (ECon [Char]
    f : [SExpr]
    as)) = case Int -> [Char] -> ([Char], [Char])
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Text -> Int
    T.length Text
    "mkSBVTuple") [Char]
    f of
                                                                 ([Char]
    "mkSBVTuple", [Char]
    c) | (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit [Char]
    c Bool -> Bool -> Bool
    && [Char] -> Int
    forall a. Read a => [Char] -> a
    read [Char]
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n Bool -> Bool -> Bool
    && [SExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SExpr]
    as Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n -> [SExpr]
    as
                                                                 ([Char], [Char])
    _  -> [SExpr]
    bad
                                  -- CVC4 way
                                  try  (EApp (EApp [ECon [Char]
    "as", ECon [Char]
    f, SExpr
    _] : [SExpr]
    as)) = SExpr -> [SExpr]
    try ([SExpr] -> SExpr
    EApp ([Char] -> SExpr
    ECon [Char]
    f SExpr -> [SExpr] -> [SExpr]
    forall a. a -> [a] -> [a]
    : [SExpr]
    as))
                                  try  SExpr
    _ = [SExpr]
    bad
                                  bad :: [SExpr]
    bad = [Char] -> [SExpr]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [SExpr]) -> [Char] -> [SExpr]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV.sexprToTuple: Impossible: Expected a constructor for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " tuple, but got: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    te

                          walk :: Int -> [Maybe CV] -> [CVal] -> [CVal]
    walk Int
    _ []           [CVal]
    sofar = [CVal] -> [CVal]
    forall a. [a] -> [a]
    reverse [CVal]
    sofar
                          walk Int
    i (Just CV
    el:[Maybe CV]
    es) [CVal]
    sofar = Int -> [Maybe CV] -> [CVal] -> [CVal]
    walk (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [Maybe CV]
    es (CV -> CVal
    cvVal CV
    el CVal -> [CVal] -> [CVal]
    forall a. a -> [a] -> [a]
    : [CVal]
    sofar)
                          walk Int
    i (Maybe CV
    Nothing:[Maybe CV]
    _)  [CVal]
    _     = [Char] -> [CVal]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [CVal]) -> [Char] -> [CVal]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Couldn't parse a tuple element at position " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i
                                                                      , [Char]
    "Kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    k
                                                                      , [Char]
    "Expr: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    te
                                                                      ]

            -- SMaybe
            interpretMaybe :: Kind -> SExpr -> Maybe CVal
    interpretMaybe (KMaybe Kind
    _)  (ECon [Char]
    "nothing_SBVMaybe")        = Maybe CVal
    forall a. Maybe a
    Nothing
            interpretMaybe (KMaybe Kind
    ek) (EApp [ECon [Char]
    "just_SBVMaybe", SExpr
    a]) = case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    ek SExpr
    a of
                                                                            Just (CV Kind
    _ CVal
    v) -> CVal -> Maybe CVal
    forall a. a -> Maybe a
    Just CVal
    v
                                                                            Maybe CV
    Nothing       -> [Char] -> Maybe CVal
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe CVal) -> [Char] -> Maybe CVal
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Couldn't parse a maybe just value"
                                                                                                             , [Char]
    "Kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    ek
                                                                                                             , [Char]
    "Expr: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    a
                                                                                                             ]
            -- CVC4 puts in full ascriptions, handle those:
            interpretMaybe Kind
    _  (      EApp [ECon [Char]
    "as", ECon [Char]
    "nothing_SBVMaybe", SExpr
    _])     = Maybe CVal
    forall a. Maybe a
    Nothing
            interpretMaybe Kind
    mk (EApp [EApp [ECon [Char]
    "as", ECon [Char]
    "just_SBVMaybe",    SExpr
    _], SExpr
    a]) = Kind -> SExpr -> Maybe CVal
    interpretMaybe Kind
    mk ([SExpr] -> SExpr
    EApp [[Char] -> SExpr
    ECon [Char]
    "just_SBVMaybe", SExpr
    a])

            interpretMaybe Kind
    _  SExpr
    other = [Char] -> Maybe CVal
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe CVal) -> [Char] -> Maybe CVal
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Expected an SMaybe sexpr, but received: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Kind, SExpr) -> [Char]
    forall a. Show a => a -> [Char]
    show (Kind
    k, SExpr
    other)

            -- SEither
            interpretEither :: Kind -> SExpr -> Either CVal CVal
    interpretEither (KEither Kind
    k1 Kind
    _) (EApp [ECon [Char]
    "left_SBVEither",  SExpr
    a]) = case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    k1 SExpr
    a of
                                                                                  Just (CV Kind
    _ CVal
    v) -> CVal -> Either CVal CVal
    forall a b. a -> Either a b
    Left CVal
    v
                                                                                  Maybe CV
    Nothing       -> [Char] -> Either CVal CVal
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either CVal CVal) -> [Char] -> Either CVal CVal
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Couldn't parse an either value on the left"
                                                                                                                   , [Char]
    "Kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    k1
                                                                                                                   , [Char]
    "Expr: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    a
                                                                                                                   ]
            interpretEither (KEither Kind
    _ Kind
    k2) (EApp [ECon [Char]
    "right_SBVEither", SExpr
    b]) = case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    k2 SExpr
    b of
                                                                                  Just (CV Kind
    _ CVal
    v) -> CVal -> Either CVal CVal
    forall a b. b -> Either a b
    Right CVal
    v
                                                                                  Maybe CV
    Nothing       -> [Char] -> Either CVal CVal
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either CVal CVal) -> [Char] -> Either CVal CVal
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Couldn't parse an either value on the right"
                                                                                                                   , [Char]
    "Kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    k2
                                                                                                                   , [Char]
    "Expr: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SExpr -> [Char]
    forall a. Show a => a -> [Char]
    show SExpr
    b
                                                                                                                   ]

            -- CVC4 puts full ascriptions:
            interpretEither Kind
    ek (EApp [EApp [ECon [Char]
    "as", ECon [Char]
    "left_SBVEither",  SExpr
    _], SExpr
    a]) = Kind -> SExpr -> Either CVal CVal
    interpretEither Kind
    ek ([SExpr] -> SExpr
    EApp [[Char] -> SExpr
    ECon [Char]
    "left_SBVEither", SExpr
    a])
            interpretEither Kind
    ek (EApp [EApp [ECon [Char]
    "as", ECon [Char]
    "right_SBVEither", SExpr
    _], SExpr
    b]) = Kind -> SExpr -> Either CVal CVal
    interpretEither Kind
    ek ([SExpr] -> SExpr
    EApp [[Char] -> SExpr
    ECon [Char]
    "right_SBVEither", SExpr
    b])

            interpretEither Kind
    _ SExpr
    other = [Char] -> Either CVal CVal
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either CVal CVal) -> [Char] -> Either CVal CVal
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Expected an SEither sexpr, but received: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Kind, SExpr) -> [Char]
    forall a. Show a => a -> [Char]
    show (Kind
    k, SExpr
    other)

            -- Intervals, for dReal
            interpretInterval :: SExpr -> Maybe CV
    interpretInterval SExpr
    expr = case SExpr
    expr of
                                       EApp [ECon [Char]
    "interval", SExpr
    lo, SExpr
    hi] -> do RealPoint Rational
    vlo <- SExpr -> Maybe (RealPoint Rational)
    getBorder SExpr
    lo
                                                                            RealPoint Rational
    vhi <- SExpr -> Maybe (RealPoint Rational)
    getBorder SExpr
    hi
                                                                            CV -> Maybe CV
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CV -> Maybe CV) -> CV -> Maybe CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KReal (AlgReal -> CVal
    CAlgReal (RealPoint Rational -> RealPoint Rational -> AlgReal
    AlgInterval RealPoint Rational
    vlo RealPoint Rational
    vhi))
                                       SExpr
    _                              -> Maybe CV
    forall a. Maybe a
    Nothing
              where getBorder :: SExpr -> Maybe (RealPoint Rational)
    getBorder (EApp [ECon [Char]
    "open",   SExpr
    v]) = Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    KReal SExpr
    v Maybe CV
    -> (CV -> Maybe (RealPoint Rational)) -> Maybe (RealPoint Rational)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Rational -> RealPoint Rational)
    -> CV -> Maybe (RealPoint Rational)
    forall {f :: * -> *} {a}.
    Applicative f =>
    (Rational -> a) -> CV -> f a
    border Rational -> RealPoint Rational
    forall a. a -> RealPoint a
    OpenPoint
                    getBorder (EApp [ECon [Char]
    "closed", SExpr
    v]) = Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    KReal SExpr
    v Maybe CV
    -> (CV -> Maybe (RealPoint Rational)) -> Maybe (RealPoint Rational)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Rational -> RealPoint Rational)
    -> CV -> Maybe (RealPoint Rational)
    forall {f :: * -> *} {a}.
    Applicative f =>
    (Rational -> a) -> CV -> f a
    border Rational -> RealPoint Rational
    forall a. a -> RealPoint a
    ClosedPoint
                    getBorder SExpr
    _                         = Maybe (RealPoint Rational)
    forall a. Maybe a
    Nothing

                    border :: (Rational -> a) -> CV -> f a
    border Rational -> a
    b (CV Kind
    KReal (CAlgReal (AlgRational Bool
    True Rational
    v))) = a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a -> f a) -> a -> f a
    forall a b. (a -> b) -> a -> b
    $ Rational -> a
    b Rational
    v
                    border Rational -> a
    _ CV
    other                                      = [Char] -> f a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> f a) -> [Char] -> f a
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV.interpretInterval.border: Expected a real-valued sexp, but received: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CV -> [Char]
    forall a. Show a => a -> [Char]
    show CV
    other

    -- | Generalization of 'Data.SBV.Control.getValueCV'
    getValueCV :: (MonadIO m, MonadQuery m) => Maybe Int -> SV -> m CV
    getValueCV :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    mbi SV
    s
      | SV -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SV
    s Kind -> Kind -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Kind
    KReal
      = Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCVHelper Maybe Int
    mbi SV
    s
      | Bool
    True
      = do SMTConfig
    cfg <- m SMTConfig
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig
           if Bool -> Bool
    not (SolverCapabilities -> Bool
    supportsApproxReals (SMTSolver -> SolverCapabilities
    capabilities (SMTConfig -> SMTSolver
    solver SMTConfig
    cfg)))
              then Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCVHelper Maybe Int
    mbi SV
    s
              else do Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True [Char]
    "(set-option :pp.decimal false)"
                      CV
    rep1 <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCVHelper Maybe Int
    mbi SV
    s
                      Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True   [Char]
    "(set-option :pp.decimal true)"
                      Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "(set-option :pp.decimal_precision " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (SMTConfig -> Int
    printRealPrec SMTConfig
    cfg) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                      CV
    rep2 <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCVHelper Maybe Int
    mbi SV
    s

                      let bad :: m CV
    bad = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m CV
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "getValueCV" [Char]
    "get-value" ([Char]
    "a real-valued binding for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    s) Maybe [[Char]]
    forall a. Maybe a
    Nothing ((CV, CV) -> [Char]
    forall a. Show a => a -> [Char]
    show (CV
    rep1, CV
    rep2)) Maybe [[Char]]
    forall a. Maybe a
    Nothing

                      case (CV
    rep1, CV
    rep2) of
                        (CV Kind
    KReal (CAlgReal AlgReal
    a), CV Kind
    KReal (CAlgReal AlgReal
    b)) -> CV -> m CV
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CV -> m CV) -> CV -> m CV
    forall a b. (a -> b) -> a -> b
    $ Kind -> CVal -> CV
    CV Kind
    KReal (AlgReal -> CVal
    CAlgReal ([Char] -> AlgReal -> AlgReal -> AlgReal
    mergeAlgReals ([Char]
    "Cannot merge real-values for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    s) AlgReal
    a AlgReal
    b))
                        (CV, CV)
    _                                              -> m CV
    bad

    -- | Retrieve value from the solver
    extractValue :: forall m. (MonadIO m, MonadQuery m) => Maybe Int -> String -> Kind -> m CV
    extractValue :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> [Char] -> Kind -> m CV
    extractValue Maybe Int
    mbi [Char]
    nm Kind
    k = do
           let modelIndex :: [Char]
    modelIndex = case Maybe Int
    mbi of
                              Maybe Int
    Nothing -> [Char]
    ""
                              Just Int
    i  -> [Char]
    " :model_index " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i

               cmd :: [Char]
    cmd        = [Char]
    "(get-value (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    modelIndex [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"

               bad :: [Char] -> Maybe [[Char]] -> m CV
    bad = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m CV
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "getModel" [Char]
    cmd ([Char]
    "a value binding for kind: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    forall a. Show a => a -> [Char]
    show Kind
    k) Maybe [[Char]]
    forall a. Maybe a
    Nothing

           [Char]
    r <- [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    cmd

           let recover :: SExpr -> m CV
    recover SExpr
    val = case Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    k SExpr
    val of
                               Just CV
    cv -> CV -> m CV
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CV
    cv
                               Maybe CV
    Nothing -> [Char] -> Maybe [[Char]] -> m CV
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

           [Char]
    -> ([Char] -> Maybe [[Char]] -> m CV) -> (SExpr -> m CV) -> m CV
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m CV
    bad ((SExpr -> m CV) -> m CV) -> (SExpr -> m CV) -> m CV
    forall a b. (a -> b) -> a -> b
    $ \case EApp [EApp [ECon [Char]
    v, SExpr
    val]] | [Char]
    v [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    nm -> SExpr -> m CV
    recover SExpr
    val
                               SExpr
    _                                   -> [Char] -> Maybe [[Char]] -> m CV
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

    -- | Generalization of 'Data.SBV.Control.getUICVal'
    getUICVal :: forall m. (MonadIO m, MonadQuery m) => Maybe Int -> (String, (Maybe [String], SBVType)) -> m CV
    getUICVal :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> ([Char], (Maybe [[Char]], SBVType)) -> m CV
    getUICVal Maybe Int
    mbi ([Char]
    nm, (Maybe [[Char]]
    _, SBVType
    t)) = case SBVType
    t of
                                  SBVType [Kind
    k] -> Maybe Int -> [Char] -> Kind -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> [Char] -> Kind -> m CV
    extractValue Maybe Int
    mbi [Char]
    nm Kind
    k
                                  SBVType
    _           -> [Char] -> m CV
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m CV) -> [Char] -> m CV
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "SBV.getUICVal: Expected to be called on an uninterpeted value of a base type, received something else: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([Char], SBVType) -> [Char]
    forall a. Show a => a -> [Char]
    show ([Char]
    nm, SBVType
    t)

    -- | Generalization of 'Data.SBV.Control.getUIFunCVAssoc'
    getUIFunCVAssoc :: forall m. (MonadIO m, MonadQuery m) => Maybe Int -> (String, (Maybe [String], SBVType)) -> m (Either String ([([CV], CV)], CV))
    getUIFunCVAssoc :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int
    -> ([Char], (Maybe [[Char]], SBVType))
    -> m (Either [Char] ([([CV], CV)], CV))
    getUIFunCVAssoc Maybe Int
    mbi ([Char]
    nm, (Maybe [[Char]]
    mbArgs, SBVType
    typ)) = do
      let modelIndex :: [Char]
    modelIndex = case Maybe Int
    mbi of
                         Maybe Int
    Nothing -> [Char]
    ""
                         Just Int
    i  -> [Char]
    " :model_index " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i

          cmd :: [Char]
    cmd        = [Char]
    "(get-value (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    modelIndex [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"

          bad :: [Char] -> Maybe [[Char]] -> m (Either [Char] ([([CV], CV)], CV))
    bad        = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m (Either [Char] ([([CV], CV)], CV))
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "get-value" [Char]
    cmd [Char]
    "a function value" Maybe [[Char]]
    forall a. Maybe a
    Nothing

      [Char]
    r <- [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    cmd

      let ([Kind]
    ats, Kind
    rt) = case SBVType
    typ of
                        SBVType [Kind]
    as | [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    as Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 -> ([Kind] -> [Kind]
    forall a. HasCallStack => [a] -> [a]
    init [Kind]
    as, [Kind] -> Kind
    forall a. HasCallStack => [a] -> a
    last [Kind]
    as)
                        SBVType
    _                          -> [Char] -> ([Kind], Kind)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([Kind], Kind)) -> [Char] -> ([Kind], Kind)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV.getUIFunCVAssoc: Expected a function type, got: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SBVType -> [Char]
    forall a. Show a => a -> [Char]
    show SBVType
    typ

      let convert :: ([([SExpr], SExpr)], SExpr) -> Maybe ([([CV], CV)], CV)
    convert ([([SExpr], SExpr)]
    vs, SExpr
    d) = (,) ([([CV], CV)] -> CV -> ([([CV], CV)], CV))
    -> Maybe [([CV], CV)] -> Maybe (CV -> ([([CV], CV)], CV))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([SExpr], SExpr) -> Maybe ([CV], CV))
    -> [([SExpr], SExpr)] -> Maybe [([CV], CV)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([SExpr], SExpr) -> Maybe ([CV], CV)
    toPoint [([SExpr], SExpr)]
    vs Maybe (CV -> ([([CV], CV)], CV))
    -> Maybe CV -> Maybe ([([CV], CV)], CV)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe CV
    toRes SExpr
    d
          toPoint :: ([SExpr], SExpr) -> Maybe ([CV], CV)
    toPoint ([SExpr]
    as, SExpr
    v)
             | [SExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SExpr]
    as Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    ats = (,) ([CV] -> CV -> ([CV], CV))
    -> Maybe [CV] -> Maybe (CV -> ([CV], CV))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Kind -> SExpr -> Maybe CV) -> [Kind] -> [SExpr] -> Maybe [CV]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Kind -> SExpr -> Maybe CV
    recoverKindedValue [Kind]
    ats [SExpr]
    as Maybe (CV -> ([CV], CV)) -> Maybe CV -> Maybe ([CV], CV)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SExpr -> Maybe CV
    toRes SExpr
    v
             | Bool
    True                    = [Char] -> Maybe ([CV], CV)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe ([CV], CV)) -> [Char] -> Maybe ([CV], CV)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV.getUIFunCVAssoc: Mismatching type/value arity, got: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([SExpr], [Kind]) -> [Char]
    forall a. Show a => a -> [Char]
    show ([SExpr]
    as, [Kind]
    ats)

          toRes :: SExpr -> Maybe CV
          toRes :: SExpr -> Maybe CV
    toRes = Kind -> SExpr -> Maybe CV
    recoverKindedValue Kind
    rt

          -- if we fail to parse, we'll return this answer as the string
          fallBack :: [Char]
    fallBack = [Char] -> [Char] -> Maybe [[Char]] -> [Char]
    trimFunctionResponse [Char]
    r [Char]
    nm Maybe [[Char]]
    mbArgs

          -- In case we end up in the pointwise scenario, boolify the result
          -- as that's the only type we support here.
          tryPointWise :: m (Either [Char] ([([CV], CV)], CV))
    tryPointWise = do Maybe ([([SExpr], SExpr)], SExpr)
    mbSExprs <- [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> SBVType -> m (Maybe ([([SExpr], SExpr)], SExpr))
    pointWiseExtract [Char]
    nm SBVType
    typ
                            case Maybe ([([SExpr], SExpr)], SExpr)
    mbSExprs of
                              Maybe ([([SExpr], SExpr)], SExpr)
    Nothing     -> Either [Char] ([([CV], CV)], CV)
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either [Char] ([([CV], CV)], CV)
     -> m (Either [Char] ([([CV], CV)], CV)))
    -> Either [Char] ([([CV], CV)], CV)
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Either [Char] ([([CV], CV)], CV)
    forall a b. a -> Either a b
    Left [Char]
    fallBack
                              Just ([([SExpr], SExpr)], SExpr)
    sExprs -> Either [Char] ([([CV], CV)], CV)
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either [Char] ([([CV], CV)], CV)
     -> m (Either [Char] ([([CV], CV)], CV)))
    -> Either [Char] ([([CV], CV)], CV)
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a b. (a -> b) -> a -> b
    $ Either [Char] ([([CV], CV)], CV)
    -> (([([CV], CV)], CV) -> Either [Char] ([([CV], CV)], CV))
    -> Maybe ([([CV], CV)], CV)
    -> Either [Char] ([([CV], CV)], CV)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> Either [Char] ([([CV], CV)], CV)
    forall a b. a -> Either a b
    Left [Char]
    fallBack) ([([CV], CV)], CV) -> Either [Char] ([([CV], CV)], CV)
    forall a b. b -> Either a b
    Right (([([SExpr], SExpr)], SExpr) -> Maybe ([([CV], CV)], CV)
    convert ([([SExpr], SExpr)], SExpr)
    sExprs)

      [Char]
    -> ([Char]
        -> Maybe [[Char]] -> m (Either [Char] ([([CV], CV)], CV)))
    -> (SExpr -> m (Either [Char] ([([CV], CV)], CV)))
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m (Either [Char] ([([CV], CV)], CV))
    bad ((SExpr -> m (Either [Char] ([([CV], CV)], CV)))
     -> m (Either [Char] ([([CV], CV)], CV)))
    -> (SExpr -> m (Either [Char] ([([CV], CV)], CV)))
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a b. (a -> b) -> a -> b
    $ \case EApp [EApp [ECon [Char]
    o, SExpr
    e]] | [Char]
    o [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    nm -> case SExpr -> Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    parseSExprFunction SExpr
    e of
                                                                 Just (Right ([([SExpr], SExpr)], SExpr)
    assocs) | Just ([([CV], CV)], CV)
    res <- ([([SExpr], SExpr)], SExpr) -> Maybe ([([CV], CV)], CV)
    convert ([([SExpr], SExpr)], SExpr)
    assocs                 -> Either [Char] ([([CV], CV)], CV)
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([([CV], CV)], CV) -> Either [Char] ([([CV], CV)], CV)
    forall a b. b -> Either a b
    Right ([([CV], CV)], CV)
    res)
                                                                                     | Bool
    True                                       -> m (Either [Char] ([([CV], CV)], CV))
    tryPointWise

                                                                 Just (Left [Char]
    nm')     | [Char]
    nm [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    nm', let res :: CV
    res = Kind -> CV
    defaultKindedValue Kind
    rt -> Either [Char] ([([CV], CV)], CV)
    -> m (Either [Char] ([([CV], CV)], CV))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([([CV], CV)], CV) -> Either [Char] ([([CV], CV)], CV)
    forall a b. b -> Either a b
    Right ([], CV
    res))
                                                                                     | Bool
    True                                       -> [Char] -> Maybe [[Char]] -> m (Either [Char] ([([CV], CV)], CV))
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

                                                                 Maybe (Either [Char] ([([SExpr], SExpr)], SExpr))
    Nothing                                                          -> m (Either [Char] ([([CV], CV)], CV))
    tryPointWise

                          SExpr
    _                                 -> [Char] -> Maybe [[Char]] -> m (Either [Char] ([([CV], CV)], CV))
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

    -- | Generalization of 'Data.SBV.Control.checkSat'
    checkSat :: (MonadIO m, MonadQuery m) => m CheckSatResult
    checkSat :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => m CheckSatResult
    checkSat = do SMTConfig
    cfg <- m SMTConfig
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig
                  [Char] -> m CheckSatResult
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m CheckSatResult
    checkSatUsing ([Char] -> m CheckSatResult) -> [Char] -> m CheckSatResult
    forall a b. (a -> b) -> a -> b
    $ SMTConfig -> [Char]
    satCmd SMTConfig
    cfg

    -- | Generalization of 'Data.SBV.Control.checkSatUsing'
    checkSatUsing :: (MonadIO m, MonadQuery m) => String -> m CheckSatResult
    checkSatUsing :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m CheckSatResult
    checkSatUsing [Char]
    cmd = do let bad :: [Char] -> Maybe [[Char]] -> m CheckSatResult
    bad = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m CheckSatResult
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "checkSat" [Char]
    cmd [Char]
    "one of sat/unsat/unknown" Maybe [[Char]]
    forall a. Maybe a
    Nothing

                               -- Sigh.. Ignore some of the pesky warnings. We only do it as an exception here.
                               ignoreList :: [[Char]]
    ignoreList = [[Char]
    "WARNING: optimization with quantified constraints is not supported"]

                           [Char]
    r <- [Char] -> [[Char]] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> [[Char]] -> m [Char]
    askIgnoring [Char]
    cmd [[Char]]
    ignoreList

                           -- query for the precision if supported
                           let getPrecision :: m (Maybe [Char])
    getPrecision = do SMTConfig
    cfg <- m SMTConfig
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig
                                                 case SolverCapabilities -> Maybe [Char]
    supportsDeltaSat (SMTSolver -> SolverCapabilities
    capabilities (SMTConfig -> SMTSolver
    solver SMTConfig
    cfg)) of
                                                   Maybe [Char]
    Nothing -> Maybe [Char] -> m (Maybe [Char])
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe [Char]
    forall a. Maybe a
    Nothing
                                                   Just [Char]
    o  -> [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> m [Char] -> m (Maybe [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    o

                           [Char]
    -> ([Char] -> Maybe [[Char]] -> m CheckSatResult)
    -> (SExpr -> m CheckSatResult)
    -> m CheckSatResult
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m CheckSatResult
    bad ((SExpr -> m CheckSatResult) -> m CheckSatResult)
    -> (SExpr -> m CheckSatResult) -> m CheckSatResult
    forall a b. (a -> b) -> a -> b
    $ \case ECon [Char]
    "sat"       -> CheckSatResult -> m CheckSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CheckSatResult
    Sat
                                               ECon [Char]
    "unsat"     -> CheckSatResult -> m CheckSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CheckSatResult
    Unsat
                                               ECon [Char]
    "unknown"   -> CheckSatResult -> m CheckSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CheckSatResult
    Unk
                                               ECon [Char]
    "delta-sat" -> Maybe [Char] -> CheckSatResult
    DSat (Maybe [Char] -> CheckSatResult)
    -> m (Maybe [Char]) -> m CheckSatResult
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m (Maybe [Char])
    getPrecision
                                               SExpr
    _                -> [Char] -> Maybe [[Char]] -> m CheckSatResult
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

    -- | What are the top level inputs? Trackers are returned as top level existentials
    getTopLevelInputs :: (MonadIO m, MonadQuery m) => m UserInputs
    getTopLevelInputs :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => m UserInputs
    getTopLevelInputs = do State{IORef Inputs
    rinps :: IORef Inputs
    rinps :: State -> IORef Inputs
    rinps}                     <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                           Inputs{UserInputs
    userInputs :: UserInputs
    userInputs :: Inputs -> UserInputs
    userInputs, UserInputs
    internInputs :: UserInputs
    internInputs :: Inputs -> UserInputs
    internInputs} <- IO Inputs -> m Inputs
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Inputs -> m Inputs) -> IO Inputs -> m Inputs
    forall a b. (a -> b) -> a -> b
    $ IORef Inputs -> IO Inputs
    forall a. IORef a -> IO a
    readIORef IORef Inputs
    rinps

                           UserInputs -> m UserInputs
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (UserInputs -> m UserInputs) -> UserInputs -> m UserInputs
    forall a b. (a -> b) -> a -> b
    $ UserInputs
    userInputs UserInputs -> UserInputs -> UserInputs
    forall a. Semigroup a => a -> a -> a
    <> UserInputs
    internInputs

    -- | Get observables, i.e., those explicitly labeled by the user with a call to 'Data.SBV.observe'.
    getObservables :: (MonadIO m, MonadQuery m) => m [(Name, CV)]
    getObservables :: forall (m :: * -> *). (MonadIO m, MonadQuery m) => m [(Text, CV)]
    getObservables = do State{IORef (Seq (Text, CV -> Bool, SV))
    rObservables :: IORef (Seq (Text, CV -> Bool, SV))
    rObservables :: State -> IORef (Seq (Text, CV -> Bool, SV))
    rObservables} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState

                        Seq (Text, CV -> Bool, SV)
    rObs <- IO (Seq (Text, CV -> Bool, SV)) -> m (Seq (Text, CV -> Bool, SV))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Seq (Text, CV -> Bool, SV)) -> m (Seq (Text, CV -> Bool, SV)))
    -> IO (Seq (Text, CV -> Bool, SV))
    -> m (Seq (Text, CV -> Bool, SV))
    forall a b. (a -> b) -> a -> b
    $ IORef (Seq (Text, CV -> Bool, SV))
    -> IO (Seq (Text, CV -> Bool, SV))
    forall a. IORef a -> IO a
    readIORef IORef (Seq (Text, CV -> Bool, SV))
    rObservables

                        -- This intentionally reverses the result; since 'rObs' stores in reversed order
                        let walk :: [(a, CV -> Bool, SV)] -> [(a, CV)] -> m [(a, CV)]
    walk []             ![(a, CV)]
    sofar = [(a, CV)] -> m [(a, CV)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(a, CV)]
    sofar
                            walk ((a
    n, CV -> Bool
    f, SV
    s):[(a, CV -> Bool, SV)]
    os) ![(a, CV)]
    sofar = do CV
    cv <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    forall a. Maybe a
    Nothing SV
    s
                                                            if CV -> Bool
    f CV
    cv
                                                              then [(a, CV -> Bool, SV)] -> [(a, CV)] -> m [(a, CV)]
    walk [(a, CV -> Bool, SV)]
    os ((a
    n, CV
    cv) (a, CV) -> [(a, CV)] -> [(a, CV)]
    forall a. a -> [a] -> [a]
    : [(a, CV)]
    sofar)
                                                              else [(a, CV -> Bool, SV)] -> [(a, CV)] -> m [(a, CV)]
    walk [(a, CV -> Bool, SV)]
    os            [(a, CV)]
    sofar

                        [(Text, CV -> Bool, SV)] -> [(Text, CV)] -> m [(Text, CV)]
    forall {m :: * -> *} {a}.
    (MonadIO m, MonadQuery m) =>
    [(a, CV -> Bool, SV)] -> [(a, CV)] -> m [(a, CV)]
    walk (Seq (Text, CV -> Bool, SV) -> [(Text, CV -> Bool, SV)]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList Seq (Text, CV -> Bool, SV)
    rObs) []

    -- | Get UIs, both constants and functions. This call returns both the before and after query ones.
    -- Generalization of 'Data.SBV.Control.getUIs'.
    getUIs :: forall m. (MonadIO m, MonadQuery m) => m [(String, (Maybe [String], SBVType))]
    getUIs :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    m [([Char], (Maybe [[Char]], SBVType))]
    getUIs = do State{IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap :: State -> IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap :: IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap, IORef [SMTDef]
    rDefns :: IORef [SMTDef]
    rDefns :: State -> IORef [SMTDef]
    rDefns, IORef IncState
    rIncState :: IORef IncState
    rIncState :: State -> IORef IncState
    rIncState} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState
                -- NB. no need to worry about new-defines, because we don't allow definitions once query mode starts
                [[Char]]
    defines <- do [SMTDef]
    allDefs <- IO [SMTDef] -> m [SMTDef]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [SMTDef] -> m [SMTDef]) -> IO [SMTDef] -> m [SMTDef]
    forall a b. (a -> b) -> a -> b
    $ IORef [SMTDef] -> IO [SMTDef]
    forall a. IORef a -> IO a
    readIORef IORef [SMTDef]
    rDefns
                              [[Char]] -> m [[Char]]
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
    forall a b. (a -> b) -> a -> b
    $ (SMTDef -> Maybe [Char]) -> [SMTDef] -> [[Char]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe SMTDef -> Maybe [Char]
    smtDefGivenName [SMTDef]
    allDefs

                Map [Char] (Maybe [[Char]], SBVType)
    prior <- IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Map [Char] (Maybe [[Char]], SBVType))
     -> m (Map [Char] (Maybe [[Char]], SBVType)))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall a b. (a -> b) -> a -> b
    $ IORef (Map [Char] (Maybe [[Char]], SBVType))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IORef a -> IO a
    readIORef IORef (Map [Char] (Maybe [[Char]], SBVType))
    rUIMap
                Map [Char] (Maybe [[Char]], SBVType)
    new   <- IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Map [Char] (Maybe [[Char]], SBVType))
     -> m (Map [Char] (Maybe [[Char]], SBVType)))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    -> m (Map [Char] (Maybe [[Char]], SBVType))
    forall a b. (a -> b) -> a -> b
    $ IORef IncState -> IO IncState
    forall a. IORef a -> IO a
    readIORef IORef IncState
    rIncState IO IncState
    -> (IncState -> IO (Map [Char] (Maybe [[Char]], SBVType)))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IORef (Map [Char] (Maybe [[Char]], SBVType))
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall a. IORef a -> IO a
    readIORef (IORef (Map [Char] (Maybe [[Char]], SBVType))
     -> IO (Map [Char] (Maybe [[Char]], SBVType)))
    -> (IncState -> IORef (Map [Char] (Maybe [[Char]], SBVType)))
    -> IncState
    -> IO (Map [Char] (Maybe [[Char]], SBVType))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IncState -> IORef (Map [Char] (Maybe [[Char]], SBVType))
    rNewUIs
                [([Char], (Maybe [[Char]], SBVType))]
    -> m [([Char], (Maybe [[Char]], SBVType))]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([([Char], (Maybe [[Char]], SBVType))]
     -> m [([Char], (Maybe [[Char]], SBVType))])
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> m [([Char], (Maybe [[Char]], SBVType))]
    forall a b. (a -> b) -> a -> b
    $ [([Char], (Maybe [[Char]], SBVType))]
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall a. Eq a => [a] -> [a]
    nub ([([Char], (Maybe [[Char]], SBVType))]
     -> [([Char], (Maybe [[Char]], SBVType))])
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall a b. (a -> b) -> a -> b
    $ [([Char], (Maybe [[Char]], SBVType))]
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall a. Ord a => [a] -> [a]
    sort [([Char], (Maybe [[Char]], SBVType))
    p | p :: ([Char], (Maybe [[Char]], SBVType))
    p@([Char]
    n, (Maybe [[Char]], SBVType)
    _) <- Map [Char] (Maybe [[Char]], SBVType)
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map [Char] (Maybe [[Char]], SBVType)
    prior [([Char], (Maybe [[Char]], SBVType))]
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall a. [a] -> [a] -> [a]
    ++ Map [Char] (Maybe [[Char]], SBVType)
    -> [([Char], (Maybe [[Char]], SBVType))]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map [Char] (Maybe [[Char]], SBVType)
    new, [Char]
    n [Char] -> [[Char]] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [[Char]]
    defines]

    -- | Return all satisfying models.
    getAllSatResult :: forall m. (MonadIO m, MonadQuery m, SolverContext m) => m AllSatResult
    getAllSatResult :: forall (m :: * -> *).
    (MonadIO m, MonadQuery m, SolverContext m) =>
    m AllSatResult
    getAllSatResult = do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** Checking Satisfiability, all solutions.."]

                         SMTConfig
    cfg <- m SMTConfig
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig
                         Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (SolverCapabilities -> Bool
    supportsCustomQueries (SMTSolver -> SolverCapabilities
    capabilities (SMTConfig -> SMTSolver
    solver SMTConfig
    cfg))) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                            [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                            , [Char]
    "*** Data.SBV: Backend solver " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Solver -> [Char]
    forall a. Show a => a -> [Char]
    show (SMTSolver -> Solver
    name (SMTConfig -> SMTSolver
    solver SMTConfig
    cfg)) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " does not support custom queries."
                                            , [Char]
    "***"
                                            , [Char]
    "*** Custom query support is needed for allSat functionality."
                                            , [Char]
    "*** Please use a solver that supports this feature."
                                            ]

                         topState :: State
    topState@State{IORef KindSet
    rUsedKinds :: IORef KindSet
    rUsedKinds :: State -> IORef KindSet
    rUsedKinds} <- m State
    forall (m :: * -> *). MonadQuery m => m State
    queryState

                         KindSet
    ki   <- IO KindSet -> m KindSet
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO KindSet -> m KindSet) -> IO KindSet -> m KindSet
    forall a b. (a -> b) -> a -> b
    $ IORef KindSet -> IO KindSet
    forall a. IORef a -> IO a
    readIORef IORef KindSet
    rUsedKinds

                         UserInputs
    allModelInputs    <- m UserInputs
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m UserInputs
    getTopLevelInputs
                         [([Char], (Maybe [[Char]], SBVType))]
    allUninterpreteds <- m [([Char], (Maybe [[Char]], SBVType))]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    m [([Char], (Maybe [[Char]], SBVType))]
    getUIs

                          -- Functions have at least two kinds in their type and all components must be "interpreted"
                         let allUiFuns :: [([Char], (Maybe [[Char]], SBVType))]
    allUiFuns = [([Char], (Maybe [[Char]], SBVType))
    u | SMTConfig -> Bool
    allSatTrackUFs SMTConfig
    cfg                                           -- config says consider UIFs
                                            , u :: ([Char], (Maybe [[Char]], SBVType))
    u@([Char]
    nm, (Maybe [[Char]]
    _, SBVType [Kind]
    as)) <- [([Char], (Maybe [[Char]], SBVType))]
    allUninterpreteds, [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    as Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1  -- get the function ones
                                            , Bool -> Bool
    not (SMTConfig -> [Char] -> Bool
    mustIgnoreVar SMTConfig
    cfg [Char]
    nm)                                    -- make sure they aren't explicitly ignored
                                         ]

                             allUiRegs :: [([Char], (Maybe [[Char]], SBVType))]
    allUiRegs = [([Char], (Maybe [[Char]], SBVType))
    u | u :: ([Char], (Maybe [[Char]], SBVType))
    u@([Char]
    nm, (Maybe [[Char]]
    _, SBVType [Kind]
    as)) <- [([Char], (Maybe [[Char]], SBVType))]
    allUninterpreteds, [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    as Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 -- non-function ones
                                            , Bool -> Bool
    not (SMTConfig -> [Char] -> Bool
    mustIgnoreVar SMTConfig
    cfg [Char]
    nm)                                   -- make sure they aren't explicitly ignored
                                         ]

                             -- We can only "allSat" if all component types themselves are interpreted. (Otherwise
                             -- there is no way to reflect back the values to the solver.)
                             collectAcceptable :: [([Char], (a, SBVType))] -> [[Char]] -> m [[Char]]
    collectAcceptable []                                [[Char]]
    sofar = [[Char]] -> m [[Char]]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Char]]
    sofar
                             collectAcceptable (([Char]
    nm, (a
    _, t :: SBVType
    t@(SBVType [Kind]
    ats))):[([Char], (a, SBVType))]
    rest) [[Char]]
    sofar
                               | Bool -> Bool
    not ((Kind -> Bool) -> [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Kind -> Bool
    hasUninterpretedSorts [Kind]
    ats)
                               = [([Char], (a, SBVType))] -> [[Char]] -> m [[Char]]
    collectAcceptable [([Char], (a, SBVType))]
    rest ([Char]
    nm [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    sofar)
                               | Bool
    True
                               = do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [ [Char]
    "*** SBV.allSat: Uninterpreted function: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " :: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SBVType -> [Char]
    forall a. Show a => a -> [Char]
    show SBVType
    t
                                               , [Char]
    "*** Will *not* be used in allSat considerations since its type"
                                               , [Char]
    "*** has uninterpreted sorts present."
                                               ]
                                    [([Char], (a, SBVType))] -> [[Char]] -> m [[Char]]
    collectAcceptable [([Char], (a, SBVType))]
    rest [[Char]]
    sofar

                         [[Char]]
    uiFuns <- [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse ([[Char]] -> [[Char]]) -> m [[Char]] -> m [[Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [([Char], (Maybe [[Char]], SBVType))] -> [[Char]] -> m [[Char]]
    forall {m :: * -> *} {a}.
    (MonadIO m, MonadQuery m) =>
    [([Char], (a, SBVType))] -> [[Char]] -> m [[Char]]
    collectAcceptable [([Char], (Maybe [[Char]], SBVType))]
    allUiFuns []
                         [[Char]]
    _      <- [([Char], (Maybe [[Char]], SBVType))] -> [[Char]] -> m [[Char]]
    forall {m :: * -> *} {a}.
    (MonadIO m, MonadQuery m) =>
    [([Char], (a, SBVType))] -> [[Char]] -> m [[Char]]
    collectAcceptable [([Char], (Maybe [[Char]], SBVType))]
    allUiRegs [] -- only done to get the queryDebug output. Actual result not needed/used

                         -- If there are uninterpreted functions, arrange so that z3's pretty-printer flattens things out
                         -- as cex's tend to get larger
                         Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    uiFuns) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                            let solverCaps :: SolverCapabilities
    solverCaps = SMTSolver -> SolverCapabilities
    capabilities (SMTConfig -> SMTSolver
    solver SMTConfig
    cfg)
                            in case SolverCapabilities -> Maybe [[Char]]
    supportsFlattenedModels SolverCapabilities
    solverCaps of
                                 Maybe [[Char]]
    Nothing   -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                 Just [[Char]]
    cmds -> ([Char] -> m ()) -> [[Char]] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True) [[Char]]
    cmds

                         let usorts :: [[Char]]
    usorts = [[Char]
    s | us :: Kind
    us@(KUserSort [Char]
    s Maybe [[Char]]
    _) <- KindSet -> [Kind]
    forall a. Set a -> [a]
    Set.toAscList KindSet
    ki, Kind -> Bool
    isFree Kind
    us]

                         Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    usorts) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [ [Char]
    "*** SBV.allSat: Uninterpreted sorts present: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unwords [[Char]]
    usorts
                                                           , [Char]
    "***             SBV will use equivalence classes to generate all-satisfying instances."
                                                           ]

                         -- Drop the things that are not model vars or internal
                         let vars :: S.Seq (SVal, NamedSymVar)
                             vars :: Seq (SVal, NamedSymVar)
    vars = let mkSVal :: NamedSymVar -> (SVal, NamedSymVar)
    mkSVal nm :: NamedSymVar
    nm@(NamedSymVar -> SV
    getSV -> SV
    sv) = (Kind -> Either CV (Cached SV) -> SVal
    SVal (SV -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SV
    sv) (Cached SV -> Either CV (Cached SV)
    forall a b. b -> Either a b
    Right ((State -> IO SV) -> Cached SV
    forall a. (State -> IO a) -> Cached a
    cache (IO SV -> State -> IO SV
    forall a b. a -> b -> a
    const (SV -> IO SV
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SV
    sv)))), NamedSymVar
    nm)

                                        ignored :: NamedSymVar -> Bool
    ignored NamedSymVar
    k = SMTConfig -> [Char] -> Bool
    mustIgnoreVar SMTConfig
    cfg (NamedSymVar -> [Char]
    getUserName' NamedSymVar
    k)

                                    in NamedSymVar -> (SVal, NamedSymVar)
    mkSVal (NamedSymVar -> (SVal, NamedSymVar))
    -> UserInputs -> Seq (SVal, NamedSymVar)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (NamedSymVar -> Bool) -> UserInputs -> UserInputs
    forall a. (a -> Bool) -> Seq a -> Seq a
    S.filter (Bool -> Bool
    not (Bool -> Bool) -> (NamedSymVar -> Bool) -> NamedSymVar -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedSymVar -> Bool
    ignored) UserInputs
    allModelInputs

                         -- We can go fast using the disjoint model trick if things are simple enough:
                         --     - No uninterpreted functions (uninterpreted values are OK)
                         --     - No uninterpreted sorts
                         --
                         -- Why can't we support the above?
                         --     - Uninterpreted functions: There is no (standard) way to define a function as a literal in SMTLib.
                         --     Some solvers support lambda, but this isn't common/reliable yet.
                         --     - Uninterpreted sort: There's no way to access the value the solver assigns to an uninterpreted sort.
                         --
                         -- So, if these two things are present, we go the "slow" route, by repeatedly rejecting the
                         -- previous model and asking for a new one. If they don't exist (which is the common case anyhow)
                         -- we use an idea due to z3 folks <http://theory.stanford.edu/%7Enikolaj/programmingz3.html#sec-blocking-evaluations>
                         -- which splits the search space into disjoint models and can produce results much more quickly.
                         let isSimple :: Bool
    isSimple = [([Char], (Maybe [[Char]], SBVType))] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [([Char], (Maybe [[Char]], SBVType))]
    allUiFuns Bool -> Bool -> Bool
    && [[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    usorts

                             start :: AllSatResult
    start = AllSatResult { allSatMaxModelCountReached :: Bool
    allSatMaxModelCountReached  = Bool
    False
                                                  , allSatSolverReturnedUnknown :: Bool
    allSatSolverReturnedUnknown = Bool
    False
                                                  , allSatSolverReturnedDSat :: Bool
    allSatSolverReturnedDSat    = Bool
    False
                                                  , allSatResults :: [SMTResult]
    allSatResults               = []
                                                  }

                         if Bool
    isSimple
                            then do let mkVar :: (String, (Maybe [String], SBVType)) -> IO (SVal, NamedSymVar)
                                        mkVar :: ([Char], (Maybe [[Char]], SBVType)) -> IO (SVal, NamedSymVar)
    mkVar ([Char]
    nm, (Maybe [[Char]]
    _, SBVType [Kind
    k])) = do SV
    sv <- State -> Kind -> SBVExpr -> IO SV
    newExpr State
    topState Kind
    k (Op -> [SV] -> SBVExpr
    SBVApp ([Char] -> Op
    Uninterpreted [Char]
    nm) [])
                                                                          let sval :: SVal
    sval = Kind -> Either CV (Cached SV) -> SVal
    SVal Kind
    k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
    forall a b. (a -> b) -> a -> b
    $ Cached SV -> Either CV (Cached SV)
    forall a b. b -> Either a b
    Right (Cached SV -> Either CV (Cached SV))
    -> Cached SV -> Either CV (Cached SV)
    forall a b. (a -> b) -> a -> b
    $ (State -> IO SV) -> Cached SV
    forall a. (State -> IO a) -> Cached a
    cache ((State -> IO SV) -> Cached SV) -> (State -> IO SV) -> Cached SV
    forall a b. (a -> b) -> a -> b
    $ \State
    _ -> SV -> IO SV
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SV
    sv
                                                                              nsv :: NamedSymVar
    nsv  = SV -> Text -> NamedSymVar
    NamedSymVar SV
    sv ([Char] -> Text
    T.pack [Char]
    nm)
                                                                          (SVal, NamedSymVar) -> IO (SVal, NamedSymVar)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SVal
    sval, NamedSymVar
    nsv)
                                        mkVar ([Char], (Maybe [[Char]], SBVType))
    nmt = [Char] -> IO (SVal, NamedSymVar)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO (SVal, NamedSymVar))
    -> [Char] -> IO (SVal, NamedSymVar)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV: Impossible happened; allSat.mkVar. Unexpected: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([Char], (Maybe [[Char]], SBVType)) -> [Char]
    forall a. Show a => a -> [Char]
    show ([Char], (Maybe [[Char]], SBVType))
    nmt
                                    Seq (SVal, NamedSymVar)
    uiVars <- IO (Seq (SVal, NamedSymVar)) -> m (Seq (SVal, NamedSymVar))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Seq (SVal, NamedSymVar)) -> m (Seq (SVal, NamedSymVar)))
    -> IO (Seq (SVal, NamedSymVar)) -> m (Seq (SVal, NamedSymVar))
    forall a b. (a -> b) -> a -> b
    $ [(SVal, NamedSymVar)] -> Seq (SVal, NamedSymVar)
    forall a. [a] -> Seq a
    S.fromList ([(SVal, NamedSymVar)] -> Seq (SVal, NamedSymVar))
    -> IO [(SVal, NamedSymVar)] -> IO (Seq (SVal, NamedSymVar))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([Char], (Maybe [[Char]], SBVType)) -> IO (SVal, NamedSymVar))
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> IO [(SVal, NamedSymVar)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([Char], (Maybe [[Char]], SBVType)) -> IO (SVal, NamedSymVar)
    mkVar [([Char], (Maybe [[Char]], SBVType))]
    allUiRegs
                                    UserInputs
    -> Seq (SVal, NamedSymVar)
    -> SMTConfig
    -> AllSatResult
    -> m AllSatResult
    fastAllSat                                        UserInputs
    allModelInputs (Seq (SVal, NamedSymVar)
    uiVars Seq (SVal, NamedSymVar)
    -> Seq (SVal, NamedSymVar) -> Seq (SVal, NamedSymVar)
    forall a. Seq a -> Seq a -> Seq a
    S.>< Seq (SVal, NamedSymVar)
    vars) SMTConfig
    cfg AllSatResult
    start
                            else    State
    -> ([([Char], (Maybe [[Char]], SBVType))], [[Char]])
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> UserInputs
    -> Seq (SVal, NamedSymVar)
    -> SMTConfig
    -> AllSatResult
    -> m AllSatResult
    loop       State
    topState ([([Char], (Maybe [[Char]], SBVType))]
    allUiFuns, [[Char]]
    uiFuns) [([Char], (Maybe [[Char]], SBVType))]
    allUiRegs UserInputs
    allModelInputs              Seq (SVal, NamedSymVar)
    vars  SMTConfig
    cfg AllSatResult
    start

       where isFree :: Kind -> Bool
    isFree (KUserSort [Char]
    _ Maybe [[Char]]
    Nothing) = Bool
    True
             isFree Kind
    _                     = Bool
    False

             finalize :: a -> SMTConfig -> AllSatResult -> Maybe [Char] -> f ()
    finalize a
    cnt SMTConfig
    cfg AllSatResult
    sofar Maybe [Char]
    extra
                    = Bool -> f () -> f ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SMTConfig -> Bool
    allSatPrintAlong SMTConfig
    cfg Bool -> Bool -> Bool
    && Bool -> Bool
    not ([SMTResult] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (AllSatResult -> [SMTResult]
    allSatResults AllSatResult
    sofar))) (f () -> f ()) -> f () -> f ()
    forall a b. (a -> b) -> a -> b
    $ do
                               let msg :: a -> [Char]
    msg a
    0 = [Char]
    "No solutions found."
                                   msg a
    1 = [Char]
    "This is the only solution."
                                   msg a
    n = [Char]
    "Found " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    n [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " different solutions."
                               IO () -> f ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> f ()) -> ([Char] -> IO ()) -> [Char] -> f ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> IO ()
    putStrLn ([Char] -> f ()) -> [Char] -> f ()
    forall a b. (a -> b) -> a -> b
    $ a -> [Char]
    forall {a}. (Eq a, Num a, Show a) => a -> [Char]
    msg (a
    cnt a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1)
                               case Maybe [Char]
    extra of
                                 Maybe [Char]
    Nothing -> () -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                                 Just [Char]
    m  -> IO () -> f ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> f ()) -> IO () -> f ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    m

             fastAllSat :: S.Seq NamedSymVar -> S.Seq (SVal, NamedSymVar) -> SMTConfig -> AllSatResult -> m AllSatResult
             fastAllSat :: UserInputs
    -> Seq (SVal, NamedSymVar)
    -> SMTConfig
    -> AllSatResult
    -> m AllSatResult
    fastAllSat UserInputs
    allInputs Seq (SVal, NamedSymVar)
    vars SMTConfig
    cfg AllSatResult
    start = do
                    IORef (Int, AllSatResult, Bool, Maybe [Char])
    result <- IO (IORef (Int, AllSatResult, Bool, Maybe [Char]))
    -> m (IORef (Int, AllSatResult, Bool, Maybe [Char]))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (IORef (Int, AllSatResult, Bool, Maybe [Char]))
     -> m (IORef (Int, AllSatResult, Bool, Maybe [Char])))
    -> IO (IORef (Int, AllSatResult, Bool, Maybe [Char]))
    -> m (IORef (Int, AllSatResult, Bool, Maybe [Char]))
    forall a b. (a -> b) -> a -> b
    $ (Int, AllSatResult, Bool, Maybe [Char])
    -> IO (IORef (Int, AllSatResult, Bool, Maybe [Char]))
    forall a. a -> IO (IORef a)
    newIORef (Int
    0, AllSatResult
    start, Bool
    False, Maybe [Char]
    forall a. Maybe a
    Nothing)
                    IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> Seq (SVal, NamedSymVar) -> m ()
    go IORef (Int, AllSatResult, Bool, Maybe [Char])
    result Seq (SVal, NamedSymVar)
    vars
                    (Int
    found, AllSatResult
    sofar, Bool
    _, Maybe [Char]
    extra) <- IO (Int, AllSatResult, Bool, Maybe [Char])
    -> m (Int, AllSatResult, Bool, Maybe [Char])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Int, AllSatResult, Bool, Maybe [Char])
     -> m (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO (Int, AllSatResult, Bool, Maybe [Char])
    -> m (Int, AllSatResult, Bool, Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> IO (Int, AllSatResult, Bool, Maybe [Char])
    forall a. IORef a -> IO a
    readIORef IORef (Int, AllSatResult, Bool, Maybe [Char])
    result
                    Int -> SMTConfig -> AllSatResult -> Maybe [Char] -> m ()
    forall {f :: * -> *} {a}.
    (Eq a, Num a, Show a, MonadIO f) =>
    a -> SMTConfig -> AllSatResult -> Maybe [Char] -> f ()
    finalize (Int
    foundInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) SMTConfig
    cfg AllSatResult
    sofar Maybe [Char]
    extra
                    AllSatResult -> m AllSatResult
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure AllSatResult
    sofar

               where haveEnough :: Int -> Bool
    haveEnough Int
    have = case SMTConfig -> Maybe Int
    allSatMaxModelCount SMTConfig
    cfg of
                                         Just Int
    maxModels -> Int
    have Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxModels
                                         Maybe Int
    _              -> Bool
    False

                     go :: IORef (Int, AllSatResult, Bool, Maybe String) -> S.Seq (SVal, NamedSymVar) -> m ()
                     go :: IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> Seq (SVal, NamedSymVar) -> m ()
    go IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult = Bool -> Seq (SVal, NamedSymVar) -> m ()
    walk Bool
    True
                       where shouldContinue :: m Bool
    shouldContinue = do (Int
    have, AllSatResult
    _, Bool
    exitLoop, Maybe [Char]
    _) <- IO (Int, AllSatResult, Bool, Maybe [Char])
    -> m (Int, AllSatResult, Bool, Maybe [Char])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Int, AllSatResult, Bool, Maybe [Char])
     -> m (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO (Int, AllSatResult, Bool, Maybe [Char])
    -> m (Int, AllSatResult, Bool, Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> IO (Int, AllSatResult, Bool, Maybe [Char])
    forall a. IORef a -> IO a
    readIORef IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult
                                                 Bool -> m Bool
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool -> m Bool) -> Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool
    exitLoop Bool -> Bool -> Bool
    || Int -> Bool
    haveEnough Int
    have)

                             walk :: Bool -> S.Seq (SVal, NamedSymVar) -> m ()
                             walk :: Bool -> Seq (SVal, NamedSymVar) -> m ()
    walk Bool
    firstRun Seq (SVal, NamedSymVar)
    terms
                               | Bool -> Bool
    not Bool
    firstRun Bool -> Bool -> Bool
    && Seq (SVal, NamedSymVar) -> Bool
    forall a. Seq a -> Bool
    S.null Seq (SVal, NamedSymVar)
    terms
                               = () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                               | Bool
    True
                               = do Maybe Int
    mbCont <- do (Int
    have, AllSatResult
    sofar, Bool
    exitLoop, Maybe [Char]
    _) <- IO (Int, AllSatResult, Bool, Maybe [Char])
    -> m (Int, AllSatResult, Bool, Maybe [Char])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Int, AllSatResult, Bool, Maybe [Char])
     -> m (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO (Int, AllSatResult, Bool, Maybe [Char])
    -> m (Int, AllSatResult, Bool, Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> IO (Int, AllSatResult, Bool, Maybe [Char])
    forall a. IORef a -> IO a
    readIORef IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult
                                                 if Bool
    exitLoop
                                                    then Maybe Int -> m (Maybe Int)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Int
    forall a. Maybe a
    Nothing
                                                    else case SMTConfig -> Maybe Int
    allSatMaxModelCount SMTConfig
    cfg of
                                                           Just Int
    maxModels
                                                             | Int
    have Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxModels -> do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (AllSatResult -> Bool
    allSatMaxModelCountReached AllSatResult
    sofar) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                                                                                          [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** Maximum model count request of " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    maxModels [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " reached, stopping the search."]
                                                                                          Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SMTConfig -> Bool
    allSatPrintAlong SMTConfig
    cfg) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    "Search stopped since model count request was reached."
                                                                                          IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult (((Int, AllSatResult, Bool, Maybe [Char])
      -> (Int, AllSatResult, Bool, Maybe [Char]))
     -> IO ())
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Int
    h, AllSatResult
    s, Bool
    _, Maybe [Char]
    m) -> (Int
    h, AllSatResult
    s{ allSatMaxModelCountReached = True }, Bool
    True, Maybe [Char]
    m)
                                                                                       Maybe Int -> m (Maybe Int)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Int
    forall a. Maybe a
    Nothing
                                                           Maybe Int
    _                     -> Maybe Int -> m (Maybe Int)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Int -> m (Maybe Int)) -> Maybe Int -> m (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Int
    haveInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1

                                    case Maybe Int
    mbCont of
                                      Maybe Int
    Nothing  -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                                      Just Int
    cnt -> do
                                        [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "Fast allSat, Looking for solution " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cnt]

                                        CheckSatResult
    cs <- m CheckSatResult
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m CheckSatResult
    checkSat

                                        case CheckSatResult
    cs of
                                          CheckSatResult
    Unsat  -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

                                          CheckSatResult
    Unk    -> do let m :: [Char]
    m = [Char]
    "Solver returned unknown, terminating query."
                                                       [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m]
                                                       IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult (((Int, AllSatResult, Bool, Maybe [Char])
      -> (Int, AllSatResult, Bool, Maybe [Char]))
     -> IO ())
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Int
    h, AllSatResult
    s, Bool
    _, Maybe [Char]
    _) -> (Int
    h, AllSatResult
    s{allSatSolverReturnedUnknown = True}, Bool
    True, [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char]
    "[" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"))

                                          DSat Maybe [Char]
    _ -> do let m :: [Char]
    m = [Char]
    "Solver returned delta-sat, terminating query."
                                                       [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m]
                                                       IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult (((Int, AllSatResult, Bool, Maybe [Char])
      -> (Int, AllSatResult, Bool, Maybe [Char]))
     -> IO ())
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Int
    h, AllSatResult
    s, Bool
    _, Maybe [Char]
    _) -> (Int
    h, AllSatResult
    s{allSatSolverReturnedDSat = True}, Bool
    True, [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char]
    "[" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"))

                                          CheckSatResult
    Sat    -> do Seq (SV, (Text, (SVal, CV)))
    assocs <- ((SVal, NamedSymVar) -> m (SV, (Text, (SVal, CV))))
    -> Seq (SVal, NamedSymVar) -> m (Seq (SV, (Text, (SVal, CV))))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Seq a -> m (Seq b)
    mapM (\(SVal
    sval, NamedSymVar SV
    sv Text
    n) -> do !CV
    cv <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    forall a. Maybe a
    Nothing SV
    sv
                                                                                                       (SV, (Text, (SVal, CV))) -> m (SV, (Text, (SVal, CV)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SV
    sv, (Text
    n, (SVal
    sval, CV
    cv)))) Seq (SVal, NamedSymVar)
    vars

                                                       Maybe (Seq (NamedSymVar, CV))
    bindings <- let grab :: NamedSymVar -> m (NamedSymVar, CV)
    grab i :: NamedSymVar
    i@(NamedSymVar -> SV
    getSV -> SV
    sv) = case ((SV, (Text, (SVal, CV))) -> SV)
    -> SV
    -> Seq (SV, (Text, (SVal, CV)))
    -> Maybe (SV, (Text, (SVal, CV)))
    forall a. Eq a => (a -> SV) -> SV -> Seq a -> Maybe a
    lookupInput (SV, (Text, (SVal, CV))) -> SV
    forall a b. (a, b) -> a
    fst SV
    sv Seq (SV, (Text, (SVal, CV)))
    assocs of
                                                                                                Just (SV
    _, (Text
    _, (SVal
    _, CV
    cv))) -> (NamedSymVar, CV) -> m (NamedSymVar, CV)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NamedSymVar
    i, CV
    cv)
                                                                                                Maybe (SV, (Text, (SVal, CV)))
    Nothing                -> do !CV
    cv <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    forall a. Maybe a
    Nothing SV
    sv
                                                                                                                             (NamedSymVar, CV) -> m (NamedSymVar, CV)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NamedSymVar
    i, CV
    cv)
                                                                   in if SMTConfig -> Bool
    validationRequested SMTConfig
    cfg
                                                                      then Seq (NamedSymVar, CV) -> Maybe (Seq (NamedSymVar, CV))
    forall a. a -> Maybe a
    Just (Seq (NamedSymVar, CV) -> Maybe (Seq (NamedSymVar, CV)))
    -> m (Seq (NamedSymVar, CV)) -> m (Maybe (Seq (NamedSymVar, CV)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (NamedSymVar -> m (NamedSymVar, CV))
    -> UserInputs -> m (Seq (NamedSymVar, CV))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Seq a -> m (Seq b)
    mapM NamedSymVar -> m (NamedSymVar, CV)
    grab UserInputs
    allInputs
                                                                      else Maybe (Seq (NamedSymVar, CV)) -> m (Maybe (Seq (NamedSymVar, CV)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Seq (NamedSymVar, CV))
    forall a. Maybe a
    Nothing

                                                       [(Text, CV)]
    obsvs <- m [(Text, CV)]
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m [(Text, CV)]
    getObservables

                                                       let lassocs :: [(SV, (Text, (SVal, CV)))]
    lassocs = Seq (SV, (Text, (SVal, CV))) -> [(SV, (Text, (SVal, CV)))]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList Seq (SV, (Text, (SVal, CV)))
    assocs
                                                           model :: SMTModel
    model   = SMTModel { modelObjectives :: [([Char], GeneralizedCV)]
    modelObjectives = []
                                                                              , modelBindings :: Maybe [(NamedSymVar, CV)]
    modelBindings   = Seq (NamedSymVar, CV) -> [(NamedSymVar, CV)]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (Seq (NamedSymVar, CV) -> [(NamedSymVar, CV)])
    -> Maybe (Seq (NamedSymVar, CV)) -> Maybe [(NamedSymVar, CV)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Seq (NamedSymVar, CV))
    bindings
                                                                              , modelAssocs :: [([Char], CV)]
    modelAssocs     =    ((Text -> [Char]) -> (Text, CV) -> ([Char], CV)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Text -> [Char]
    T.unpack ((Text, CV) -> ([Char], CV)) -> [(Text, CV)] -> [([Char], CV)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Text, CV) -> Text) -> [(Text, CV)] -> [(Text, CV)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Text, CV) -> Text
    forall a b. (a, b) -> a
    fst [(Text, CV)]
    obsvs)
                                                                                                  [([Char], CV)] -> [([Char], CV)] -> [([Char], CV)]
    forall a. Semigroup a => a -> a -> a
    <> [(Text -> [Char]
    T.unpack Text
    n, CV
    cv) | (SV
    _, (Text
    n, (SVal
    _, CV
    cv))) <- [(SV, (Text, (SVal, CV)))]
    lassocs]
                                                                              , modelUIFuns :: [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))]
    modelUIFuns     = []
                                                                              }
                                                           currentResult :: SMTResult
    currentResult = SMTConfig -> SMTModel -> SMTResult
    Satisfiable SMTConfig
    cfg SMTModel
    model

                                                       IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Int, AllSatResult, Bool, Maybe [Char])
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef (Int, AllSatResult, Bool, Maybe [Char])
    finalResult (((Int, AllSatResult, Bool, Maybe [Char])
      -> (Int, AllSatResult, Bool, Maybe [Char]))
     -> IO ())
    -> ((Int, AllSatResult, Bool, Maybe [Char])
        -> (Int, AllSatResult, Bool, Maybe [Char]))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Int
    h, AllSatResult
    s, Bool
    e, Maybe [Char]
    m) -> let h' :: Int
    h' = Int
    hInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1 in Int
    h' Int
    -> (Int, AllSatResult, Bool, Maybe [Char])
    -> (Int, AllSatResult, Bool, Maybe [Char])
    forall a b. a -> b -> b
    `seq` (Int
    h', AllSatResult
    s{allSatResults = currentResult : allSatResults s}, Bool
    e, Maybe [Char]
    m)

                                                       Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SMTConfig -> Bool
    allSatPrintAlong SMTConfig
    cfg) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                                                            IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Solution #" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cnt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ":"
                                                            IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SMTConfig -> SMTModel -> [Char]
    showModel SMTConfig
    cfg SMTModel
    model

                                                       let findVal :: (SVal, NamedSymVar) -> (SVal, CV)
                                                           findVal :: (SVal, NamedSymVar) -> (SVal, CV)
    findVal (SVal
    _, NamedSymVar SV
    sv Text
    nm) = case Seq (SV, (Text, (SVal, CV))) -> [(SV, (Text, (SVal, CV)))]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (((SV, (Text, (SVal, CV))) -> Bool)
    -> Seq (SV, (Text, (SVal, CV))) -> Seq (SV, (Text, (SVal, CV)))
    forall a. (a -> Bool) -> Seq a -> Seq a
    S.filter (\(SV
    sv', (Text, (SVal, CV))
    _) -> SV
    sv SV -> SV -> Bool
    forall a. Eq a => a -> a -> Bool
    == SV
    sv') Seq (SV, (Text, (SVal, CV)))
    assocs) of
                                                                                               [(SV
    _, (Text
    _, (SVal, CV)
    scv))] -> (SVal, CV)
    scv
                                                                                               [(SV, (Text, (SVal, CV)))]
    _               -> [Char] -> (SVal, CV)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (SVal, CV)) -> [Char] -> (SVal, CV)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.SBV: Cannot uniquely determine " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Seq (SV, (Text, (SVal, CV))) -> [Char]
    forall a. Show a => a -> [Char]
    show Seq (SV, (Text, (SVal, CV)))
    assocs

                                                           cstr :: Bool -> (SVal, CV) -> m ()
                                                           cstr :: Bool -> (SVal, CV) -> m ()
    cstr Bool
    shouldReject (SVal
    sv, CV
    cv) = SBool -> m ()
    forall a. QuantifiedBool a => a -> m ()
    forall (m :: * -> *) a.
    (SolverContext m, QuantifiedBool a) =>
    a -> m ()
    constrain (SVal -> SBool
    forall a. SVal -> SBV a
    SBV (SVal -> SBool) -> SVal -> SBool
    forall a b. (a -> b) -> a -> b
    $ Kind -> SVal -> SVal -> SVal
    mkEq (SVal -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SVal
    sv) SVal
    sv (Kind -> Either CV (Cached SV) -> SVal
    SVal (SVal -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SVal
    sv) (CV -> Either CV (Cached SV)
    forall a b. a -> Either a b
    Left CV
    cv)) :: SBool)
                                                             where mkEq :: Kind -> SVal -> SVal -> SVal
                                                                   mkEq :: Kind -> SVal -> SVal -> SVal
    mkEq Kind
    k SVal
    a SVal
    b
                                                                    | Kind -> Bool
    forall a. HasKind a => a -> Bool
    isDouble Kind
    k Bool -> Bool -> Bool
    || Kind -> Bool
    forall a. HasKind a => a -> Bool
    isFloat Kind
    k Bool -> Bool -> Bool
    || Kind -> Bool
    forall a. HasKind a => a -> Bool
    isFP Kind
    k
                                                                    = if Bool
    shouldReject
                                                                         then SVal -> SVal
    svNot  (SVal
    a SVal -> SVal -> SVal
    `fpEq` SVal
    b)
                                                                         else         SVal
    a SVal -> SVal -> SVal
    `fpEq` SVal
    b
                                                                    | Bool
    True
                                                                    = if Bool
    shouldReject
                                                                         then SVal
    a SVal -> SVal -> SVal
    `svNotEqual` SVal
    b
                                                                         else SVal
    a SVal -> SVal -> SVal
    `svEqual`    SVal
    b

                                                                   fpEq :: SVal -> SVal -> SVal
    fpEq SVal
    a SVal
    b = Kind -> Either CV (Cached SV) -> SVal
    SVal Kind
    KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
    forall a b. (a -> b) -> a -> b
    $ Cached SV -> Either CV (Cached SV)
    forall a b. b -> Either a b
    Right (Cached SV -> Either CV (Cached SV))
    -> Cached SV -> Either CV (Cached SV)
    forall a b. (a -> b) -> a -> b
    $ (State -> IO SV) -> Cached SV
    forall a. (State -> IO a) -> Cached a
    cache State -> IO SV
    r
                                                                       where r :: State -> IO SV
    r State
    st = do SV
    sva <- State -> SVal -> IO SV
    svToSV State
    st SVal
    a
                                                                                       SV
    svb <- State -> SVal -> IO SV
    svToSV State
    st SVal
    b
                                                                                       State -> Kind -> SBVExpr -> IO SV
    newExpr State
    st Kind
    KBool (Op -> [SV] -> SBVExpr
    SBVApp (FPOp -> Op
    IEEEFP FPOp
    FP_ObjEqual) [SV
    sva, SV
    svb])

                                                           reject, accept :: (SVal, NamedSymVar) -> m ()
                                                           reject :: (SVal, NamedSymVar) -> m ()
    reject = Bool -> (SVal, CV) -> m ()
    cstr Bool
    True  ((SVal, CV) -> m ())
    -> ((SVal, NamedSymVar) -> (SVal, CV))
    -> (SVal, NamedSymVar)
    -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SVal, NamedSymVar) -> (SVal, CV)
    findVal
                                                           accept :: (SVal, NamedSymVar) -> m ()
    accept = Bool -> (SVal, CV) -> m ()
    cstr Bool
    False ((SVal, CV) -> m ())
    -> ((SVal, NamedSymVar) -> (SVal, CV))
    -> (SVal, NamedSymVar)
    -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SVal, NamedSymVar) -> (SVal, CV)
    findVal

                                                           scope :: (SVal, NamedSymVar) -> S.Seq (SVal, NamedSymVar) -> m () -> m ()
                                                           scope :: (SVal, NamedSymVar) -> Seq (SVal, NamedSymVar) -> m () -> m ()
    scope (SVal, NamedSymVar)
    cur Seq (SVal, NamedSymVar)
    pres m ()
    c = do
                                                                    Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True [Char]
    "(push 1)"
                                                                    (SVal, NamedSymVar) -> m ()
    reject (SVal, NamedSymVar)
    cur
                                                                    ((SVal, NamedSymVar) -> m ()) -> Seq (SVal, NamedSymVar) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (SVal, NamedSymVar) -> m ()
    accept Seq (SVal, NamedSymVar)
    pres
                                                                    ()
    r <- m ()
    c
                                                                    Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True [Char]
    "(pop 1)"
                                                                    () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    r

                                                       [Int] -> (Int -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Seq (SVal, NamedSymVar) -> Int
    forall a. Seq a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Seq (SVal, NamedSymVar)
    terms Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i -> do
                                                            Bool
    sc <- m Bool
    shouldContinue
                                                            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    sc (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do case Int
    -> Seq (SVal, NamedSymVar)
    -> (Seq (SVal, NamedSymVar), Seq (SVal, NamedSymVar))
    forall a. Int -> Seq a -> (Seq a, Seq a)
    S.splitAt Int
    i Seq (SVal, NamedSymVar)
    terms of
                                                                           (Seq (SVal, NamedSymVar)
    pre, rest :: Seq (SVal, NamedSymVar)
    rest@((SVal, NamedSymVar)
    cur S.:<| Seq (SVal, NamedSymVar)
    _)) -> (SVal, NamedSymVar) -> Seq (SVal, NamedSymVar) -> m () -> m ()
    scope (SVal, NamedSymVar)
    cur Seq (SVal, NamedSymVar)
    pre (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Seq (SVal, NamedSymVar) -> m ()
    walk Bool
    False Seq (SVal, NamedSymVar)
    rest
                                                                           (Seq (SVal, NamedSymVar), Seq (SVal, NamedSymVar))
    _                         -> [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Data.SBV.allSat: Impossible happened, ran out of terms!"

             -- All sat loop. This is slower, as it implements the reject-the-previous model and loop around logic. But
             -- it can handle uninterpreted sorts; so we keep it here as a fall-back.
             loop :: State
    -> ([([Char], (Maybe [[Char]], SBVType))], [[Char]])
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> UserInputs
    -> Seq (SVal, NamedSymVar)
    -> SMTConfig
    -> AllSatResult
    -> m AllSatResult
    loop State
    topState ([([Char], (Maybe [[Char]], SBVType))]
    allUiFuns, [[Char]]
    uiFunsToReject) [([Char], (Maybe [[Char]], SBVType))]
    allUiRegs UserInputs
    allInputs Seq (SVal, NamedSymVar)
    vars SMTConfig
    cfg = Int -> AllSatResult -> m AllSatResult
    go (Int
    1::Int)
               where go :: Int -> AllSatResult -> m AllSatResult
                     go :: Int -> AllSatResult -> m AllSatResult
    go !Int
    cnt !AllSatResult
    sofar
                       | Just Int
    maxModels <- SMTConfig -> Maybe Int
    allSatMaxModelCount SMTConfig
    cfg, Int
    cnt Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxModels
                       = do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** Maximum model count request of " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    maxModels [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " reached, stopping the search."]
                            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SMTConfig -> Bool
    allSatPrintAlong SMTConfig
    cfg) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    "Search stopped since model count request was reached."
                            AllSatResult -> m AllSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AllSatResult -> m AllSatResult) -> AllSatResult -> m AllSatResult
    forall a b. (a -> b) -> a -> b
    $! AllSatResult
    sofar { allSatMaxModelCountReached = True }
                       | Bool
    True
                       = do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "Looking for solution " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cnt]

                            CheckSatResult
    cs <- m CheckSatResult
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m CheckSatResult
    checkSat

                            let endMsg :: Maybe [Char] -> m ()
    endMsg = Int -> SMTConfig -> AllSatResult -> Maybe [Char] -> m ()
    forall {f :: * -> *} {a}.
    (Eq a, Num a, Show a, MonadIO f) =>
    a -> SMTConfig -> AllSatResult -> Maybe [Char] -> f ()
    finalize Int
    cnt SMTConfig
    cfg AllSatResult
    sofar

                            case CheckSatResult
    cs of
                              CheckSatResult
    Unsat  -> do Maybe [Char] -> m ()
    endMsg Maybe [Char]
    forall a. Maybe a
    Nothing
                                           AllSatResult -> m AllSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return AllSatResult
    sofar

                              CheckSatResult
    Unk    -> do let m :: [Char]
    m = [Char]
    "Solver returned unknown, terminating query."
                                           [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m]
                                           Maybe [Char] -> m ()
    endMsg (Maybe [Char] -> m ()) -> Maybe [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "[" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"
                                           AllSatResult -> m AllSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return AllSatResult
    sofar{ allSatSolverReturnedUnknown = True }

                              DSat Maybe [Char]
    _ -> do let m :: [Char]
    m = [Char]
    "Solver returned delta-sat, terminating query."
                                           [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [[Char]
    "*** " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m]
                                           Maybe [Char] -> m ()
    endMsg (Maybe [Char] -> m ()) -> Maybe [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "[" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"
                                           AllSatResult -> m AllSatResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return AllSatResult
    sofar{ allSatSolverReturnedDSat = True }

                              CheckSatResult
    Sat    -> do Seq (SV, (Text, (SVal, CV)))
    assocs <- ((SVal, NamedSymVar) -> m (SV, (Text, (SVal, CV))))
    -> Seq (SVal, NamedSymVar) -> m (Seq (SV, (Text, (SVal, CV))))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Seq a -> m (Seq b)
    mapM (\(SVal
    sval, NamedSymVar SV
    sv Text
    n) -> do !CV
    cv <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    forall a. Maybe a
    Nothing SV
    sv
                                                                                           (SV, (Text, (SVal, CV))) -> m (SV, (Text, (SVal, CV)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SV
    sv, (Text
    n, (SVal
    sval, CV
    cv)))) Seq (SVal, NamedSymVar)
    vars

                                           let getUIFun :: ([Char], (Maybe [[Char]], SBVType))
    -> m ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    getUIFun ui :: ([Char], (Maybe [[Char]], SBVType))
    ui@([Char]
    nm, (Maybe [[Char]]
    _, SBVType
    t)) = do Either [Char] ([([CV], CV)], CV)
    cvs <- Maybe Int
    -> ([Char], (Maybe [[Char]], SBVType))
    -> m (Either [Char] ([([CV], CV)], CV))
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int
    -> ([Char], (Maybe [[Char]], SBVType))
    -> m (Either [Char] ([([CV], CV)], CV))
    getUIFunCVAssoc Maybe Int
    forall a. Maybe a
    Nothing ([Char], (Maybe [[Char]], SBVType))
    ui
                                                                             ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    -> m ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    nm, (SBVType
    t, Either [Char] ([([CV], CV)], CV)
    cvs))
                                           [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))]
    uiFunVals <- (([Char], (Maybe [[Char]], SBVType))
     -> m ([Char], (SBVType, Either [Char] ([([CV], CV)], CV))))
    -> [([Char], (Maybe [[Char]], SBVType))]
    -> m [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([Char], (Maybe [[Char]], SBVType))
    -> m ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    forall {m :: * -> *}.
    (MonadIO m, MonadQuery m) =>
    ([Char], (Maybe [[Char]], SBVType))
    -> m ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    getUIFun [([Char], (Maybe [[Char]], SBVType))]
    allUiFuns

                                           [([Char], CV)]
    uiRegVals <- (([Char], (Maybe [[Char]], SBVType)) -> m ([Char], CV))
    -> [([Char], (Maybe [[Char]], SBVType))] -> m [([Char], CV)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\ui :: ([Char], (Maybe [[Char]], SBVType))
    ui@([Char]
    nm, (Maybe [[Char]], SBVType)
    _) -> ([Char]
    nm,) (CV -> ([Char], CV)) -> m CV -> m ([Char], CV)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Int -> ([Char], (Maybe [[Char]], SBVType)) -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> ([Char], (Maybe [[Char]], SBVType)) -> m CV
    getUICVal Maybe Int
    forall a. Maybe a
    Nothing ([Char], (Maybe [[Char]], SBVType))
    ui) [([Char], (Maybe [[Char]], SBVType))]
    allUiRegs

                                           [(Text, CV)]
    obsvs <- m [(Text, CV)]
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m [(Text, CV)]
    getObservables

                                           Maybe (Seq (NamedSymVar, CV))
    bindings <- let grab :: NamedSymVar -> m (NamedSymVar, CV)
    grab i :: NamedSymVar
    i@(NamedSymVar -> SV
    getSV -> SV
    sv) = case ((SV, (Text, (SVal, CV))) -> SV)
    -> SV
    -> Seq (SV, (Text, (SVal, CV)))
    -> Maybe (SV, (Text, (SVal, CV)))
    forall a. Eq a => (a -> SV) -> SV -> Seq a -> Maybe a
    lookupInput (SV, (Text, (SVal, CV))) -> SV
    forall a b. (a, b) -> a
    fst SV
    sv Seq (SV, (Text, (SVal, CV)))
    assocs of
                                                                                    Just (SV
    _, (Text
    _, (SVal
    _, CV
    cv))) -> (NamedSymVar, CV) -> m (NamedSymVar, CV)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NamedSymVar
    i, CV
    cv)
                                                                                    Maybe (SV, (Text, (SVal, CV)))
    Nothing                -> do !CV
    cv <- Maybe Int -> SV -> m CV
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Maybe Int -> SV -> m CV
    getValueCV Maybe Int
    forall a. Maybe a
    Nothing SV
    sv
                                                                                                                 (NamedSymVar, CV) -> m (NamedSymVar, CV)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NamedSymVar
    i, CV
    cv)
                                                       in if SMTConfig -> Bool
    validationRequested SMTConfig
    cfg
                                                             then Seq (NamedSymVar, CV) -> Maybe (Seq (NamedSymVar, CV))
    forall a. a -> Maybe a
    Just (Seq (NamedSymVar, CV) -> Maybe (Seq (NamedSymVar, CV)))
    -> m (Seq (NamedSymVar, CV)) -> m (Maybe (Seq (NamedSymVar, CV)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (NamedSymVar -> m (NamedSymVar, CV))
    -> UserInputs -> m (Seq (NamedSymVar, CV))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Seq a -> m (Seq b)
    mapM NamedSymVar -> m (NamedSymVar, CV)
    grab UserInputs
    allInputs
                                                             else Maybe (Seq (NamedSymVar, CV)) -> m (Maybe (Seq (NamedSymVar, CV)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Seq (NamedSymVar, CV))
    forall a. Maybe a
    Nothing

                                           let model :: SMTModel
    model = SMTModel { modelObjectives :: [([Char], GeneralizedCV)]
    modelObjectives = []
                                                                , modelBindings :: Maybe [(NamedSymVar, CV)]
    modelBindings   = Seq (NamedSymVar, CV) -> [(NamedSymVar, CV)]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (Seq (NamedSymVar, CV) -> [(NamedSymVar, CV)])
    -> Maybe (Seq (NamedSymVar, CV)) -> Maybe [(NamedSymVar, CV)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Seq (NamedSymVar, CV))
    bindings
                                                                , modelAssocs :: [([Char], CV)]
    modelAssocs     =    [([Char], CV)]
    uiRegVals
                                                                                    [([Char], CV)] -> [([Char], CV)] -> [([Char], CV)]
    forall a. Semigroup a => a -> a -> a
    <> ((Text -> [Char]) -> (Text, CV) -> ([Char], CV)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Text -> [Char]
    T.unpack ((Text, CV) -> ([Char], CV)) -> [(Text, CV)] -> [([Char], CV)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Text, CV) -> Text) -> [(Text, CV)] -> [(Text, CV)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Text, CV) -> Text
    forall a b. (a, b) -> a
    fst [(Text, CV)]
    obsvs)
                                                                                    [([Char], CV)] -> [([Char], CV)] -> [([Char], CV)]
    forall a. Semigroup a => a -> a -> a
    <> [(Text -> [Char]
    T.unpack Text
    n, CV
    cv) | (SV
    _, (Text
    n, (SVal
    _, CV
    cv))) <- Seq (SV, (Text, (SVal, CV))) -> [(SV, (Text, (SVal, CV)))]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList Seq (SV, (Text, (SVal, CV)))
    assocs]
                                                                , modelUIFuns :: [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))]
    modelUIFuns     = [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))]
    uiFunVals
                                                                }
                                               m :: SMTResult
    m = SMTConfig -> SMTModel -> SMTResult
    Satisfiable SMTConfig
    cfg SMTModel
    model

                                               (Seq (SVal, CV)
    interpreteds, Seq (SVal, CV)
    uninterpreteds) = ((SVal, CV) -> Bool)
    -> Seq (SVal, CV) -> (Seq (SVal, CV), Seq (SVal, CV))
    forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
    S.partition (Bool -> Bool
    not (Bool -> Bool) -> ((SVal, CV) -> Bool) -> (SVal, CV) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Kind -> Bool
    isFree (Kind -> Bool) -> ((SVal, CV) -> Kind) -> (SVal, CV) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SVal -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (SVal -> Kind) -> ((SVal, CV) -> SVal) -> (SVal, CV) -> Kind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SVal, CV) -> SVal
    forall a b. (a, b) -> a
    fst) (((SV, (Text, (SVal, CV))) -> (SVal, CV))
    -> Seq (SV, (Text, (SVal, CV))) -> Seq (SVal, CV)
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Text, (SVal, CV)) -> (SVal, CV)
    forall a b. (a, b) -> b
    snd ((Text, (SVal, CV)) -> (SVal, CV))
    -> ((SV, (Text, (SVal, CV))) -> (Text, (SVal, CV)))
    -> (SV, (Text, (SVal, CV)))
    -> (SVal, CV)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SV, (Text, (SVal, CV))) -> (Text, (SVal, CV))
    forall a b. (a, b) -> b
    snd) Seq (SV, (Text, (SVal, CV)))
    assocs)

                                               interpretedRegUis :: [([Char], CV)]
    interpretedRegUis = (([Char], CV) -> Bool) -> [([Char], CV)] -> [([Char], CV)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (([Char], CV) -> Bool) -> ([Char], CV) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Kind -> Bool
    isFree (Kind -> Bool) -> (([Char], CV) -> Kind) -> ([Char], CV) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CV -> Kind
    forall a. HasKind a => a -> Kind
    kindOf (CV -> Kind) -> (([Char], CV) -> CV) -> ([Char], CV) -> Kind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], CV) -> CV
    forall a b. (a, b) -> b
    snd) [([Char], CV)]
    uiRegVals

                                               interpretedRegUiSVs :: [(SVal, CV)]
    interpretedRegUiSVs = [([Char] -> Kind -> SVal
    cvt [Char]
    n (CV -> Kind
    forall a. HasKind a => a -> Kind
    kindOf CV
    cv), CV
    cv) | ([Char]
    n, CV
    cv) <- [([Char], CV)]
    interpretedRegUis]
                                                 where cvt :: String -> Kind -> SVal
                                                       cvt :: [Char] -> Kind -> SVal
    cvt [Char]
    nm Kind
    k = Kind -> Either CV (Cached SV) -> SVal
    SVal Kind
    k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
    forall a b. (a -> b) -> a -> b
    $ Cached SV -> Either CV (Cached SV)
    forall a b. b -> Either a b
    Right (Cached SV -> Either CV (Cached SV))
    -> Cached SV -> Either CV (Cached SV)
    forall a b. (a -> b) -> a -> b
    $ (State -> IO SV) -> Cached SV
    forall a. (State -> IO a) -> Cached a
    cache State -> IO SV
    r
                                                         where r :: State -> IO SV
    r State
    st = State -> Kind -> SBVExpr -> IO SV
    newExpr State
    st Kind
    k (Op -> [SV] -> SBVExpr
    SBVApp ([Char] -> Op
    Uninterpreted [Char]
    nm) [])

                                               -- For each interpreted variable, figure out the model equivalence
                                               -- NB. When the kind is floating, we *have* to be careful, since +/- zero, and NaN's
                                               -- and equality don't get along!
                                               interpretedEqs :: [SVal]
                                               interpretedEqs :: [SVal]
    interpretedEqs = [Kind -> SVal -> SVal -> SVal
    forall {a}. HasKind a => a -> SVal -> SVal -> SVal
    mkNotEq (SVal -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SVal
    sv) SVal
    sv (Kind -> Either CV (Cached SV) -> SVal
    SVal (SVal -> Kind
    forall a. HasKind a => a -> Kind
    kindOf SVal
    sv) (CV -> Either CV (Cached SV)
    forall a b. a -> Either a b
    Left CV
    cv)) | (SVal
    sv, CV
    cv) <- [(SVal, CV)]
    interpretedRegUiSVs [(SVal, CV)] -> [(SVal, CV)] -> [(SVal, CV)]
    forall a. Semigroup a => a -> a -> a
    <> Seq (SVal, CV) -> [(SVal, CV)]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList Seq (SVal, CV)
    interpreteds]
                                                  where mkNotEq :: a -> SVal -> SVal -> SVal
    mkNotEq a
    k SVal
    a SVal
    b
                                                         | a -> Bool
    forall a. HasKind a => a -> Bool
    isDouble a
    k Bool -> Bool -> Bool
    || a -> Bool
    forall a. HasKind a => a -> Bool
    isFloat a
    k Bool -> Bool -> Bool
    || a -> Bool
    forall a. HasKind a => a -> Bool
    isFP a
    k
                                                         = SVal -> SVal
    svNot (SVal
    a SVal -> SVal -> SVal
    `fpEq` SVal
    b)
                                                         | Bool
    True
                                                         = SVal
    a SVal -> SVal -> SVal
    `svNotEqual` SVal
    b

                                                        fpEq :: SVal -> SVal -> SVal
    fpEq SVal
    a SVal
    b = Kind -> Either CV (Cached SV) -> SVal
    SVal Kind
    KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
    forall a b. (a -> b) -> a -> b
    $ Cached SV -> Either CV (Cached SV)
    forall a b. b -> Either a b
    Right (Cached SV -> Either CV (Cached SV))
    -> Cached SV -> Either CV (Cached SV)
    forall a b. (a -> b) -> a -> b
    $ (State -> IO SV) -> Cached SV
    forall a. (State -> IO a) -> Cached a
    cache State -> IO SV
    r
                                                            where r :: State -> IO SV
    r State
    st = do SV
    sva <- State -> SVal -> IO SV
    svToSV State
    st SVal
    a
                                                                            SV
    svb <- State -> SVal -> IO SV
    svToSV State
    st SVal
    b
                                                                            State -> Kind -> SBVExpr -> IO SV
    newExpr State
    st Kind
    KBool (Op -> [SV] -> SBVExpr
    SBVApp (FPOp -> Op
    IEEEFP FPOp
    FP_ObjEqual) [SV
    sva, SV
    svb])

                                               -- For each uninterpreted constant, use equivalence class
                                               uninterpretedEqs :: [SVal]
                                               uninterpretedEqs :: [SVal]
    uninterpretedEqs = ([SVal] -> [SVal]) -> [[SVal]] -> [SVal]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [SVal] -> [SVal]
    pwDistinct         -- Assert that they are pairwise distinct
                                                                ([[SVal]] -> [SVal])
    -> ([(SVal, CV)] -> [[SVal]]) -> [(SVal, CV)] -> [SVal]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([SVal] -> Bool) -> [[SVal]] -> [[SVal]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\[SVal]
    l -> [SVal] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SVal]
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1)  -- Only need this class if it has at least two members
                                                                ([[SVal]] -> [[SVal]])
    -> ([(SVal, CV)] -> [[SVal]]) -> [(SVal, CV)] -> [[SVal]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(SVal, CV)] -> [SVal]) -> [[(SVal, CV)]] -> [[SVal]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((SVal, CV) -> SVal) -> [(SVal, CV)] -> [SVal]
    forall a b. (a -> b) -> [a] -> [b]
    map (SVal, CV) -> SVal
    forall a b. (a, b) -> a
    fst)                -- throw away values, we only need svals
                                                                ([[(SVal, CV)]] -> [[SVal]])
    -> ([(SVal, CV)] -> [[(SVal, CV)]]) -> [(SVal, CV)] -> [[SVal]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((SVal, CV) -> (SVal, CV) -> Bool)
    -> [(SVal, CV)] -> [[(SVal, CV)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (CV -> CV -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (CV -> CV -> Bool)
    -> ((SVal, CV) -> CV) -> (SVal, CV) -> (SVal, CV) -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (SVal, CV) -> CV
    forall a b. (a, b) -> b
    snd)      -- make sure they belong to the same sort and have the same value
                                                                ([(SVal, CV)] -> [[(SVal, CV)]])
    -> ([(SVal, CV)] -> [(SVal, CV)]) -> [(SVal, CV)] -> [[(SVal, CV)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((SVal, CV) -> CV) -> [(SVal, CV)] -> [(SVal, CV)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (SVal, CV) -> CV
    forall a b. (a, b) -> b
    snd                   -- sort them according to their CV (i.e., sort/value)
                                                                ([(SVal, CV)] -> [SVal]) -> [(SVal, CV)] -> [SVal]
    forall a b. (a -> b) -> a -> b
    $ Seq (SVal, CV) -> [(SVal, CV)]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList Seq (SVal, CV)
    uninterpreteds
                                                 where pwDistinct :: [SVal] -> [SVal]
                                                       pwDistinct :: [SVal] -> [SVal]
    pwDistinct [SVal]
    ss = [SVal
    x SVal -> SVal -> SVal
    `svNotEqual` SVal
    y | (SVal
    x:[SVal]
    ys) <- [SVal] -> [[SVal]]
    forall a. [a] -> [[a]]
    tails [SVal]
    ss, SVal
    y <- [SVal]
    ys]

                                               -- For each uninterpreted function, create a disqualifying equation
                                               -- We do this rather brute-force, since we need to create a new function
                                               -- and do an existential assertion.
                                               uninterpretedReject :: Maybe [String]
                                               uninterpretedFuns   :: [String]
                                               (Maybe [[Char]]
    uninterpretedReject, [[Char]]
    uninterpretedFuns) = (Maybe [[Char]]
    uiReject, [[[Char]]] -> [[Char]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[[Char]]]
    defs)
                                                   where uiReject :: Maybe [[Char]]
    uiReject = case [[Char]]
    rejects of
                                                                      []  -> Maybe [[Char]]
    forall a. Maybe a
    Nothing
                                                                      [[Char]]
    xs  -> [[Char]] -> Maybe [[Char]]
    forall a. a -> Maybe a
    Just [[Char]]
    xs

                                                         ([[Char]]
    rejects, [[[Char]]]
    defs) = [([Char], [[Char]])] -> ([[Char]], [[[Char]]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    -> ([Char], [[Char]])
    mkNotEq ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    ui | ui :: ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    ui@([Char]
    nm, (SBVType, Either [Char] ([([CV], CV)], CV))
    _) <- [([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))]
    uiFunVals, [Char]
    nm [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    uiFunsToReject]

                                                         -- Otherwise, we have things to refute, go for it if we have a good interpretation for it
                                                         mkNotEq :: ([Char], (SBVType, Either [Char] ([([CV], CV)], CV)))
    -> ([Char], [[Char]])
    mkNotEq ([Char]
    nm, (SBVType
    typ, Left [Char]
    def)) =
                                                            [Char] -> ([Char], [[Char]])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([Char], [[Char]])) -> [Char] -> ([Char], [[Char]])
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [
                                                                [Char]
    ""
                                                              , [Char]
    "*** allSat: Unsupported: Building a rejecting instance for:"
                                                              , [Char]
    "***"
                                                              , [Char]
    "***     " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " :: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SBVType -> [Char]
    forall a. Show a => a -> [Char]
    show SBVType
    typ
                                                              , [Char]
    "***     " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    def
                                                              , [Char]
    "***"
                                                              , [Char]
    "*** At this time, SBV cannot compute allSat when the model has a non-table definition."
                                                              , [Char]
    "***"
                                                              , [Char]
    "*** You can ignore specific functions via the 'isNonModelVar' filter:"
                                                              , [Char]
    "***"
                                                              , [Char]
    "***    allSatWith z3{isNonModelVar = (`elem` [" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "])} ..."
                                                              , [Char]
    "***"
                                                              , [Char]
    "*** Or you can ignore all uninterpreted functions for all-sat purposes using the 'allSatTrackUFs' parameter:"
                                                              , [Char]
    "***"
                                                              , [Char]
    "***    allSatWith z3{allSatTrackUFs = False} ..."
                                                              , [Char]
    "***"
                                                              , [Char]
    "*** You can see the response from the solver by running with the '{verbose = True}' option."
                                                              , [Char]
    "***"
                                                              , [Char]
    "*** NB. If this is a use case you'd like SBV to support, please get in touch!"
                                                              ]
                                                         mkNotEq ([Char]
    nm, (SBVType [Kind]
    ts, Right ([([CV], CV)], CV)
    vs)) = ([Char]
    reject, [[Char]]
    def [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]]
    dif)
                                                           where nm' :: [Char]
    nm' = [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "_model" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cnt

                                                                 reject :: [Char]
    reject = [Char]
    nm' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "_reject"

                                                                 -- rounding mode doesn't matter here, just pick one
                                                                 scv :: CV -> [Char]
    scv = RoundingMode -> CV -> [Char]
    cvToSMTLib RoundingMode
    RoundNearestTiesToEven

                                                                 ([Kind]
    ats, Kind
    rt) = ([Kind] -> [Kind]
    forall a. HasCallStack => [a] -> [a]
    init [Kind]
    ts, [Kind] -> Kind
    forall a. HasCallStack => [a] -> a
    last [Kind]
    ts)

                                                                 args :: [Char]
    args = [[Char]] -> [Char]
    unwords [[Char]
    "(x!" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Kind -> [Char]
    smtType Kind
    t [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")" | (Kind
    t, Int
    i) <- [Kind] -> [Int] -> [(Kind, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Kind]
    ats [(Int
    0::Int)..]]
                                                                 res :: [Char]
    res  = Kind -> [Char]
    smtType Kind
    rt

                                                                 params :: [[Char]]
    params = [[Char]
    "x!" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i | (Kind
    _, Int
    i) <- [Kind] -> [Int] -> [(Kind, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Kind]
    ats [(Int
    0::Int)..]]

                                                                 uparams :: [Char]
    uparams = [[Char]] -> [Char]
    unwords [[Char]]
    params

                                                                 chain :: ([([CV], CV)], CV) -> [[Char]]
    chain ([([CV], CV)]
    vals, CV
    fallThru) = [([CV], CV)] -> [[Char]]
    walk [([CV], CV)]
    vals
                                                                   where walk :: [([CV], CV)] -> [[Char]]
    walk []               = [[Char]
    "   " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CV -> [Char]
    scv CV
    fallThru [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate ([([CV], CV)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [([CV], CV)]
    vals) Char
    ')']
                                                                         walk (([CV]
    as, CV
    r) : [([CV], CV)]
    rest) = ([Char]
    "   (ite " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [CV] -> [Char]
    cond [CV]
    as [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CV -> [Char]
    scv CV
    r) [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :  [([CV], CV)] -> [[Char]]
    walk [([CV], CV)]
    rest

                                                                         cond :: [CV] -> [Char]
    cond [CV]
    as = [Char]
    "(and " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unwords (([Char] -> CV -> [Char]) -> [[Char]] -> [CV] -> [[Char]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith [Char] -> CV -> [Char]
    eq [[Char]]
    params [CV]
    as) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                                                                         eq :: [Char] -> CV -> [Char]
    eq [Char]
    p CV
    a  = [Char]
    "(= " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    p [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CV -> [Char]
    scv CV
    a [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"

                                                                 def :: [[Char]]
    def =    ([Char]
    "(define-fun " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    args [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ") " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    res)
                                                                       [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :  ([([CV], CV)], CV) -> [[Char]]
    chain ([([CV], CV)], CV)
    vs
                                                                       [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]
    ")"]

                                                                 pad :: [Char]
    pad = Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    nm' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    nm) Char
    ' '

                                                                 dif :: [[Char]]
    dif = [ [Char]
    "(define-fun " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++  [Char]
    reject [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " () Bool"
                                                                       , [Char]
    "   (exists (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    args [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                                                                       , [Char]
    "           (distinct (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm  [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    pad [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    uparams [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                                                                       , [Char]
    "                     (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    uparams [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "))))"
                                                                       ]

                                               eqs :: [SVal]
    eqs = [SVal]
    interpretedEqs [SVal] -> [SVal] -> [SVal]
    forall a. [a] -> [a] -> [a]
    ++ [SVal]
    uninterpretedEqs

                                               disallow :: Maybe (SBV a)
    disallow = case [SVal]
    eqs of
                                                            [] -> Maybe (SBV a)
    forall a. Maybe a
    Nothing
                                                            [SVal]
    _  -> SBV a -> Maybe (SBV a)
    forall a. a -> Maybe a
    Just (SBV a -> Maybe (SBV a)) -> SBV a -> Maybe (SBV a)
    forall a b. (a -> b) -> a -> b
    $ SVal -> SBV a
    forall a. SVal -> SBV a
    SBV (SVal -> SBV a) -> SVal -> SBV a
    forall a b. (a -> b) -> a -> b
    $ (SVal -> SVal -> SVal) -> [SVal] -> SVal
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 SVal -> SVal -> SVal
    svOr [SVal]
    eqs

                                           Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SMTConfig -> Bool
    allSatPrintAlong SMTConfig
    cfg) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                                             IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Solution #" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cnt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ":"
                                             IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SMTConfig -> SMTModel -> [Char]
    showModel SMTConfig
    cfg SMTModel
    model

                                           let resultsSoFar :: AllSatResult
    resultsSoFar = AllSatResult
    sofar { allSatResults = m : allSatResults sofar }

                                               -- This is clunky, but let's not generate a rejector unless we really need it
                                               needMoreIterations :: Bool
    needMoreIterations
                                                     | Just Int
    maxModels <- SMTConfig -> Maybe Int
    allSatMaxModelCount SMTConfig
    cfg, (Int
    cntInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxModels = Bool
    False
                                                     | Bool
    True                                                           = Bool
    True

                                           -- Send function disequalities, if any:
                                           if Bool -> Bool
    not Bool
    needMoreIterations
                                              then Int -> AllSatResult -> m AllSatResult
    go (Int
    cntInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) AllSatResult
    resultsSoFar
                                              else do let uiFunRejector :: [Char]
    uiFunRejector   = [Char]
    "uiFunRejector_model_" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cnt
                                                          header :: [Char]
    header          = [Char]
    "define-fun " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    uiFunRejector [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " () Bool "

                                                          defineRejector :: [[Char]] -> m ()
    defineRejector []     = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                                          defineRejector [[Char]
    x]    = Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "(" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    header [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                                                          defineRejector ([Char]
    x:[[Char]]
    xs) = ([Char] -> m ()) -> [[Char]] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True) ([[Char]] -> m ()) -> [[Char]] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [[Char]]
    mergeSExpr ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $  ([Char]
    "(" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    header)
                                                                                                                 [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :  ([Char]
    "        (or " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    x)
                                                                                                                 [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :  [[Char]
    "            " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    e | [Char]
    e <- [[Char]]
    xs]
                                                                                                                 [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]
    "        ))"]
                                                      Maybe [Char]
    rejectFuncs <- case Maybe [[Char]]
    uninterpretedReject of
                                                                       Maybe [[Char]]
    Nothing -> Maybe [Char] -> m (Maybe [Char])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    forall a. Maybe a
    Nothing
                                                                       Just [[Char]]
    fs -> do ([Char] -> m ()) -> [[Char]] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True) ([[Char]] -> m ()) -> [[Char]] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [[Char]]
    mergeSExpr [[Char]]
    uninterpretedFuns
                                                                                     [[Char]] -> m ()
    defineRejector [[Char]]
    fs
                                                                                     Maybe [Char] -> m (Maybe [Char])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Char] -> m (Maybe [Char]))
    -> Maybe [Char] -> m (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    uiFunRejector

                                                      -- send the disallow clause and the uninterpreted rejector:
                                                      case (Maybe SBool
    forall {a}. Maybe (SBV a)
    disallow, Maybe [Char]
    rejectFuncs) of
                                                         (Maybe SBool
    Nothing, Maybe [Char]
    Nothing) -> AllSatResult -> m AllSatResult
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure AllSatResult
    resultsSoFar
                                                         (Just SBool
    d,  Maybe [Char]
    Nothing) -> do SBool -> m ()
    forall a. QuantifiedBool a => a -> m ()
    forall (m :: * -> *) a.
    (SolverContext m, QuantifiedBool a) =>
    a -> m ()
    constrain SBool
    d
                                                                                  Int -> AllSatResult -> m AllSatResult
    go (Int
    cntInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) AllSatResult
    resultsSoFar
                                                         (Maybe SBool
    Nothing, Just [Char]
    f)  -> do Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "(assert " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    f [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
                                                                                  Int -> AllSatResult -> m AllSatResult
    go (Int
    cntInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) AllSatResult
    resultsSoFar
                                                         (Just SBool
    d,  Just [Char]
    f)  -> -- This is where it gets ugly. We have an SBV and a string and we need to "or" them.
                                                                               -- But we need a way to force 'd' to be produced. So, go ahead and force it:
                                                                               do SBool -> m ()
    forall a. QuantifiedBool a => a -> m ()
    forall (m :: * -> *) a.
    (SolverContext m, QuantifiedBool a) =>
    a -> m ()
    constrain (SBool -> m ()) -> SBool -> m ()
    forall a b. (a -> b) -> a -> b
    $ SBool
    d SBool -> SBool -> SBool
    .=> SBool
    d  -- NB: Redundant, but it makes sure the corresponding constraint gets shown
                                                                                  SV
    svd <- IO SV -> m SV
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO SV -> m SV) -> IO SV -> m SV
    forall a b. (a -> b) -> a -> b
    $ State -> SVal -> IO SV
    svToSV State
    topState (SBool -> SVal
    forall a. SBV a -> SVal
    unSBV SBool
    d)
                                                                                  Bool -> [Char] -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    Bool -> [Char] -> m ()
    send Bool
    True ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "(assert (or " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    f [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    svd [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "))"
                                                                                  Int -> AllSatResult -> m AllSatResult
    go (Int
    cntInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) AllSatResult
    resultsSoFar

    -- | Generalization of 'Data.SBV.Control.getUnsatAssumptions'
    getUnsatAssumptions :: (MonadIO m, MonadQuery m) => [String] -> [(String, a)] -> m [a]
    getUnsatAssumptions :: forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [[Char]] -> [([Char], a)] -> m [a]
    getUnsatAssumptions [[Char]]
    originals [([Char], a)]
    proxyMap = do
            let cmd :: [Char]
    cmd = [Char]
    "(get-unsat-assumptions)"

                bad :: [Char] -> Maybe [[Char]] -> m [a]
    bad = [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m [a]
    forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    "getUnsatAssumptions" [Char]
    cmd [Char]
    "a list of unsatisfiable assumptions"
                               (Maybe [[Char]] -> [Char] -> Maybe [[Char]] -> m [a])
    -> Maybe [[Char]] -> [Char] -> Maybe [[Char]] -> m [a]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> Maybe [[Char]]
    forall a. a -> Maybe a
    Just [ [Char]
    "Make sure you use:"
                                      , [Char]
    ""
                                      , [Char]
    "       setOption $ ProduceUnsatAssumptions True"
                                      , [Char]
    ""
                                      , [Char]
    "to make sure the solver is ready for producing unsat assumptions,"
                                      , [Char]
    "and that there is a model by first issuing a 'checkSat' call."
                                      ]

                fromECon :: SExpr -> Maybe [Char]
    fromECon (ECon [Char]
    s) = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    s
                fromECon SExpr
    _        = Maybe [Char]
    forall a. Maybe a
    Nothing

            [Char]
    r <- [Char] -> m [Char]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> m [Char]
    ask [Char]
    cmd

            -- If unsat-cores are enabled, z3 might end-up printing an assumption that wasn't
            -- in the original list of assumptions for `check-sat-assuming`. So, we walk over
            -- and ignore those that weren't in the original list, and put a warning for those
            -- we couldn't find.
            let walk :: [[Char]] -> [a] -> m [a]
    walk []     [a]
    sofar = [a] -> m [a]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([a] -> m [a]) -> [a] -> m [a]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    sofar
                walk ([Char]
    a:[[Char]]
    as) [a]
    sofar = case [Char]
    a [Char] -> [([Char], a)] -> Maybe a
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [([Char], a)]
    proxyMap of
                                      Just a
    v  -> [[Char]] -> [a] -> m [a]
    walk [[Char]]
    as (a
    va -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    sofar)
                                      Maybe a
    Nothing -> do [[Char]] -> m ()
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => [[Char]] -> m ()
    queryDebug [ [Char]
    "*** In call to 'getUnsatAssumptions'"
                                                               , [Char]
    "***"
                                                               , [Char]
    "***    Unexpected assumption named: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    a
                                                               , [Char]
    "***    Was expecting one of       : " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show [[Char]]
    originals
                                                               , [Char]
    "***"
                                                               , [Char]
    "*** This can happen if unsat-cores are also enabled. Ignoring."
                                                               ]
                                                    [[Char]] -> [a] -> m [a]
    walk [[Char]]
    as [a]
    sofar

            [Char]
    -> ([Char] -> Maybe [[Char]] -> m [a]) -> (SExpr -> m [a]) -> m [a]
    forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> m [a]
    bad ((SExpr -> m [a]) -> m [a]) -> (SExpr -> m [a]) -> m [a]
    forall a b. (a -> b) -> a -> b
    $ \case
               EApp [SExpr]
    es | Just [[Char]]
    xs <- (SExpr -> Maybe [Char]) -> [SExpr] -> Maybe [[Char]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM SExpr -> Maybe [Char]
    fromECon [SExpr]
    es -> [[Char]] -> [a] -> m [a]
    walk [[Char]]
    xs []
               SExpr
    _                                     -> [Char] -> Maybe [[Char]] -> m [a]
    bad [Char]
    r Maybe [[Char]]
    forall a. Maybe a
    Nothing

    -- | Generalization of 'Data.SBV.Control.timeout'
    timeout :: (MonadIO m, MonadQuery m) => Int -> m a -> m a
    timeout :: forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    Int -> m a -> m a
    timeout Int
    n m a
    q = do (QueryState -> QueryState) -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    (QueryState -> QueryState) -> m ()
    modifyQueryState (\QueryState
    qs -> QueryState
    qs {queryTimeOutValue = Just n})
                     a
    r <- m a
    q
                     (QueryState -> QueryState) -> m ()
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    (QueryState -> QueryState) -> m ()
    modifyQueryState (\QueryState
    qs -> QueryState
    qs {queryTimeOutValue = Nothing})
                     a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r

    -- | Bail out if a parse goes bad
    parse :: String -> (String -> Maybe [String] -> a) -> (SExpr -> a) -> a
    parse :: forall a.
    [Char] -> ([Char] -> Maybe [[Char]] -> a) -> (SExpr -> a) -> a
    parse [Char]
    r [Char] -> Maybe [[Char]] -> a
    fCont SExpr -> a
    sCont = case [Char] -> Either [Char] SExpr
    parseSExpr [Char]
    r of
                            Left  [Char]
    e   -> [Char] -> Maybe [[Char]] -> a
    fCont [Char]
    r ([[Char]] -> Maybe [[Char]]
    forall a. a -> Maybe a
    Just [[Char]
    e])
                            Right SExpr
    res -> SExpr -> a
    sCont SExpr
    res

    -- | Generalization of 'Data.SBV.Control.unexpected'
    unexpected :: (MonadIO m, MonadQuery m) => String -> String -> String -> Maybe [String] -> String -> Maybe [String] -> m a
    unexpected :: forall (m :: * -> *) a.
    (MonadIO m, MonadQuery m) =>
    [Char]
    -> [Char]
    -> [Char]
    -> Maybe [[Char]]
    -> [Char]
    -> Maybe [[Char]]
    -> m a
    unexpected [Char]
    ctx [Char]
    sent [Char]
    expected Maybe [[Char]]
    mbHint [Char]
    received Maybe [[Char]]
    mbReason = do
            -- empty the response channel first
            [[Char]]
    extras <- [Char] -> Maybe Int -> m [[Char]]
    forall (m :: * -> *).
    (MonadIO m, MonadQuery m) =>
    [Char] -> Maybe Int -> m [[Char]]
    retrieveResponse [Char]
    "terminating upon unexpected response" (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    5000000)

            SMTConfig
    cfg <- m SMTConfig
    forall (m :: * -> *). (MonadIO m, MonadQuery m) => m SMTConfig
    getConfig

            let exc :: SBVException
    exc = SBVException { sbvExceptionDescription :: [Char]
    sbvExceptionDescription = [Char]
    "Unexpected response from the solver, context: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ctx
                                   , sbvExceptionSent :: Maybe [Char]
    sbvExceptionSent        = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    sent
                                   , sbvExceptionExpected :: Maybe [Char]
    sbvExceptionExpected    = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    expected
                                   , sbvExceptionReceived :: Maybe [Char]
    sbvExceptionReceived    = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    received
                                   , sbvExceptionStdOut :: Maybe [Char]
    sbvExceptionStdOut      = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [[Char]]
    extras
                                   , sbvExceptionStdErr :: Maybe [Char]
    sbvExceptionStdErr      = Maybe [Char]
    forall a. Maybe a
    Nothing
                                   , sbvExceptionExitCode :: Maybe ExitCode
    sbvExceptionExitCode    = Maybe ExitCode
    forall a. Maybe a
    Nothing
                                   , sbvExceptionConfig :: SMTConfig
    sbvExceptionConfig      = SMTConfig
    cfg
                                   , sbvExceptionReason :: Maybe [[Char]]
    sbvExceptionReason      = Maybe [[Char]]
    mbReason
                                   , sbvExceptionHint :: Maybe [[Char]]
    sbvExceptionHint        = Maybe [[Char]]
    mbHint
                                   }

            IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ SBVException -> IO a
    forall e a. Exception e => e -> IO a
    C.throwIO SBVException
    exc

    -- | Convert a query result to an SMT Problem
    runProofOn :: SBVRunMode -> QueryContext -> [String] -> Result -> SMTProblem
    runProofOn :: SBVRunMode -> QueryContext -> [[Char]] -> Result -> SMTProblem
    runProofOn SBVRunMode
    rm QueryContext
    context [[Char]]
    comments res :: Result
    res@(Result ProgInfo
    progInfo KindSet
    ki [([Char], CV)]
    _qcInfo [([Char], CV -> Bool, SV)]
    _observables [([Char], [[Char]])]
    _codeSegs ResultInp
    is (CnstMap, [(SV, CV)])
    consts [((Int, Kind, Kind), [SV])]
    tbls [(Int, ArrayInfo)]
    arrs [([Char], (Maybe [[Char]], SBVType))]
    uis [SMTDef]
    defns SBVPgm
    pgm Seq (Bool, [([Char], [Char])], SV)
    cstrs [([Char], Maybe CallStack, SV)]
    _assertions [SV]
    outputs) =
         let (SMTConfig
    config, Bool
    isSat, Bool
    isSafe, Bool
    isSetup) = case SBVRunMode
    rm of
                                                  SMTMode QueryContext
    _ IStage
    stage Bool
    s SMTConfig
    c -> (SMTConfig
    c, Bool
    s, IStage -> Bool
    isSafetyCheckingIStage IStage
    stage, IStage -> Bool
    isSetupIStage IStage
    stage)
                                                  SBVRunMode
    _                   -> [Char] -> (SMTConfig, Bool, Bool, Bool)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (SMTConfig, Bool, Bool, Bool))
    -> [Char] -> (SMTConfig, Bool, Bool, Bool)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "runProofOn: Unexpected run mode: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SBVRunMode -> [Char]
    forall a. Show a => a -> [Char]
    show SBVRunMode
    rm

             o :: SV
    o | Bool
    isSafe = SV
    trueSV
               | Bool
    True   = case [SV]
    outputs of
                            []  | Bool
    isSetup -> SV
    trueSV
                            [SV
    so]          -> case SV
    so of
                                               SV Kind
    KBool NodeId
    _ -> SV
    so
                                               SV
    _          -> [Char] -> SV
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> SV) -> [Char] -> SV
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Impossible happened, non-boolean output: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SV -> [Char]
    forall a. Show a => a -> [Char]
    show SV
    so
                                                                             , [Char]
    "Detected while generating the trace:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Result -> [Char]
    forall a. Show a => a -> [Char]
    show Result
    res
                                                                             ]
                            [SV]
    os  -> [Char] -> SV
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> SV) -> [Char] -> SV
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "User error: Multiple output values detected: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [SV] -> [Char]
    forall a. Show a => a -> [Char]
    show [SV]
    os
                                                   , [Char]
    "Detected while generating the trace:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Result -> [Char]
    forall a. Show a => a -> [Char]
    show Result
    res
                                                   , [Char]
    "*** Check calls to \"output\", they are typically not needed!"
                                                   ]

         in SMTProblem { smtLibPgm :: SMTConfig -> SMTLibPgm
    smtLibPgm = SMTConfig -> SMTLibConverter SMTLibPgm
    toSMTLib SMTConfig
    config QueryContext
    context ProgInfo
    progInfo KindSet
    ki Bool
    isSat [[Char]]
    comments ResultInp
    is (CnstMap, [(SV, CV)])
    consts [((Int, Kind, Kind), [SV])]
    tbls [(Int, ArrayInfo)]
    arrs [([Char], (Maybe [[Char]], SBVType))]
    uis [SMTDef]
    defns SBVPgm
    pgm Seq (Bool, [([Char], [Char])], SV)
    cstrs SV
    o }

    -- | Generalization of 'Data.SBV.Control.executeQuery'
    executeQuery :: forall m a. ExtractIO m => QueryContext -> QueryT m a -> SymbolicT m a
    executeQuery :: forall (m :: * -> *) a.
    ExtractIO m =>
    QueryContext -> QueryT m a -> SymbolicT m a
    executeQuery QueryContext
    queryContext (QueryT ReaderT State m a
    userQuery) = do
         State
    st <- SymbolicT m State
    forall (m :: * -> *). MonadSymbolic m => m State
    symbolicEnv
         SBVRunMode
    rm <- IO SBVRunMode -> SymbolicT m SBVRunMode
    forall a. IO a -> SymbolicT m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO SBVRunMode -> SymbolicT m SBVRunMode)
    -> IO SBVRunMode -> SymbolicT m SBVRunMode
    forall a b. (a -> b) -> a -> b
    $ IORef SBVRunMode -> IO SBVRunMode
    forall a. IORef a -> IO a
    readIORef (State -> IORef SBVRunMode
    runMode State
    st)

         -- Make sure the phases match:
         () <- IO () -> SymbolicT m ()
    forall a. IO a -> SymbolicT m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> SymbolicT m ()) -> IO () -> SymbolicT m ()
    forall a b. (a -> b) -> a -> b
    $ case (QueryContext
    queryContext, SBVRunMode
    rm) of
                          (QueryContext
    QueryInternal, SBVRunMode
    _)                                -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- no worries, internal
                          (QueryContext
    QueryExternal, SMTMode QueryContext
    QueryExternal IStage
    ISetup Bool
    _ SMTConfig
    _) -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- legitimate runSMT call
                          (QueryContext, SBVRunMode)
    _                                                 -> SBVRunMode -> IO ()
    forall {a} {a}. Show a => a -> a
    invalidQuery SBVRunMode
    rm

         case SBVRunMode
    rm of
            -- Transitioning from setup
            SMTMode QueryContext
    qc IStage
    stage Bool
    isSAT SMTConfig
    cfg | Bool -> Bool
    not (IStage -> Bool
    isRunIStage IStage
    stage) -> do

                      let slvr :: SMTSolver
    slvr    = SMTConfig -> SMTSolver
    solver SMTConfig
    cfg
                          backend :: SMTConfig -> State -> [Char] -> (State -> IO (m a)) -> IO (m a)
    backend = SMTSolver -> SMTEngine
    engine SMTSolver
    slvr

                      -- make sure if we have dsat precision, then solver supports it
                      let dsatOK :: Bool
    dsatOK =  Maybe Double -> Bool
    forall a. Maybe a -> Bool
    isNothing (SMTConfig -> Maybe Double
    dsatPrecision SMTConfig
    cfg)
                                 Bool -> Bool -> Bool
    || Maybe [Char] -> Bool
    forall a. Maybe a -> Bool
    isJust    (SolverCapabilities -> Maybe [Char]
    supportsDeltaSat (SMTSolver -> SolverCapabilities
    capabilities SMTSolver
    slvr))

                      Bool -> SymbolicT m () -> SymbolicT m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    dsatOK (SymbolicT m () -> SymbolicT m ())
    -> SymbolicT m () -> SymbolicT m ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SymbolicT m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> SymbolicT m ()) -> [Char] -> SymbolicT m ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines
                                         [ [Char]
    ""
                                         , [Char]
    "*** Data.SBV: Delta-sat precision is specified."
                                         , [Char]
    "***           But the chosen solver (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Solver -> [Char]
    forall a. Show a => a -> [Char]
    show (SMTSolver -> Solver
    name SMTSolver
    slvr) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ") does not support"
                                         , [Char]
    "***           delta-satisfiability."
                                         ]

                      Result
    res     <- IO Result -> SymbolicT m Result
    forall a. IO a -> SymbolicT m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> SymbolicT m Result)
    -> IO Result -> SymbolicT m Result
    forall a b. (a -> b) -> a -> b
    $ State -> IO Result
    extractSymbolicSimulationState State
    st
                      [SMTOption]
    setOpts <- IO [SMTOption] -> SymbolicT m [SMTOption]
    forall a. IO a -> SymbolicT m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SMTOption] -> SymbolicT m [SMTOption])
    -> IO [SMTOption] -> SymbolicT m [SMTOption]
    forall a b. (a -> b) -> a -> b
    $ [SMTOption] -> [SMTOption]
    forall a. [a] -> [a]
    reverse ([SMTOption] -> [SMTOption]) -> IO [SMTOption] -> IO [SMTOption]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [SMTOption] -> IO [SMTOption]
    forall a. IORef a -> IO a
    readIORef (State -> IORef [SMTOption]
    rSMTOptions State
    st)

                      let SMTProblem{SMTConfig -> SMTLibPgm
    smtLibPgm :: SMTProblem -> SMTConfig -> SMTLibPgm
    smtLibPgm :: SMTConfig -> SMTLibPgm
    smtLibPgm} = SBVRunMode -> QueryContext -> [[Char]] -> Result -> SMTProblem
    runProofOn SBVRunMode
    rm QueryContext
    queryContext [] Result
    res
                          cfg' :: SMTConfig
    cfg' = SMTConfig
    cfg { solverSetOptions = solverSetOptions cfg ++ setOpts }
                          pgm :: SMTLibPgm
    pgm  = SMTConfig -> SMTLibPgm
    smtLibPgm SMTConfig
    cfg'

                      IO () -> SymbolicT m ()
    forall a. IO a -> SymbolicT m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> SymbolicT m ()) -> IO () -> SymbolicT m ()
    forall a b. (a -> b) -> a -> b
    $ IORef SBVRunMode -> SBVRunMode -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (State -> IORef SBVRunMode
    runMode State
    st) (SBVRunMode -> IO ()) -> SBVRunMode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ QueryContext -> IStage -> Bool -> SMTConfig -> SBVRunMode
    SMTMode QueryContext
    qc IStage
    IRun Bool
    isSAT SMTConfig
    cfg

                      m a -> SymbolicT m a
    forall (m :: * -> *) a. Monad m => m a -> SymbolicT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> SymbolicT m a) -> m a -> SymbolicT m a
    forall a b. (a -> b) -> a -> b
    $ m (m a) -> m a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (m (m a) -> m a) -> m (m a) -> m a
    forall a b. (a -> b) -> a -> b
    $ IO (m a) -> m (m a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (m a) -> m (m a)) -> IO (m a) -> m (m a)
    forall a b. (a -> b) -> a -> b
    $ SMTConfig -> State -> [Char] -> (State -> IO (m a)) -> IO (m a)
    backend SMTConfig
    cfg' State
    st (SMTLibPgm -> [Char]
    forall a. Show a => a -> [Char]
    show SMTLibPgm
    pgm) ((State -> IO (m a)) -> IO (m a))
    -> (State -> IO (m a)) -> IO (m a)
    forall a b. (a -> b) -> a -> b
    $ m a -> IO (m a)
    forall a. m a -> IO (m a)
    forall (m :: * -> *) a. ExtractIO m => m a -> IO (m a)
    extractIO (m a -> IO (m a)) -> (State -> m a) -> State -> IO (m a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReaderT State m a -> State -> m a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT State m a
    userQuery

            -- Already in a query, in theory we can just continue, but that causes use-case issues
            -- so we reject it. TODO: Review if we should actually support this. The issue arises with
            -- expressions like this:
            --
            -- In the following t0's output doesn't get recorded, as the output call is too late when we get
            -- here. (The output field isn't "incremental.") So, t0/t1 behave differently!
            --
            --   t0 = satWith z3{verbose=True, transcript=Just "t.smt2"} $ query (return (false::SBool))
            --   t1 = satWith z3{verbose=True, transcript=Just "t.smt2"} $ ((return (false::SBool)) :: Predicate)
            --
            -- Also, not at all clear what it means to go in an out of query mode:
            --
            -- r = runSMTWith z3{verbose=True} $ do
            --         a' <- sInteger "a"
            --
            --        (a, av) <- query $ do _ <- checkSat
            --                              av <- getValue a'
            --                              return (a', av)
            --
            --        liftIO $ putStrLn $ "Got: " ++ show av
            --        -- constrain $ a .> literal av + 1      -- Can't do this since we're "out" of query. Sigh.
            --
            --        bv <- query $ do constrain $ a .> literal av + 1
            --                         _ <- checkSat
            --                         getValue a
            --
            --        return $ a' .== a' + 1
            --
            -- This would be one possible implementation, alas it has the problems above:
            --
            --    SMTMode IRun _ _ -> liftIO $ evalStateT userQuery st
            --
            -- So, we just reject it.

            SMTMode QueryContext
    _ IStage
    IRun Bool
    _ SMTConfig
    _ -> [Char] -> SymbolicT m a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> SymbolicT m a) -> [Char] -> SymbolicT m a
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                                  , [Char]
    "*** Data.SBV: Unsupported nested query is detected."
                                                  , [Char]
    "***"
                                                  , [Char]
    "*** Please group your queries into one block. Note that this"
                                                  , [Char]
    "*** can also arise if you have a call to 'query' not within 'runSMT'"
                                                  , [Char]
    "*** For instance, within 'sat'/'prove' calls with custom user queries."
                                                  , [Char]
    "*** The solution is to do the sat/prove part in the query directly."
                                                  , [Char]
    "***"
                                                  , [Char]
    "*** While multiple/nested queries should not be necessary in general,"
                                                  , [Char]
    "*** please do get in touch if your use case does require such a feature,"
                                                  , [Char]
    "*** to see how we can accommodate such scenarios."
                                                  ]

            -- Otherwise choke!
            SBVRunMode
    _ -> SBVRunMode -> SymbolicT m a
    forall {a} {a}. Show a => a -> a
    invalidQuery SBVRunMode
    rm

      where invalidQuery :: a -> a
    invalidQuery a
    rm = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    ""
                                              , [Char]
    "*** Data.SBV: Invalid query call."
                                              , [Char]
    "***"
                                              , [Char]
    "***   Current mode: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    rm
                                              , [Char]
    "***"
                                              , [Char]
    "*** Query calls are only valid within runSMT/runSMTWith calls,"
                                              , [Char]
    "*** and each call to runSMT should have only one query call inside."
                                              ]

    {- HLint ignore module          "Reduce duplication" -}
    {- HLint ignore getAllSatResult "Use forM_"          -}