{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Grisette.Backend.SBV.Data.SMT.Lowering
( lowerSinglePrim,
lowerSinglePrimCached,
parseModel,
SymBiMap,
)
where
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (MonadTrans (lift), ReaderT)
import Control.Monad.State (StateT)
import Data.Bifunctor (Bifunctor (bimap, first, second))
import Data.Bits
( Bits (complement, xor, (.&.), (.|.)),
)
import Data.Dynamic (Typeable, fromDyn, toDyn)
import Data.Foldable (Foldable (foldl'), asum)
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Data.SBV (SIntegral, sRotateLeft, sRotateRight, sShiftLeft, sShiftRight)
import qualified Data.SBV as SBV
import qualified Data.SBV.Internals as SBVI
import qualified Data.SBV.Trans as SBVT
import qualified Data.SBV.Trans.Control as SBVTC
import Data.Type.Equality (type (~~))
import Data.Typeable (Proxy (Proxy), type (:~:) (Refl))
import GHC.Exts (sortWith)
import GHC.Stack (HasCallStack)
import GHC.TypeNats
( KnownNat,
Nat,
natVal,
type (+),
type (-),
type (<=),
)
import {-# SOURCE #-} Grisette.Backend.SBV.Data.SMT.Solving
( ApproximationConfig (Approx, NoApprox),
ExtraConfig (integerApprox),
GrisetteSMTConfig (GrisetteSMTConfig),
TermTy,
)
import Grisette.Backend.SBV.Data.SMT.SymBiMap
( SymBiMap,
addBiMap,
addBiMapIntermediate,
emptySymBiMap,
findStringToSymbol,
lookupTerm,
sizeBiMap,
)
import Grisette.Core.Data.BV (IntN (IntN, unIntN), WordN (WordN))
import Grisette.Core.Data.Class.ModelOps
( ModelOps (emptyModel, insertValue),
)
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
( conTerm,
symTerm,
)
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.SomeTerm
( SomeTerm (SomeTerm),
)
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
( SomeTypedSymbol (SomeTypedSymbol),
SupportedPrim (withPrim),
Term
( AbsNumTerm,
AddNumTerm,
AndBitsTerm,
AndTerm,
BVConcatTerm,
BVExtendTerm,
BVSelectTerm,
BinaryTerm,
ComplementBitsTerm,
ConTerm,
DivBoundedIntegralTerm,
DivIntegralTerm,
EqvTerm,
GeneralFunApplyTerm,
ITETerm,
LENumTerm,
LTNumTerm,
ModBoundedIntegralTerm,
ModIntegralTerm,
NotTerm,
OrBitsTerm,
OrTerm,
QuotBoundedIntegralTerm,
QuotIntegralTerm,
RemBoundedIntegralTerm,
RemIntegralTerm,
RotateLeftTerm,
RotateRightTerm,
ShiftLeftTerm,
ShiftRightTerm,
SignumNumTerm,
SymTerm,
TabularFunApplyTerm,
TernaryTerm,
TimesNumTerm,
ToSignedTerm,
ToUnsignedTerm,
UMinusNumTerm,
UnaryTerm,
XorBitsTerm
),
TypedSymbol (IndexedSymbol),
buildGeneralFun,
someTypedSymbol,
withSymbolSupported,
type (-->),
)
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.TermUtils
( introSupportedPrimConstraint,
)
import Grisette.IR.SymPrim.Data.Prim.Model as PM (Model)
import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
( pevalEqvTerm,
pevalITETerm,
)
import Grisette.IR.SymPrim.Data.TabularFun
( type (=->) (TabularFun),
)
import Grisette.Utils.Parameterized
( KnownProof (KnownProof),
LeqProof (LeqProof),
unsafeAxiom,
unsafeKnownProof,
unsafeLeqProof,
withKnownProof,
)
import qualified Type.Reflection as R
translateTypeError :: (HasCallStack) => R.TypeRep a -> b
translateTypeError :: forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError TypeRep a
ta =
[Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$
[Char]
"Don't know how to translate the type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
ta [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to SMT"
translateUnaryError :: (HasCallStack) => String -> R.TypeRep a -> R.TypeRep b -> c
translateUnaryError :: forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
op TypeRep a
ta TypeRep b
tb =
[Char] -> c
forall a. HasCallStack => [Char] -> a
error ([Char] -> c) -> [Char] -> c
forall a b. (a -> b) -> a -> b
$
[Char]
"Don't know how to translate the op "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
op
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" :: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
ta
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep b -> [Char]
forall a. Show a => a -> [Char]
show TypeRep b
tb
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to SMT"
translateBinaryError :: (HasCallStack) => String -> R.TypeRep a -> R.TypeRep b -> R.TypeRep c -> d
translateBinaryError :: forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
op TypeRep a
ta TypeRep b
tb TypeRep c
tc =
[Char] -> d
forall a. HasCallStack => [Char] -> a
error ([Char] -> d) -> [Char] -> d
forall a b. (a -> b) -> a -> b
$
[Char]
"Don't know how to translate the op "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
op
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" :: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
ta
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep b -> [Char]
forall a. Show a => a -> [Char]
show TypeRep b
tb
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep c -> [Char]
forall a. Show a => a -> [Char]
show TypeRep c
tc
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to SMT"
translateTernaryError :: (HasCallStack) => String -> R.TypeRep a -> R.TypeRep b -> R.TypeRep c -> R.TypeRep d -> e
translateTernaryError :: forall {k} {k} {k} {k} (a :: k) (b :: k) (c :: k) (d :: k) e.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> e
translateTernaryError [Char]
op TypeRep a
ta TypeRep b
tb TypeRep c
tc TypeRep d
td =
[Char] -> e
forall a. HasCallStack => [Char] -> a
error ([Char] -> e) -> [Char] -> e
forall a b. (a -> b) -> a -> b
$
[Char]
"Don't know how to translate the op "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
op
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" :: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep a -> [Char]
forall a. Show a => a -> [Char]
show TypeRep a
ta
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep b -> [Char]
forall a. Show a => a -> [Char]
show TypeRep b
tb
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep c -> [Char]
forall a. Show a => a -> [Char]
show TypeRep c
tc
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep d -> [Char]
forall a. Show a => a -> [Char]
show TypeRep d
td
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to SMT"
lowerValue ::
forall integerBitWidth a.
(SupportedPrim a, Typeable a) =>
GrisetteSMTConfig integerBitWidth ->
a ->
TermTy integerBitWidth a
lowerValue :: forall (integerBitWidth :: Nat) a.
(SupportedPrim a, Typeable a) =>
GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
lowerValue config :: GrisetteSMTConfig integerBitWidth
config@ResolvedConfig {} a
v =
case forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a of
TypeRep a
BoolType -> if a
Bool
v then SBool
TermTy integerBitWidth a
SBV.sTrue else SBool
TermTy integerBitWidth a
SBV.sFalse
TypeRep a
IntegerType -> Integer -> SBV s
forall a. Num a => Integer -> a
fromInteger a
Integer
v
SignedBVType Proxy n
_ -> case a
v of
IntN Integer
x -> Integer -> SBV (IntN n)
forall a. Num a => Integer -> a
fromInteger Integer
x
UnsignedBVType Proxy n
_ -> case a
v of
WordN Integer
x -> Integer -> SBV (WordN n)
forall a. Num a => Integer -> a
fromInteger Integer
x
TFunType (TypeRep a
l :: a1) (TypeRep b
r :: a2) ->
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep a
l), (GrisetteSMTConfig integerBitWidth
config, TypeRep b
r)) of
((GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep b)
ResolvedMergeableType) ->
GrisetteSMTConfig integerBitWidth
-> (a =-> b)
-> TermTy integerBitWidth a
-> TermTy integerBitWidth b
forall (integerBitWidth :: Nat) a b.
(SupportedPrim a, SupportedPrim b,
EqSymbolic (TermTy integerBitWidth a),
Mergeable (TermTy integerBitWidth b)) =>
GrisetteSMTConfig integerBitWidth
-> (a =-> b)
-> TermTy integerBitWidth a
-> TermTy integerBitWidth b
lowerTFunCon GrisetteSMTConfig integerBitWidth
config a
a =-> b
v
((GrisetteSMTConfig integerBitWidth, TypeRep a),
(GrisetteSMTConfig integerBitWidth, TypeRep b))
_ -> TypeRep a -> TermTy integerBitWidth a -> TermTy integerBitWidth b
forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
TypeRep a
_ -> TypeRep a -> TermTy integerBitWidth a
forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerValue GrisetteSMTConfig integerBitWidth
_ a
_ = TypeRep a -> TermTy integerBitWidth a
forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerTFunCon ::
forall integerBitWidth a b.
(SupportedPrim a, SupportedPrim b, SBV.EqSymbolic (TermTy integerBitWidth a), SBV.Mergeable (TermTy integerBitWidth b)) =>
GrisetteSMTConfig integerBitWidth ->
(a =-> b) ->
(TermTy integerBitWidth a -> TermTy integerBitWidth b)
lowerTFunCon :: forall (integerBitWidth :: Nat) a b.
(SupportedPrim a, SupportedPrim b,
EqSymbolic (TermTy integerBitWidth a),
Mergeable (TermTy integerBitWidth b)) =>
GrisetteSMTConfig integerBitWidth
-> (a =-> b)
-> TermTy integerBitWidth a
-> TermTy integerBitWidth b
lowerTFunCon config :: GrisetteSMTConfig integerBitWidth
config@ResolvedConfig {} (TabularFun [(a, b)]
l b
d) = [(a, b)]
-> b -> TermTy integerBitWidth a -> TermTy integerBitWidth b
go [(a, b)]
l b
d
where
go :: [(a, b)]
-> b -> TermTy integerBitWidth a -> TermTy integerBitWidth b
go [] b
d TermTy integerBitWidth a
_ = GrisetteSMTConfig integerBitWidth -> b -> TermTy integerBitWidth b
forall (integerBitWidth :: Nat) a.
(SupportedPrim a, Typeable a) =>
GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
lowerValue GrisetteSMTConfig integerBitWidth
config b
d
go ((a
x, b
r) : [(a, b)]
xs) b
d TermTy integerBitWidth a
v = SBool
-> TermTy integerBitWidth b
-> TermTy integerBitWidth b
-> TermTy integerBitWidth b
forall a. Mergeable a => SBool -> a -> a -> a
SBV.ite (GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
forall (integerBitWidth :: Nat) a.
(SupportedPrim a, Typeable a) =>
GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
lowerValue GrisetteSMTConfig integerBitWidth
config a
x TermTy integerBitWidth a -> TermTy integerBitWidth a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
SBV..== TermTy integerBitWidth a
v) (GrisetteSMTConfig integerBitWidth -> b -> TermTy integerBitWidth b
forall (integerBitWidth :: Nat) a.
(SupportedPrim a, Typeable a) =>
GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
lowerValue GrisetteSMTConfig integerBitWidth
config b
r) ([(a, b)]
-> b -> TermTy integerBitWidth a -> TermTy integerBitWidth b
go [(a, b)]
xs b
d TermTy integerBitWidth a
v)
lowerTFunCon GrisetteSMTConfig integerBitWidth
_ TabularFun {} = TypeRep a -> TermTy integerBitWidth a -> TermTy integerBitWidth b
forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
buildUTFun11 ::
forall integerBitWidth s1 s2 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2))
buildUTFun11 :: forall (integerBitWidth :: Nat) s1 s2 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2))
buildUTFun11 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m = case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth s1 -> TermTy integerBitWidth s2
f = forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth s1 -> TermTy integerBitWidth s2) [Char]
name
in (SymBiMap, SBV s' -> SBV s') -> Maybe (SymBiMap, SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s' -> SBV s'
TermTy integerBitWidth s1 -> TermTy integerBitWidth s2
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s' -> SBV s'
TermTy integerBitWidth s1 -> TermTy integerBitWidth s2
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2))
_ -> Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2))
Maybe
(SymBiMap, TermTy integerBitWidth s1 -> TermTy integerBitWidth s2)
forall a. Maybe a
Nothing
buildUTFun11 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap, TermTy integerBitWidth s1 -> TermTy integerBitWidth s2)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUTFun111 ::
forall integerBitWidth s1 s2 s3 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2, SupportedPrim s3) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2 =-> s3))
buildUTFun111 :: forall (integerBitWidth :: Nat) s1 s2 s3 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> (s2 =-> s3)))
buildUTFun111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth s1 -> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3)
[Char]
name
in (SymBiMap, SBV s' -> SBV s' -> SBV s')
-> Maybe (SymBiMap, SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3))
_ -> Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> (s2 =-> s3)))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3)
forall a. Maybe a
Nothing
buildUTFun111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUTFun1111 ::
forall integerBitWidth s1 s2 s3 s4 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2, SupportedPrim s3, SupportedPrim s4) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4))
buildUTFun1111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap, TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> s4))))
buildUTFun1111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth s1 -> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3 -> TermTy integerBitWidth s4)
[Char]
name
in (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s' -> SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s' -> SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4))
_ -> Maybe
(SymBiMap, TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> s4))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4)
forall a. Maybe a
Nothing
buildUTFun1111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUTFun11111 ::
forall integerBitWidth s1 s2 s3 s4 s5 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2, SupportedPrim s3, SupportedPrim s4, SupportedPrim s5) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5))
buildUTFun11111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> s5)))))
buildUTFun11111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> s5))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5))
[Char]
name
in (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> s5))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> s5))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5))
_ -> Maybe
(SymBiMap,
TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> s5)))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5)
forall a. Maybe a
Nothing
buildUTFun11111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUTFun111111 ::
forall integerBitWidth s1 s2 s3 s4 s5 s6 a.
( SupportedPrim a,
SupportedPrim s1,
SupportedPrim s2,
SupportedPrim s3,
SupportedPrim s4,
SupportedPrim s5,
SupportedPrim s6
) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
R.TypeRep s6 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5 =-> s6))
buildUTFun111111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> s6))))))
buildUTFun111111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te TypeRep s6
tf term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te), (GrisetteSMTConfig integerBitWidth
config, TypeRep s6
tf)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s6)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy
integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> s6)))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5 =-> s6))
[Char]
name
in (SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe
(SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy
integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> s6)))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy
integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> s6)))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5),
(GrisetteSMTConfig integerBitWidth, TypeRep s6))
_ -> Maybe
(SymBiMap,
TermTy
integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> s6))))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6)
forall a. Maybe a
Nothing
buildUTFun111111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ TypeRep s6
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUTFun1111111 ::
forall integerBitWidth s1 s2 s3 s4 s5 s6 s7 a.
( SupportedPrim a,
SupportedPrim s1,
SupportedPrim s2,
SupportedPrim s3,
SupportedPrim s4,
SupportedPrim s5,
SupportedPrim s6,
SupportedPrim s7
) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
R.TypeRep s6 ->
R.TypeRep s7 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5 =-> s6 =-> s7))
buildUTFun1111111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> s7)))))))
buildUTFun1111111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te TypeRep s6
tf TypeRep s7
tg term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te), (GrisetteSMTConfig integerBitWidth
config, TypeRep s6
tf), (GrisetteSMTConfig integerBitWidth
config, TypeRep s7
tg)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s6)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s7)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> s7))))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5 =-> s6 =-> s7))
[Char]
name
in (SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe
(SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s'
-> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> s7))))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> s7))))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5),
(GrisetteSMTConfig integerBitWidth, TypeRep s6),
(GrisetteSMTConfig integerBitWidth, TypeRep s7))
_ -> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> s7)))))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7)
forall a. Maybe a
Nothing
buildUTFun1111111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ TypeRep s6
_ TypeRep s7
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUTFun11111111 ::
forall integerBitWidth s1 s2 s3 s4 s5 s6 s7 s8 a.
( SupportedPrim a,
SupportedPrim s1,
SupportedPrim s2,
SupportedPrim s3,
SupportedPrim s4,
SupportedPrim s5,
SupportedPrim s6,
SupportedPrim s7,
SupportedPrim s8
) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
R.TypeRep s6 ->
R.TypeRep s7 ->
R.TypeRep s8 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5 =-> s6 =-> s7 =-> s8))
buildUTFun11111111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 s8 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7, SupportedPrim s8) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> TypeRep s8
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> (s7 =-> s8))))))))
buildUTFun11111111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te TypeRep s6
tf TypeRep s7
tg TypeRep s8
th term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te), (GrisetteSMTConfig integerBitWidth
config, TypeRep s6
tf), (GrisetteSMTConfig integerBitWidth
config, TypeRep s7
tg), (GrisetteSMTConfig integerBitWidth
config, TypeRep s8
th)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s6)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s7)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s8)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> (s7 =-> s8)))))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 =-> s2 =-> s3 =-> s4 =-> s5 =-> s6 =-> s7 =-> s8))
[Char]
name
in (SymBiMap,
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s')
-> Maybe
(SymBiMap,
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s')
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> (s7 =-> s8)))))))
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> (s7 =-> s8)))))))
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5),
(GrisetteSMTConfig integerBitWidth, TypeRep s6),
(GrisetteSMTConfig integerBitWidth, TypeRep s7),
(GrisetteSMTConfig integerBitWidth, TypeRep s8))
_ -> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> (s7 =-> s8))))))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7
-> TermTy integerBitWidth s8)
forall a. Maybe a
Nothing
buildUTFun11111111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ TypeRep s6
_ TypeRep s7
_ TypeRep s8
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7
-> TermTy integerBitWidth s8)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun11 ::
forall integerBitWidth s1 s2 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2))
buildUGFun11 :: forall (integerBitWidth :: Nat) s1 s2 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2))
buildUGFun11 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m = case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth s1 -> TermTy integerBitWidth s2
f = forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth s1 -> TermTy integerBitWidth s2) [Char]
name
in (SymBiMap, SBV s' -> SBV s') -> Maybe (SymBiMap, SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s' -> SBV s'
TermTy integerBitWidth s1 -> TermTy integerBitWidth s2
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s' -> SBV s'
TermTy integerBitWidth s1 -> TermTy integerBitWidth s2
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2))
_ -> Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2))
Maybe
(SymBiMap, TermTy integerBitWidth s1 -> TermTy integerBitWidth s2)
forall a. Maybe a
Nothing
buildUGFun11 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap, TermTy integerBitWidth s1 -> TermTy integerBitWidth s2)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun111 ::
forall integerBitWidth s1 s2 s3 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2, SupportedPrim s3) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2 --> s3))
buildUGFun111 :: forall (integerBitWidth :: Nat) s1 s2 s3 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 --> (s2 --> s3)))
buildUGFun111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m = case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth s1 -> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3)
[Char]
name
in (SymBiMap, SBV s' -> SBV s' -> SBV s')
-> Maybe (SymBiMap, SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3))
_ -> Maybe (SymBiMap, TermTy integerBitWidth (s1 --> (s2 --> s3)))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3)
forall a. Maybe a
Nothing
buildUGFun111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun1111 ::
forall integerBitWidth s1 s2 s3 s4 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2, SupportedPrim s3, SupportedPrim s4) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2 --> s3 --> s4))
buildUGFun1111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap, TermTy integerBitWidth (s1 --> (s2 --> (s3 --> s4))))
buildUGFun1111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth s1 -> TermTy integerBitWidth s2 -> TermTy integerBitWidth s3 -> TermTy integerBitWidth s4)
[Char]
name
in (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s' -> SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s' -> SBV s' -> SBV s' -> SBV s'
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4))
_ -> Maybe
(SymBiMap, TermTy integerBitWidth (s1 --> (s2 --> (s3 --> s4))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4)
forall a. Maybe a
Nothing
buildUGFun1111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun11111 ::
forall integerBitWidth s1 s2 s3 s4 s5 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2, SupportedPrim s3, SupportedPrim s4, SupportedPrim s5) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5))
buildUGFun11111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> s5)))))
buildUGFun11111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> s5))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5))
[Char]
name
in (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe (SymBiMap, SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s') -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> s5))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> s5))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5))
_ -> Maybe
(SymBiMap,
TermTy integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> s5)))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5)
forall a. Maybe a
Nothing
buildUGFun11111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun111111 ::
forall integerBitWidth s1 s2 s3 s4 s5 s6 a.
( SupportedPrim a,
SupportedPrim s1,
SupportedPrim s2,
SupportedPrim s3,
SupportedPrim s4,
SupportedPrim s5,
SupportedPrim s6
) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
R.TypeRep s6 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5 --> s6))
buildUGFun111111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> (s5 --> s6))))))
buildUGFun111111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te TypeRep s6
tf term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te), (GrisetteSMTConfig integerBitWidth
config, TypeRep s6
tf)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s6)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy
integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> (s5 --> s6)))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5 --> s6))
[Char]
name
in (SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe
(SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy
integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> (s5 --> s6)))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy
integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> (s5 --> s6)))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5),
(GrisetteSMTConfig integerBitWidth, TypeRep s6))
_ -> Maybe
(SymBiMap,
TermTy
integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> (s5 --> s6))))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6)
forall a. Maybe a
Nothing
buildUGFun111111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ TypeRep s6
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun1111111 ::
forall integerBitWidth s1 s2 s3 s4 s5 s6 s7 a.
( SupportedPrim a,
SupportedPrim s1,
SupportedPrim s2,
SupportedPrim s3,
SupportedPrim s4,
SupportedPrim s5,
SupportedPrim s6,
SupportedPrim s7
) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
R.TypeRep s6 ->
R.TypeRep s7 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5 --> s6 --> s7))
buildUGFun1111111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> s7)))))))
buildUGFun1111111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te TypeRep s6
tf TypeRep s7
tg term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te), (GrisetteSMTConfig integerBitWidth
config, TypeRep s6
tf), (GrisetteSMTConfig integerBitWidth
config, TypeRep s7
tg)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s6)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s7)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> s7))))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5 --> s6 --> s7))
[Char]
name
in (SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Maybe
(SymBiMap,
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s'
-> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s')
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> s7))))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> s7))))))
SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s' -> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5),
(GrisetteSMTConfig integerBitWidth, TypeRep s6),
(GrisetteSMTConfig integerBitWidth, TypeRep s7))
_ -> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> s7)))))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7)
forall a. Maybe a
Nothing
buildUGFun1111111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ TypeRep s6
_ TypeRep s7
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
buildUGFun11111111 ::
forall integerBitWidth s1 s2 s3 s4 s5 s6 s7 s8 a.
( SupportedPrim a,
SupportedPrim s1,
SupportedPrim s2,
SupportedPrim s3,
SupportedPrim s4,
SupportedPrim s5,
SupportedPrim s6,
SupportedPrim s7,
SupportedPrim s8
) =>
GrisetteSMTConfig integerBitWidth ->
R.TypeRep s1 ->
R.TypeRep s2 ->
R.TypeRep s3 ->
R.TypeRep s4 ->
R.TypeRep s5 ->
R.TypeRep s6 ->
R.TypeRep s7 ->
R.TypeRep s8 ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5 --> s6 --> s7 --> s8))
buildUGFun11111111 :: forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 s8 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7, SupportedPrim s8) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> TypeRep s8
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> (s7 --> s8))))))))
buildUGFun11111111 GrisetteSMTConfig integerBitWidth
config TypeRep s1
ta TypeRep s2
tb TypeRep s3
tc TypeRep s4
td TypeRep s5
te TypeRep s6
tf TypeRep s7
tg TypeRep s8
th term :: Term a
term@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
case ((GrisetteSMTConfig integerBitWidth
config, TypeRep s1
ta), (GrisetteSMTConfig integerBitWidth
config, TypeRep s2
tb), (GrisetteSMTConfig integerBitWidth
config, TypeRep s3
tc), (GrisetteSMTConfig integerBitWidth
config, TypeRep s4
td), (GrisetteSMTConfig integerBitWidth
config, TypeRep s5
te), (GrisetteSMTConfig integerBitWidth
config, TypeRep s6
tf), (GrisetteSMTConfig integerBitWidth
config, TypeRep s7
tg), (GrisetteSMTConfig integerBitWidth
config, TypeRep s8
th)) of
((GrisetteSMTConfig integerBitWidth, TypeRep s1)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s2)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s3)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s4)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s5)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s6)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s7)
ResolvedSimpleType, (GrisetteSMTConfig integerBitWidth, TypeRep s8)
ResolvedSimpleType) ->
let name :: [Char]
name = [Char]
"ufunc_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show (SymBiMap -> Id
sizeBiMap SymBiMap
m)
f :: TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> (s7 --> s8)))))))
f =
forall a. SMTDefinable a => [Char] -> a
SBV.uninterpret @(TermTy integerBitWidth (s1 --> s2 --> s3 --> s4 --> s5 --> s6 --> s7 --> s8))
[Char]
name
in (SymBiMap,
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s')
-> Maybe
(SymBiMap,
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s')
forall a. a -> Maybe a
Just (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
term) ((SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s')
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> (s7 --> s8)))))))
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
f) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> (s7 --> s8)))))))
SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
-> SBV s'
f)
((GrisetteSMTConfig integerBitWidth, TypeRep s1),
(GrisetteSMTConfig integerBitWidth, TypeRep s2),
(GrisetteSMTConfig integerBitWidth, TypeRep s3),
(GrisetteSMTConfig integerBitWidth, TypeRep s4),
(GrisetteSMTConfig integerBitWidth, TypeRep s5),
(GrisetteSMTConfig integerBitWidth, TypeRep s6),
(GrisetteSMTConfig integerBitWidth, TypeRep s7),
(GrisetteSMTConfig integerBitWidth, TypeRep s8))
_ -> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> (s7 --> s8))))))))
Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7
-> TermTy integerBitWidth s8)
forall a. Maybe a
Nothing
buildUGFun11111111 GrisetteSMTConfig integerBitWidth
_ TypeRep s1
_ TypeRep s2
_ TypeRep s3
_ TypeRep s4
_ TypeRep s5
_ TypeRep s6
_ TypeRep s7
_ TypeRep s8
_ Term a
_ SymBiMap
_ = [Char]
-> Maybe
(SymBiMap,
TermTy integerBitWidth s1
-> TermTy integerBitWidth s2
-> TermTy integerBitWidth s3
-> TermTy integerBitWidth s4
-> TermTy integerBitWidth s5
-> TermTy integerBitWidth s6
-> TermTy integerBitWidth s7
-> TermTy integerBitWidth s8)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should only be called on SymTerm"
lowerSinglePrimUFun ::
forall integerBitWidth a.
GrisetteSMTConfig integerBitWidth ->
Term a ->
SymBiMap ->
Maybe (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimUFun :: forall (integerBitWidth :: Nat) a.
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> Maybe (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimUFun GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(SymTerm Id
_ TypedSymbol a
_) SymBiMap
m =
case forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a of
TFun8Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 TypeRep h
t8 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep h
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(a =-> (b =-> (c =-> (d =-> (e =-> (f =-> (g =-> h))))))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 s8 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7, SupportedPrim s8) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> TypeRep s8
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> (s7 =-> s8))))))))
buildUTFun11111111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 TypeRep h
t8 Term a
t SymBiMap
m
TFun7Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth (a =-> (b =-> (c =-> (d =-> (e =-> (f =-> g)))))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> (s6 =-> s7)))))))
buildUTFun1111111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 Term a
t SymBiMap
m
TFun6Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (a =-> (b =-> (c =-> (d =-> (e =-> f))))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> (s5 =-> s6))))))
buildUTFun111111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 Term a
t SymBiMap
m
TFun5Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (a =-> (b =-> (c =-> (d =-> e)))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> (s4 =-> s5)))))
buildUTFun11111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 Term a
t SymBiMap
m
TFun4Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap, TermTy integerBitWidth (a =-> (b =-> (c =-> d))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap, TermTy integerBitWidth (s1 =-> (s2 =-> (s3 =-> s4))))
buildUTFun1111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 Term a
t SymBiMap
m
TFun3Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (a =-> (b =-> c)))
forall (integerBitWidth :: Nat) s1 s2 s3 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> (s2 =-> s3)))
buildUTFun111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 Term a
t SymBiMap
m
TFunType TypeRep a
t1 TypeRep b
t2 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (a =-> b))
forall (integerBitWidth :: Nat) s1 s2 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 =-> s2))
buildUTFun11 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 Term a
t SymBiMap
m
GFun8Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 TypeRep h
t8 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep h
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(a --> (b --> (c --> (d --> (e --> (f --> (g --> h))))))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 s8 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7, SupportedPrim s8) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> TypeRep s8
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> (s7 --> s8))))))))
buildUGFun11111111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 TypeRep h
t8 Term a
t SymBiMap
m
GFun7Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth (a --> (b --> (c --> (d --> (e --> (f --> g)))))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 s7 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6, SupportedPrim s7) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> TypeRep s7
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth
(s1 --> (s2 --> (s3 --> (s4 --> (s5 --> (s6 --> s7)))))))
buildUGFun1111111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 TypeRep g
t7 Term a
t SymBiMap
m
GFun6Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (a --> (b --> (c --> (d --> (e --> f))))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 s6 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5,
SupportedPrim s6) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> TypeRep s6
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy
integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> (s5 --> s6))))))
buildUGFun111111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 TypeRep f
t6 Term a
t SymBiMap
m
GFun5Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (a --> (b --> (c --> (d --> e)))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 s5 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4, SupportedPrim s5) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> TypeRep s5
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap,
TermTy integerBitWidth (s1 --> (s2 --> (s3 --> (s4 --> s5)))))
buildUGFun11111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 TypeRep e
t5 Term a
t SymBiMap
m
GFun4Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap, TermTy integerBitWidth (a --> (b --> (c --> d))))
forall (integerBitWidth :: Nat) s1 s2 s3 s4 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3, SupportedPrim s4) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> TypeRep s4
-> Term a
-> SymBiMap
-> Maybe
(SymBiMap, TermTy integerBitWidth (s1 --> (s2 --> (s3 --> s4))))
buildUGFun1111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 TypeRep d
t4 Term a
t SymBiMap
m
GFun3Type TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> TypeRep c
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (a --> (b --> c)))
forall (integerBitWidth :: Nat) s1 s2 s3 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2,
SupportedPrim s3) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> TypeRep s3
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 --> (s2 --> s3)))
buildUGFun111 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 TypeRep c
t3 Term a
t SymBiMap
m
GFunType TypeRep a
t1 TypeRep b
t2 -> GrisetteSMTConfig integerBitWidth
-> TypeRep a
-> TypeRep b
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (a --> b))
forall (integerBitWidth :: Nat) s1 s2 a.
(SupportedPrim a, SupportedPrim s1, SupportedPrim s2) =>
GrisetteSMTConfig integerBitWidth
-> TypeRep s1
-> TypeRep s2
-> Term a
-> SymBiMap
-> Maybe (SymBiMap, TermTy integerBitWidth (s1 --> s2))
buildUGFun11 GrisetteSMTConfig integerBitWidth
config TypeRep a
t1 TypeRep b
t2 Term a
t SymBiMap
m
TypeRep a
_ -> Maybe (SymBiMap, TermTy integerBitWidth a)
forall a. Maybe a
Nothing
lowerSinglePrimUFun GrisetteSMTConfig integerBitWidth
_ Term a
_ SymBiMap
_ = [Char] -> Maybe (SymBiMap, TermTy integerBitWidth a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should not call this function"
class (Monad m) => SBVFreshMonad m where
sbvFresh :: (SBV.SymVal a) => String -> m (SBV.SBV a)
instance (MonadIO m) => SBVFreshMonad (SBVT.SymbolicT m) where
sbvFresh :: forall a. SymVal a => [Char] -> SymbolicT m (SBV a)
sbvFresh = [Char] -> SymbolicT m (SBV a)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV a)
SBVT.free
instance (MonadIO m) => SBVFreshMonad (SBVTC.QueryT m) where
sbvFresh :: forall a. SymVal a => [Char] -> QueryT m (SBV a)
sbvFresh = [Char] -> QueryT m (SBV a)
forall a (m :: * -> *).
(MonadIO m, MonadQuery m, SymVal a) =>
[Char] -> m (SBV a)
SBVTC.freshVar
instance (SBVFreshMonad m) => SBVFreshMonad (ReaderT r m) where
sbvFresh :: forall a. SymVal a => [Char] -> ReaderT r m (SBV a)
sbvFresh = m (SBV a) -> ReaderT r m (SBV a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (SBV a) -> ReaderT r m (SBV a))
-> ([Char] -> m (SBV a)) -> [Char] -> ReaderT r m (SBV a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m (SBV a)
forall a. SymVal a => [Char] -> m (SBV a)
forall (m :: * -> *) a.
(SBVFreshMonad m, SymVal a) =>
[Char] -> m (SBV a)
sbvFresh
instance (SBVFreshMonad m) => SBVFreshMonad (StateT s m) where
sbvFresh :: forall a. SymVal a => [Char] -> StateT s m (SBV a)
sbvFresh = m (SBV a) -> StateT s m (SBV a)
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (SBV a) -> StateT s m (SBV a))
-> ([Char] -> m (SBV a)) -> [Char] -> StateT s m (SBV a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m (SBV a)
forall a. SymVal a => [Char] -> m (SBV a)
forall (m :: * -> *) a.
(SBVFreshMonad m, SymVal a) =>
[Char] -> m (SBV a)
sbvFresh
lowerUnaryTerm ::
forall integerBitWidth a a1 x x1 m.
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x, HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth ->
Term x ->
Term a ->
(a1 -> x1) ->
SymBiMap ->
m (SymBiMap, x1)
lowerUnaryTerm :: forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term x
orig Term a
t1 a1 -> x1
f SymBiMap
m = do
(SymBiMap
m1, a1
l1) <- GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
t1 SymBiMap
m
let g :: x1
g = a1 -> x1
f a1
l1
(SymBiMap, x1) -> m (SymBiMap, x1)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
addBiMapIntermediate (Term x -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term x
orig) (x1 -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn x1
g) SymBiMap
m1, x1
g)
lowerBinaryTerm ::
forall integerBitWidth a b a1 b1 x x1 m.
(Typeable x1, a1 ~ TermTy integerBitWidth a, b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth ->
Term x ->
Term a ->
Term b ->
(a1 -> b1 -> x1) ->
SymBiMap ->
m (SymBiMap, x1)
lowerBinaryTerm :: forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term x
orig Term a
t1 Term b
t2 a1 -> b1 -> x1
f SymBiMap
m = do
(SymBiMap
m1, a1
l1) <- GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
t1 SymBiMap
m
(SymBiMap
m2, b1
l2) <- GrisetteSMTConfig integerBitWidth
-> Term b -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth b)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term b
t2 SymBiMap
m1
let g :: x1
g = a1 -> b1 -> x1
f a1
l1 b1
l2
(SymBiMap, x1) -> m (SymBiMap, x1)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
addBiMapIntermediate (Term x -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term x
orig) (x1 -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn x1
g) SymBiMap
m2, x1
g)
lowerSinglePrimCached ::
forall integerBitWidth a m.
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth ->
Term a ->
SymBiMap ->
m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached :: forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
t SymBiMap
m =
Term a
-> (SupportedPrim a => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall t a. Term t -> (SupportedPrim t => a) -> a
introSupportedPrimConstraint Term a
t ((SupportedPrim a => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (SupportedPrim a => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedDeepType ->
case HasCallStack => SomeTerm -> SymBiMap -> Maybe Dynamic
SomeTerm -> SymBiMap -> Maybe Dynamic
lookupTerm (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
t) SymBiMap
m of
Just Dynamic
x -> (SymBiMap, s') -> m (SymBiMap, s')
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SymBiMap
m, Dynamic -> s' -> s'
forall a. Typeable a => Dynamic -> a -> a
fromDyn Dynamic
x s'
forall a. HasCallStack => a
undefined)
Maybe Dynamic
Nothing -> GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config Term a
t SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrim ::
forall integerBitWidth a m.
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth ->
Term a ->
m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrim :: forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrim GrisetteSMTConfig integerBitWidth
config Term a
t = GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
t SymBiMap
emptySymBiMap
lowerSinglePrimImpl ::
forall integerBitWidth a m.
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth ->
Term a ->
SymBiMap ->
m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimImpl :: forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimImpl config :: GrisetteSMTConfig integerBitWidth
config@ResolvedConfig {} (ConTerm Id
_ a
v) SymBiMap
m = (SymBiMap, TermTy integerBitWidth a)
-> m (SymBiMap, TermTy integerBitWidth a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SymBiMap
m, GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
forall (integerBitWidth :: Nat) a.
(SupportedPrim a, Typeable a) =>
GrisetteSMTConfig integerBitWidth -> a -> TermTy integerBitWidth a
lowerValue GrisetteSMTConfig integerBitWidth
config a
v)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(SymTerm Id
_ TypedSymbol a
ts) SymBiMap
m =
m (SymBiMap, TermTy integerBitWidth a)
-> Maybe (m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a. a -> Maybe a -> a
fromMaybe m (SymBiMap, TermTy integerBitWidth a)
forall x. x
errorMsg (Maybe (m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> Maybe (m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$ [Maybe (m (SymBiMap, TermTy integerBitWidth a))]
-> Maybe (m (SymBiMap, TermTy integerBitWidth a))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe (m (SymBiMap, TermTy integerBitWidth a))
simple, Maybe (m (SymBiMap, TermTy integerBitWidth a))
ufunc]
where
errorMsg :: forall x. x
errorMsg :: forall x. x
errorMsg = TypeRep a -> x
forall {k} (a :: k) b. HasCallStack => TypeRep a -> b
translateTypeError (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
simple :: Maybe (m (SymBiMap, TermTy integerBitWidth a))
simple :: Maybe (m (SymBiMap, TermTy integerBitWidth a))
simple = case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSimpleType -> m (SymBiMap, TermTy integerBitWidth a)
-> Maybe (m (SymBiMap, TermTy integerBitWidth a))
forall a. a -> Maybe a
Just (m (SymBiMap, TermTy integerBitWidth a)
-> Maybe (m (SymBiMap, TermTy integerBitWidth a)))
-> m (SymBiMap, TermTy integerBitWidth a)
-> Maybe (m (SymBiMap, TermTy integerBitWidth a))
forall a b. (a -> b) -> a -> b
$ do
let name :: [Char]
name = TypedSymbol a -> [Char]
forall a. Show a => a -> [Char]
show TypedSymbol a
ts
(TermTy integerBitWidth a
g :: TermTy integerBitWidth a) <- [Char] -> m (SBV s')
forall a. SymVal a => [Char] -> m (SBV a)
forall (m :: * -> *) a.
(SBVFreshMonad m, SymVal a) =>
[Char] -> m (SBV a)
sbvFresh [Char]
name
(SymBiMap, SBV s') -> m (SymBiMap, SBV s')
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack =>
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
SomeTerm
-> Dynamic -> [Char] -> SomeTypedSymbol -> SymBiMap -> SymBiMap
addBiMap (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
t) (SBV s' -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn SBV s'
TermTy integerBitWidth a
g) [Char]
name (TypedSymbol a -> SomeTypedSymbol
forall t. TypedSymbol t -> SomeTypedSymbol
someTypedSymbol TypedSymbol a
ts) SymBiMap
m, SBV s'
TermTy integerBitWidth a
g)
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> Maybe (m (SymBiMap, TermTy integerBitWidth a))
forall a. Maybe a
Nothing
ufunc :: (Maybe (m (SymBiMap, TermTy integerBitWidth a)))
ufunc :: Maybe (m (SymBiMap, TermTy integerBitWidth a))
ufunc = (SymBiMap, TermTy integerBitWidth a)
-> m (SymBiMap, TermTy integerBitWidth a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SymBiMap, TermTy integerBitWidth a)
-> m (SymBiMap, TermTy integerBitWidth a))
-> Maybe (SymBiMap, TermTy integerBitWidth a)
-> Maybe (m (SymBiMap, TermTy integerBitWidth a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> Maybe (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a.
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> Maybe (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimUFun GrisetteSMTConfig integerBitWidth
config Term a
t SymBiMap
m
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
_ (UnaryTerm Id
_ tag
op (Term arg
_ :: Term x)) SymBiMap
_ = m (SymBiMap, TermTy integerBitWidth a)
forall x. x
errorMsg
where
errorMsg :: forall t1. t1
errorMsg :: forall x. x
errorMsg = [Char] -> TypeRep arg -> TypeRep a -> t1
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError (tag -> [Char]
forall a. Show a => a -> [Char]
show tag
op) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
_ (BinaryTerm Id
_ tag
op (Term arg1
_ :: Term x) (Term arg2
_ :: Term y)) SymBiMap
_ = m (SymBiMap, TermTy integerBitWidth a)
forall x. x
errorMsg
where
errorMsg :: forall t1. t1
errorMsg :: forall x. x
errorMsg = [Char] -> TypeRep arg1 -> TypeRep arg2 -> TypeRep a -> t1
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError (tag -> [Char]
forall a. Show a => a -> [Char]
show tag
op) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @y) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl ResolvedConfig {} (TernaryTerm Id
_ tag
op (Term arg1
_ :: Term x) (Term arg2
_ :: Term y) (Term arg3
_ :: Term z)) SymBiMap
_ = m (SymBiMap, TermTy integerBitWidth a)
forall x. x
errorMsg
where
errorMsg :: forall t1. t1
errorMsg :: forall x. x
errorMsg = [Char]
-> TypeRep arg1 -> TypeRep arg2 -> TypeRep arg3 -> TypeRep a -> t1
forall {k} {k} {k} {k} (a :: k) (b :: k) (c :: k) (d :: k) e.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> e
translateTernaryError (tag -> [Char]
forall a. Show a => a -> [Char]
show tag
op) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @y) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @z) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(NotTerm Id
_ Term Bool
arg) SymBiMap
m = GrisetteSMTConfig integerBitWidth
-> Term a
-> Term Bool
-> (SBool -> SBool)
-> SymBiMap
-> m (SymBiMap, SBool)
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term Bool
arg SBool -> SBool
SBV.sNot SymBiMap
m
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(OrTerm Id
_ Term Bool
arg1 Term Bool
arg2) SymBiMap
m = GrisetteSMTConfig integerBitWidth
-> Term a
-> Term Bool
-> Term Bool
-> (SBool -> SBool -> SBool)
-> SymBiMap
-> m (SymBiMap, SBool)
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term Bool
arg1 Term Bool
arg2 SBool -> SBool -> SBool
(SBV..||) SymBiMap
m
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(AndTerm Id
_ Term Bool
arg1 Term Bool
arg2) SymBiMap
m = GrisetteSMTConfig integerBitWidth
-> Term a
-> Term Bool
-> Term Bool
-> (SBool -> SBool -> SBool)
-> SymBiMap
-> m (SymBiMap, SBool)
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term Bool
arg1 Term Bool
arg2 SBool -> SBool -> SBool
(SBV..&&) SymBiMap
m
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(EqvTerm Id
_ (Term t1
arg1 :: Term x) Term t1
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) of
(GrisetteSMTConfig integerBitWidth, TypeRep t1)
ResolvedSimpleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term t1
-> Term t1
-> (SBV s' -> SBV s' -> SBool)
-> SymBiMap
-> m (SymBiMap, SBool)
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term t1
arg1 Term t1
arg2 SBV s' -> SBV s' -> SBool
forall a. EqSymbolic a => a -> a -> SBool
(SBV..==) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep t1)
_ -> [Char]
-> TypeRep t1 -> TypeRep t1 -> TypeRep a -> m (SymBiMap, SBool)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(==)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ITETerm Id
_ Term Bool
cond Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedMergeableType -> do
(SymBiMap
m1, SBool
l1) <- GrisetteSMTConfig integerBitWidth
-> Term Bool
-> SymBiMap
-> m (SymBiMap, TermTy integerBitWidth Bool)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term Bool
cond SymBiMap
m
(SymBiMap
m2, TermTy integerBitWidth a
l2) <- GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
arg1 SymBiMap
m1
(SymBiMap
m3, TermTy integerBitWidth a
l3) <- GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
arg2 SymBiMap
m2
let g :: TermTy integerBitWidth a
g = SBool
-> TermTy integerBitWidth a
-> TermTy integerBitWidth a
-> TermTy integerBitWidth a
forall a. Mergeable a => SBool -> a -> a -> a
SBV.ite SBool
l1 TermTy integerBitWidth a
l2 TermTy integerBitWidth a
l3
(SymBiMap, TermTy integerBitWidth a)
-> m (SymBiMap, TermTy integerBitWidth a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
addBiMapIntermediate (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
t) (TermTy integerBitWidth a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn TermTy integerBitWidth a
g) SymBiMap
m3, TermTy integerBitWidth a
g)
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep Bool
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"ite" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Bool) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(AddNumTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedNumType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. Num a => a -> a -> a
(+) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(+)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(UMinusNumTerm Id
_ Term a
arg) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedNumType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> (SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg SBV s' -> SBV s'
forall a. Num a => a -> a
negate SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"negate" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(TimesNumTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedNumType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. Num a => a -> a -> a
(*) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(*)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(AbsNumTerm Id
_ Term a
arg) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedNumType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> (SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg SBV s' -> SBV s'
forall a. Num a => a -> a
abs SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"abs" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(SignumNumTerm Id
_ Term a
arg) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedNumType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> (SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg SBV s' -> SBV s'
forall a. Num a => a -> a
signum SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"signum" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(LTNumTerm Id
_ (Term t1
arg1 :: Term arg) Term t1
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @arg) of
(GrisetteSMTConfig integerBitWidth, TypeRep t1)
ResolvedNumOrdType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term t1
-> Term t1
-> (SBV s' -> SBV s' -> SBool)
-> SymBiMap
-> m (SymBiMap, SBool)
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term t1
arg1 Term t1
arg2 SBV s' -> SBV s' -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
(SBV..<) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep t1)
_ -> [Char]
-> TypeRep a -> TypeRep a -> TypeRep Bool -> m (SymBiMap, SBool)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(<)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Bool)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(LENumTerm Id
_ (Term t1
arg1 :: Term arg) Term t1
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @arg) of
(GrisetteSMTConfig integerBitWidth, TypeRep t1)
ResolvedNumOrdType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term t1
-> Term t1
-> (SBV s' -> SBV s' -> SBool)
-> SymBiMap
-> m (SymBiMap, SBool)
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term t1
arg1 Term t1
arg2 SBV s' -> SBV s' -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
(SBV..<=) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep t1)
_ -> [Char]
-> TypeRep a -> TypeRep a -> TypeRep Bool -> m (SymBiMap, SBool)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(<=)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Bool)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(AndBitsTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. Bits a => a -> a -> a
(.&.) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(.&.)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(OrBitsTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. Bits a => a -> a -> a
(.|.) SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"(.|.)" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(XorBitsTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. Bits a => a -> a -> a
xor SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"xor" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ComplementBitsTerm Id
_ Term a
arg) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> (SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg SBV s' -> SBV s'
forall a. Bits a => a -> a
complement SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"complement" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ShiftLeftTerm Id
_ Term a
arg Term a
n) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg Term a
n SBV s' -> SBV s' -> SBV s'
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftLeft SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep Id
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"shiftLeft" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Int) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ShiftRightTerm Id
_ Term a
arg Term a
n) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg Term a
n SBV s' -> SBV s' -> SBV s'
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftRight SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep Id
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"shiftRight" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Int) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(RotateLeftTerm Id
_ Term a
arg Term a
n) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth
_, SignedBVType (Proxy n
Proxy :: Proxy n)) ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV (IntN n) -> SBV (IntN n) -> SBV (IntN n))
-> SymBiMap
-> m (SymBiMap, SBV (IntN n))
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm
GrisetteSMTConfig integerBitWidth
config
Term a
t
Term a
arg
Term a
n
( \SBV (IntN n)
x SBV (IntN n)
y ->
SBV (WordN n) -> SBV (IntN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral (SBV (WordN n) -> SBV (IntN n)) -> SBV (WordN n) -> SBV (IntN n)
forall a b. (a -> b) -> a -> b
$
SBV (WordN n) -> SBV (WordN n) -> SBV (WordN n)
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateLeft
(SBV (IntN n) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SBV (IntN n)
x :: SBV.SWord n)
(SBV (IntN n) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SBV (IntN n)
y :: SBV.SWord n)
)
SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg Term a
n SBV s' -> SBV s' -> SBV s'
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateLeft SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep Id
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"rotateLeft" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Int) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(RotateRightTerm Id
_ Term a
arg Term a
n) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth
_, SignedBVType (Proxy n
Proxy :: Proxy n)) ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV (IntN n) -> SBV (IntN n) -> SBV (IntN n))
-> SymBiMap
-> m (SymBiMap, SBV (IntN n))
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm
GrisetteSMTConfig integerBitWidth
config
Term a
t
Term a
arg
Term a
n
( \SBV (IntN n)
x SBV (IntN n)
y ->
SBV (WordN n) -> SBV (IntN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral (SBV (WordN n) -> SBV (IntN n)) -> SBV (WordN n) -> SBV (IntN n)
forall a b. (a -> b) -> a -> b
$
SBV (WordN n) -> SBV (WordN n) -> SBV (WordN n)
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateRight
(SBV (IntN n) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SBV (IntN n)
x :: SBV.SWord n)
(SBV (IntN n) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SBV (IntN n)
y :: SBV.SWord n)
)
SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedBitsType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg Term a
n SBV s' -> SBV s' -> SBV s'
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateRight SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep Id
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"rotateRight" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Int) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ToSignedTerm Id
_ (Term u
bv :: Term x)) SymBiMap
m =
case (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) of
(SignedBVType (Proxy n
_ :: Proxy na), UnsignedBVType (Proxy n
_ :: Proxy nx)) ->
case TypeRep n -> TypeRep n -> Maybe (n :~~: n)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep (forall (a :: Nat). Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @na) (forall (a :: Nat). Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @nx) of
Just n :~~: n
R.HRefl ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term u
-> (SBV (WordN n) -> SBV (IntN n))
-> SymBiMap
-> m (SymBiMap, SBV (IntN n))
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term u
bv SBV (WordN n) -> SBV (IntN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SymBiMap
m
Maybe (n :~~: n)
_ -> [Char] -> TypeRep u -> TypeRep a -> m (SymBiMap, SBV (IntN n))
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"u2s" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
(TypeRep a, TypeRep u)
_ -> [Char]
-> TypeRep u -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"u2s" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ToUnsignedTerm Id
_ (Term s
bv :: Term x)) SymBiMap
m =
case (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) of
(UnsignedBVType (Proxy n
_ :: Proxy na), SignedBVType (Proxy n
_ :: Proxy nx)) ->
case TypeRep n -> TypeRep n -> Maybe (n :~~: n)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep (forall (a :: Nat). Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @na) (forall (a :: Nat). Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @nx) of
Just n :~~: n
R.HRefl ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term s
-> (SBV (IntN n) -> SBV (WordN n))
-> SymBiMap
-> m (SymBiMap, SBV (WordN n))
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term s
bv SBV (IntN n) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SymBiMap
m
Maybe (n :~~: n)
_ -> [Char] -> TypeRep s -> TypeRep a -> m (SymBiMap, SBV (WordN n))
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"s2u" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
(TypeRep a, TypeRep s)
_ -> [Char]
-> TypeRep s -> TypeRep a -> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} (a :: k) (b :: k) c.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> c
translateUnaryError [Char]
"s2u" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(BVConcatTerm Id
_ (Term (bv a)
bv1 :: Term x) (Term (bv b)
bv2 :: Term y)) SymBiMap
m =
case (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @y) of
(UnsignedBVType (Proxy n
_ :: Proxy na), UnsignedBVType (Proxy n
_ :: Proxy nx), UnsignedBVType (Proxy n
_ :: Proxy ny)) ->
case (forall (a :: Nat) (b :: Nat). a :~: b
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom @(nx + ny) @na) of
(n + n) :~: n
Refl -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term (bv a)
-> Term (bv b)
-> (SBV (WordN a) -> SBV (WordN b) -> SBV (WordN n))
-> SymBiMap
-> m (SymBiMap, SBV (WordN n))
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term (bv a)
bv1 Term (bv b)
bv2 SBV (WordN a) -> SBV (WordN b) -> SBV (WordN n)
SBV (WordN a) -> SBV (WordN b) -> SBV (WordN (a + b))
forall (n :: Nat) (bv :: Nat -> *) (m :: Nat).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
BVIsNonZero m, SymVal (bv m)) =>
SBV (bv n) -> SBV (bv m) -> SBV (bv (n + m))
(SBV.#) SymBiMap
m
(SignedBVType (Proxy n
_ :: Proxy na), SignedBVType (Proxy n
_ :: Proxy nx), SignedBVType (Proxy n
_ :: Proxy ny)) ->
case (forall (a :: Nat) (b :: Nat). a :~: b
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom @(nx + ny) @na) of
(n + n) :~: n
Refl ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term (bv a)
-> Term (bv b)
-> (SInt a -> SInt b -> SBV (IntN n))
-> SymBiMap
-> m (SymBiMap, SBV (IntN n))
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm
GrisetteSMTConfig integerBitWidth
config
Term a
t
Term (bv a)
bv1
Term (bv b)
bv2
( \(SInt a
x :: SBV.SInt xn) (SInt b
y :: SBV.SInt yn) ->
SBV (WordN n) -> SBV (IntN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral (SBV (WordN n) -> SBV (IntN n)) -> SBV (WordN n) -> SBV (IntN n)
forall a b. (a -> b) -> a -> b
$
(SInt a -> SBV (WordN a)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SInt a
x :: SBV.SWord xn) SBV (WordN a) -> SBV (WordN b) -> SBV (WordN (a + b))
forall (n :: Nat) (bv :: Nat -> *) (m :: Nat).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
BVIsNonZero m, SymVal (bv m)) =>
SBV (bv n) -> SBV (bv m) -> SBV (bv (n + m))
SBV.# (SInt b -> SBV (WordN b)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SInt b
y :: SBV.SWord yn)
)
SymBiMap
m
(TypeRep a, TypeRep (bv a), TypeRep (bv b))
_ -> [Char]
-> TypeRep (bv a)
-> TypeRep (bv b)
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth (bv (a + b)))
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"bvconcat" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @y) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(BVSelectTerm Id
_ (TypeRep ix
ix :: R.TypeRep ix) TypeRep w
w (Term (bv n)
bv :: Term x)) SymBiMap
m =
case (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) of
(UnsignedBVType (Proxy n
_ :: Proxy na), UnsignedBVType (Proxy n
_ :: Proxy xn)) ->
KnownProof ((w + ix) - 1)
-> (KnownNat ((w + ix) - 1) =>
m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall (n :: Nat) r. KnownProof n -> (KnownNat n => r) -> r
withKnownProof (forall (n :: Nat). Nat -> KnownProof n
unsafeKnownProof @(na + ix - 1) (Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @na) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Proxy ix -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @ix) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1)) ((KnownNat ((w + ix) - 1) =>
m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (KnownNat ((w + ix) - 1) =>
m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
case ( forall (a :: Nat) (b :: Nat). a :~: b
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom @(na + ix - 1 - ix + 1) @na,
forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @(na + ix - 1 + 1) @xn,
forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @ix @(na + ix - 1)
) of
(((((w + ix) - 1) - ix) + 1) :~: w
Refl, LeqProof (((w + ix) - 1) + 1) n
LeqProof, LeqProof ix ((w + ix) - 1)
LeqProof) ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term (bv n)
-> (SBV (WordN n) -> SBV (WordN w))
-> SymBiMap
-> m (SymBiMap, SBV (WordN w))
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term (bv n)
bv (Proxy ((w + ix) - 1)
-> Proxy ix
-> SBV (WordN n)
-> SBV (WordN ((((w + ix) - 1) - ix) + 1))
forall (i :: Nat) (j :: Nat) (n :: Nat) (bv :: Nat -> *)
(proxy :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat i, KnownNat j,
(i + 1) <= n, j <= i, BVIsNonZero ((i - j) + 1)) =>
proxy i -> proxy j -> SBV (bv n) -> SBV (bv ((i - j) + 1))
SBV.bvExtract (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(na + ix - 1)) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @ix)) SymBiMap
m
(SignedBVType (Proxy n
_ :: Proxy na), SignedBVType (Proxy n
_ :: Proxy xn)) ->
KnownProof ((w + ix) - 1)
-> (KnownNat ((w + ix) - 1) =>
m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall (n :: Nat) r. KnownProof n -> (KnownNat n => r) -> r
withKnownProof (forall (n :: Nat). Nat -> KnownProof n
unsafeKnownProof @(na + ix - 1) (Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @na) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Proxy ix -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @ix) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1)) ((KnownNat ((w + ix) - 1) =>
m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (KnownNat ((w + ix) - 1) =>
m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
case ( forall (a :: Nat) (b :: Nat). a :~: b
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom @(na + ix - 1 - ix + 1) @na,
forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @(na + ix - 1 + 1) @xn,
forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @ix @(na + ix - 1)
) of
(((((w + ix) - 1) - ix) + 1) :~: w
Refl, LeqProof (((w + ix) - 1) + 1) n
LeqProof, LeqProof ix ((w + ix) - 1)
LeqProof) ->
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term (bv n)
-> (SBV (IntN n) -> SBV (IntN w))
-> SymBiMap
-> m (SymBiMap, SBV (IntN w))
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term (bv n)
bv (Proxy ((w + ix) - 1)
-> Proxy ix
-> SBV (IntN n)
-> SBV (IntN ((((w + ix) - 1) - ix) + 1))
forall (i :: Nat) (j :: Nat) (n :: Nat) (bv :: Nat -> *)
(proxy :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat i, KnownNat j,
(i + 1) <= n, j <= i, BVIsNonZero ((i - j) + 1)) =>
proxy i -> proxy j -> SBV (bv n) -> SBV (bv ((i - j) + 1))
SBV.bvExtract (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(na + ix - 1)) (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @ix)) SymBiMap
m
(TypeRep a, TypeRep (bv n))
_ -> [Char]
-> TypeRep ix
-> TypeRep w
-> TypeRep (bv n)
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth (bv w))
forall {k} {k} {k} {k} (a :: k) (b :: k) (c :: k) (d :: k) e.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> e
translateTernaryError [Char]
"bvselect" TypeRep ix
ix TypeRep w
w (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(BVExtendTerm Id
_ Bool
signed (TypeRep r
n :: R.TypeRep n) (Term (bv l)
bv :: Term x)) SymBiMap
m =
case (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) of
(UnsignedBVType (Proxy n
_ :: Proxy na), UnsignedBVType (Proxy n
_ :: Proxy nx)) ->
KnownProof (r - l)
-> (KnownNat (r - l) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall (n :: Nat) r. KnownProof n -> (KnownNat n => r) -> r
withKnownProof (forall (n :: Nat). Nat -> KnownProof n
unsafeKnownProof @(na - nx) (Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @na) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @nx))) ((KnownNat (r - l) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (KnownNat (r - l) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
case (forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @(nx + 1) @na, forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @1 @(na - nx)) of
(LeqProof (l + 1) r
LeqProof, LeqProof 1 (r - l)
LeqProof) ->
forall (w :: Nat) r. (1 <= w) => (BVIsNonZero w => r) -> r
bvIsNonZeroFromGEq1 @(na - nx) ((BVIsNonZero (n - n) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (BVIsNonZero (n - n) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term (bv l)
-> (SBV (WordN l) -> SBV (WordN r))
-> SymBiMap
-> m (SymBiMap, SBV (WordN r))
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term (bv l)
bv (if Bool
signed then SBV (WordN l) -> SBV (WordN r)
forall (n :: Nat) (m :: Nat) (bv :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
BVIsNonZero m, SymVal (bv m), (n + 1) <= m, SFiniteBits (bv n),
SIntegral (bv (m - n)), BVIsNonZero (m - n)) =>
SBV (bv n) -> SBV (bv m)
SBV.signExtend else SBV (WordN l) -> SBV (WordN r)
forall (n :: Nat) (m :: Nat) (bv :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
BVIsNonZero m, SymVal (bv m), (n + 1) <= m, SIntegral (bv (m - n)),
BVIsNonZero (m - n)) =>
SBV (bv n) -> SBV (bv m)
SBV.zeroExtend) SymBiMap
m
(SignedBVType (Proxy n
_ :: Proxy na), SignedBVType (Proxy n
_ :: Proxy nx)) ->
KnownProof (r - l)
-> (KnownNat (r - l) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall (n :: Nat) r. KnownProof n -> (KnownNat n => r) -> r
withKnownProof (forall (n :: Nat). Nat -> KnownProof n
unsafeKnownProof @(na - nx) (Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @na) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Proxy n -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @nx))) ((KnownNat (r - l) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (KnownNat (r - l) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
case (forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @(nx + 1) @na, forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @1 @(na - nx)) of
(LeqProof (l + 1) r
LeqProof, LeqProof 1 (r - l)
LeqProof) ->
forall (w :: Nat) r. (1 <= w) => (BVIsNonZero w => r) -> r
bvIsNonZeroFromGEq1 @(na - nx) ((BVIsNonZero (n - n) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a))
-> (BVIsNonZero (n - n) => m (SymBiMap, TermTy integerBitWidth a))
-> m (SymBiMap, TermTy integerBitWidth a)
forall a b. (a -> b) -> a -> b
$
GrisetteSMTConfig integerBitWidth
-> Term a
-> Term (bv l)
-> (SBV (IntN l) -> SBV (IntN r))
-> SymBiMap
-> m (SymBiMap, SBV (IntN r))
forall (integerBitWidth :: Nat) a a1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x,
HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x -> Term a -> (a1 -> x1) -> SymBiMap -> m (SymBiMap, x1)
lowerUnaryTerm
GrisetteSMTConfig integerBitWidth
config
Term a
t
Term (bv l)
bv
( if Bool
signed
then SBV (IntN l) -> SBV (IntN r)
forall (n :: Nat) (m :: Nat) (bv :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
BVIsNonZero m, SymVal (bv m), (n + 1) <= m, SFiniteBits (bv n),
SIntegral (bv (m - n)), BVIsNonZero (m - n)) =>
SBV (bv n) -> SBV (bv m)
SBV.signExtend
else \SBV (IntN l)
x ->
SBV (WordN n) -> SBV (IntN r)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral
(SBV (WordN n) -> SBV (WordN n)
forall (n :: Nat) (m :: Nat) (bv :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
BVIsNonZero m, SymVal (bv m), (n + 1) <= m, SIntegral (bv (m - n)),
BVIsNonZero (m - n)) =>
SBV (bv n) -> SBV (bv m)
SBV.zeroExtend (SBV (IntN l) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
SBV.sFromIntegral SBV (IntN l)
x :: SBV.SBV (SBV.WordN nx)) :: SBV.SBV (SBV.WordN na))
)
SymBiMap
m
(TypeRep a, TypeRep (bv l))
_ -> [Char]
-> TypeRep Bool
-> TypeRep r
-> TypeRep (bv l)
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth (bv r))
forall {k} {k} {k} {k} (a :: k) (b :: k) (c :: k) (d :: k) e.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> e
translateTernaryError [Char]
"bvextend" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Bool) TypeRep r
n (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @x) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(TabularFunApplyTerm Id
_ (Term (a =-> a)
f :: Term (b =-> a)) (Term a
arg :: Term b)) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedDeepType -> do
(SymBiMap
m1, TermTy integerBitWidth a -> s'
l1) <- GrisetteSMTConfig integerBitWidth
-> Term (a =-> a)
-> SymBiMap
-> m (SymBiMap, TermTy integerBitWidth (a =-> a))
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term (a =-> a)
f SymBiMap
m
(SymBiMap
m2, TermTy integerBitWidth a
l2) <- GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
arg SymBiMap
m1
let g :: s'
g = TermTy integerBitWidth a -> s'
l1 TermTy integerBitWidth a
l2
(SymBiMap, s') -> m (SymBiMap, s')
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
addBiMapIntermediate (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
t) (s' -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn s'
g) SymBiMap
m2, s'
g)
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep (a =-> a)
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"tabularApply" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @(b =-> a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(GeneralFunApplyTerm Id
_ (Term (a --> a)
f :: Term (b --> a)) (Term a
arg :: Term b)) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedDeepType -> do
(SymBiMap
m1, TermTy integerBitWidth a -> s'
l1) <- GrisetteSMTConfig integerBitWidth
-> Term (a --> a)
-> SymBiMap
-> m (SymBiMap, TermTy integerBitWidth (a --> a))
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term (a --> a)
f SymBiMap
m
(SymBiMap
m2, TermTy integerBitWidth a
l2) <- GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
forall (integerBitWidth :: Nat) a (m :: * -> *).
(HasCallStack, SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term a -> SymBiMap -> m (SymBiMap, TermTy integerBitWidth a)
lowerSinglePrimCached GrisetteSMTConfig integerBitWidth
config Term a
arg SymBiMap
m1
let g :: s'
g = TermTy integerBitWidth a -> s'
l1 TermTy integerBitWidth a
l2
(SymBiMap, s') -> m (SymBiMap, s')
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
SomeTerm -> Dynamic -> SymBiMap -> SymBiMap
addBiMapIntermediate (Term a -> SomeTerm
forall a. SupportedPrim a => Term a -> SomeTerm
SomeTerm Term a
t) (s' -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn s'
g) SymBiMap
m2, s'
g)
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep (a --> a)
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"generalApply" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @(b --> a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(DivIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sDiv SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"div" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ModIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sMod SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"mod" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(QuotIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sQuot SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"quot" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(RemIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sRem SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"rem" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(DivBoundedIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sDiv SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"div" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(ModBoundedIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sMod SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"mod" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(QuotBoundedIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sQuot SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"quot" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
config t :: Term a
t@(RemBoundedIntegralTerm Id
_ Term a
arg1 Term a
arg2) SymBiMap
m =
case (GrisetteSMTConfig integerBitWidth
config, forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) of
(GrisetteSMTConfig integerBitWidth, TypeRep a)
ResolvedSDivisibleType -> GrisetteSMTConfig integerBitWidth
-> Term a
-> Term a
-> Term a
-> (SBV s' -> SBV s' -> SBV s')
-> SymBiMap
-> m (SymBiMap, SBV s')
forall (integerBitWidth :: Nat) a b a1 b1 x x1 (m :: * -> *).
(Typeable x1, a1 ~ TermTy integerBitWidth a,
b1 ~ TermTy integerBitWidth b, SupportedPrim x, HasCallStack,
SBVFreshMonad m) =>
GrisetteSMTConfig integerBitWidth
-> Term x
-> Term a
-> Term b
-> (a1 -> b1 -> x1)
-> SymBiMap
-> m (SymBiMap, x1)
lowerBinaryTerm GrisetteSMTConfig integerBitWidth
config Term a
t Term a
arg1 Term a
arg2 SBV s' -> SBV s' -> SBV s'
forall a. SDivisible a => a -> a -> a
SBV.sRem SymBiMap
m
(GrisetteSMTConfig integerBitWidth, TypeRep a)
_ -> [Char]
-> TypeRep a
-> TypeRep a
-> TypeRep a
-> m (SymBiMap, TermTy integerBitWidth a)
forall {k} {k} {k} (a :: k) (b :: k) (c :: k) d.
HasCallStack =>
[Char] -> TypeRep a -> TypeRep b -> TypeRep c -> d
translateBinaryError [Char]
"rem" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
lowerSinglePrimImpl GrisetteSMTConfig integerBitWidth
_ Term a
_ SymBiMap
_ = [Char] -> m (SymBiMap, TermTy integerBitWidth a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen"
bvIsNonZeroFromGEq1 :: forall w r. (1 <= w) => ((SBV.BVIsNonZero w) => r) -> r
bvIsNonZeroFromGEq1 :: forall (w :: Nat) r. (1 <= w) => (BVIsNonZero w => r) -> r
bvIsNonZeroFromGEq1 BVIsNonZero w => r
r1 = case w :~: 1
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom :: w :~: 1 of
w :~: 1
Refl -> r
BVIsNonZero w => r
r1
#if MIN_VERSION_sbv(10,3,0)
preprocessUIFuncs ::
[(String, (Bool, SBVI.SBVType, Either String ([([SBVI.CV], SBVI.CV)], SBVI.CV)))] ->
Maybe [(String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV)))]
preprocessUIFuncs :: [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
-> Maybe [([Char], (SBVType, ([([CV], CV)], CV)))]
preprocessUIFuncs =
(([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))
-> Maybe ([Char], (SBVType, ([([CV], CV)], CV))))
-> [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
-> Maybe [([Char], (SBVType, ([([CV], CV)], CV)))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
(\case
([Char]
a, (Bool
_, SBVType
b, Right ([([CV], CV)], CV)
c)) -> ([Char], (SBVType, ([([CV], CV)], CV)))
-> Maybe ([Char], (SBVType, ([([CV], CV)], CV)))
forall a. a -> Maybe a
Just ([Char]
a, (SBVType
b, ([([CV], CV)], CV)
c))
([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))
_ -> Maybe ([Char], (SBVType, ([([CV], CV)], CV)))
forall a. Maybe a
Nothing)
#elif MIN_VERSION_sbv(10,0,0)
preprocessUIFuncs ::
[(String, (SBVI.SBVType, Either String ([([SBVI.CV], SBVI.CV)], SBVI.CV)))] ->
Maybe [(String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV)))]
preprocessUIFuncs =
traverse
(\case
(a, (b, Right c)) -> Just (a, (b, c))
_ -> Nothing)
#else
preprocessUIFuncs ::
[(String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV)))] ->
Maybe [(String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV)))]
preprocessUIFuncs = Just
#endif
parseModel :: forall integerBitWidth. GrisetteSMTConfig integerBitWidth -> SBVI.SMTModel -> SymBiMap -> PM.Model
parseModel :: forall (integerBitWidth :: Nat).
GrisetteSMTConfig integerBitWidth -> SMTModel -> SymBiMap -> Model
parseModel GrisetteSMTConfig integerBitWidth
_ (SBVI.SMTModel [([Char], GeneralizedCV)]
_ Maybe [(NamedSymVar, CV)]
_ [([Char], CV)]
assoc [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
orguifuncs) SymBiMap
mp =
case [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
-> Maybe [([Char], (SBVType, ([([CV], CV)], CV)))]
preprocessUIFuncs [([Char], (Bool, SBVType, Either [Char] ([([CV], CV)], CV)))]
orguifuncs of
Just [([Char], (SBVType, ([([CV], CV)], CV)))]
uifuncs -> (([Char], (SBVType, ([([CV], CV)], CV))) -> Model -> Model)
-> Model -> [([Char], (SBVType, ([([CV], CV)], CV)))] -> Model
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char], (SBVType, ([([CV], CV)], CV))) -> Model -> Model
gouifuncs ((([Char], CV) -> Model -> Model)
-> Model -> [([Char], CV)] -> Model
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char], CV) -> Model -> Model
goassoc Model
forall model symbolSet (typedSymbol :: * -> *).
ModelOps model symbolSet typedSymbol =>
model
emptyModel [([Char], CV)]
assoc) [([Char], (SBVType, ([([CV], CV)], CV)))]
uifuncs
Maybe [([Char], (SBVType, ([([CV], CV)], CV)))]
_ -> [Char] -> Model
forall a. HasCallStack => [Char] -> a
error [Char]
"SBV Failed to parse model"
where
goassoc :: (String, SBVI.CV) -> PM.Model -> PM.Model
goassoc :: ([Char], CV) -> Model -> Model
goassoc ([Char]
name, CV
cv) Model
m = case [Char] -> SymBiMap -> Maybe SomeTypedSymbol
findStringToSymbol [Char]
name SymBiMap
mp of
Just (SomeTypedSymbol TypeRep t
tr TypedSymbol t
s) ->
TypedSymbol t -> t -> Model -> Model
forall t. TypedSymbol t -> t -> Model -> Model
forall model symbolSet (typedSymbol :: * -> *) t.
ModelOps model symbolSet typedSymbol =>
typedSymbol t -> t -> model -> model
insertValue TypedSymbol t
s (TypeRep t -> CV -> t
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep t
tr CV
cv) Model
m
Maybe SomeTypedSymbol
Nothing -> [Char] -> Model
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad"
resolveSingle :: R.TypeRep a -> SBVI.CV -> a
resolveSingle :: forall a. TypeRep a -> CV -> a
resolveSingle TypeRep a
t (SBVI.CV Kind
SBVI.KBool (SBVI.CInteger Integer
n)) =
case TypeRep a -> TypeRep Bool -> Maybe (a :~~: Bool)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
t (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Bool) of
Just a :~~: Bool
R.HRefl -> Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
Maybe (a :~~: Bool)
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad type"
resolveSingle TypeRep a
t (SBVI.CV Kind
SBVI.KUnbounded (SBVI.CInteger Integer
i)) =
case TypeRep a -> TypeRep Integer -> Maybe (a :~~: Integer)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
t (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Integer) of
Just a :~~: Integer
R.HRefl -> a
Integer
i
Maybe (a :~~: Integer)
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad type"
resolveSingle TypeRep a
t (SBVI.CV (SBVI.KBounded Bool
_ Id
bitWidth) (SBVI.CInteger Integer
i)) =
case TypeRep a -> TypeRep Integer -> Maybe (a :~~: Integer)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
t (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Integer) of
Just a :~~: Integer
R.HRefl -> a
Integer
i
Maybe (a :~~: Integer)
_ -> case TypeRep a
t of
R.App TypeRep a
a (TypeRep b
n :: R.TypeRep w) ->
case TypeRep k1 -> TypeRep Nat -> Maybe (k1 :~~: Nat)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep (TypeRep b -> TypeRep k1
forall k (a :: k). TypeRep a -> TypeRep k
R.typeRepKind TypeRep b
n) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Nat) of
Just k1 :~~: Nat
R.HRefl ->
case (forall (n :: Nat). Nat -> KnownProof n
unsafeKnownProof @w (Id -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Id
bitWidth), forall (m :: Nat) (n :: Nat). LeqProof m n
unsafeLeqProof @1 @w) of
(KnownProof b
KnownProof, LeqProof 1 b
LeqProof) ->
case (TypeRep a -> TypeRep IntN -> Maybe (a :~~: IntN)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
a (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: Nat -> *). Typeable a => TypeRep a
R.typeRep @IntN), TypeRep a -> TypeRep WordN -> Maybe (a :~~: WordN)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
a (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: Nat -> *). Typeable a => TypeRep a
R.typeRep @WordN)) of
(Just a :~~: IntN
R.HRefl, Maybe (a :~~: WordN)
_) ->
Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
(Maybe (a :~~: IntN)
_, Just a :~~: WordN
R.HRefl) -> Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
(Maybe (a :~~: IntN), Maybe (a :~~: WordN))
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad type"
Maybe (k1 :~~: Nat)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad type"
TypeRep a
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad type"
resolveSingle TypeRep a
_ CV
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Unknown cv"
buildConstFun :: (SupportedPrim a, SupportedPrim r) => R.TypeRep a -> R.TypeRep r -> SBVI.CV -> a =-> r
buildConstFun :: forall a r.
(SupportedPrim a, SupportedPrim r) =>
TypeRep a -> TypeRep r -> CV -> a =-> r
buildConstFun TypeRep a
_ TypeRep r
tr CV
v = case TypeRep r
tr of
TFunType (TypeRep a
ta2' :: R.TypeRep a2) (TypeRep b
tr2' :: R.TypeRep r2) -> [(a, r)] -> r -> a =-> r
forall a b. [(a, b)] -> b -> a =-> b
TabularFun [] (r -> a =-> r) -> r -> a =-> r
forall a b. (a -> b) -> a -> b
$ TypeRep a -> TypeRep b -> CV -> a =-> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
TypeRep a -> TypeRep r -> CV -> a =-> r
buildConstFun TypeRep a
ta2' TypeRep b
tr2' CV
v
TypeRep r
_ -> [(a, r)] -> r -> a =-> r
forall a b. [(a, b)] -> b -> a =-> b
TabularFun [] (r -> a =-> r) -> r -> a =-> r
forall a b. (a -> b) -> a -> b
$ TypeRep r -> CV -> r
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep r
tr CV
v
goutfuncResolve ::
forall a r.
(SupportedPrim a, SupportedPrim r) =>
R.TypeRep a ->
R.TypeRep r ->
([([SBVI.CV], SBVI.CV)], SBVI.CV) ->
(a =-> r)
goutfuncResolve :: forall a r.
(SupportedPrim a, SupportedPrim r) =>
TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a =-> r
goutfuncResolve TypeRep a
ta1 TypeRep r
ta2 ([([CV], CV)]
l, CV
s) =
case TypeRep r
ta2 of
TFunType (TypeRep a
ta2' :: R.TypeRep a2) (TypeRep b
tr2' :: R.TypeRep r2) ->
[(a, r)] -> r -> a =-> r
forall a b. [(a, b)] -> b -> a =-> b
TabularFun
(([([CV], CV)] -> r) -> (a, [([CV], CV)]) -> (a, r)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\[([CV], CV)]
r -> TypeRep a -> TypeRep b -> ([([CV], CV)], CV) -> a =-> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a =-> r
goutfuncResolve TypeRep a
ta2' TypeRep b
tr2' ([([CV], CV)]
r, CV
s)) ((a, [([CV], CV)]) -> (a, r)) -> [(a, [([CV], CV)])] -> [(a, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
partition TypeRep a
ta1 [([CV], CV)]
l)
(TypeRep a -> TypeRep b -> CV -> a =-> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
TypeRep a -> TypeRep r -> CV -> a =-> r
buildConstFun TypeRep a
ta2' TypeRep b
tr2' CV
s)
TypeRep r
_ ->
[(a, r)] -> r -> a =-> r
forall a b. [(a, b)] -> b -> a =-> b
TabularFun
(([CV] -> a) -> (CV -> r) -> ([CV], CV) -> (a, r)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TypeRep a -> CV -> a
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep a
ta1 (CV -> a) -> ([CV] -> CV) -> [CV] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CV] -> CV
forall a. HasCallStack => [a] -> a
head) (TypeRep r -> CV -> r
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep r
ta2) (([CV], CV) -> (a, r)) -> [([CV], CV)] -> [(a, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([CV], CV)]
l)
(TypeRep r -> CV -> r
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep r
ta2 CV
s)
gougfuncResolve ::
forall a r.
(SupportedPrim a, SupportedPrim r) =>
Int ->
R.TypeRep a ->
R.TypeRep r ->
([([SBVI.CV], SBVI.CV)], SBVI.CV) ->
(a --> r)
gougfuncResolve :: forall a r.
(SupportedPrim a, SupportedPrim r) =>
Id -> TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a --> r
gougfuncResolve Id
idx TypeRep a
ta1 TypeRep r
ta2 ([([CV], CV)]
l, CV
s) =
case TypeRep r
ta2 of
GFunType (TypeRep a
ta2' :: R.TypeRep a2) (TypeRep b
tr2' :: R.TypeRep r2) ->
let sym :: TypedSymbol a
sym = Text -> Id -> TypedSymbol a
forall t. SupportedPrim t => Text -> Id -> TypedSymbol t
IndexedSymbol Text
"arg" Id
idx
funs :: [(a, a --> b)]
funs = ([([CV], CV)] -> a --> b) -> (a, [([CV], CV)]) -> (a, a --> b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\[([CV], CV)]
r -> Id -> TypeRep a -> TypeRep b -> ([([CV], CV)], CV) -> a --> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
Id -> TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a --> r
gougfuncResolve (Id
idx Id -> Id -> Id
forall a. Num a => a -> a -> a
+ Id
1) TypeRep a
ta2' TypeRep b
tr2' ([([CV], CV)]
r, CV
s)) ((a, [([CV], CV)]) -> (a, a --> b))
-> [(a, [([CV], CV)])] -> [(a, a --> b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
partition TypeRep a
ta1 [([CV], CV)]
l
def :: a --> b
def = Id -> TypeRep a -> TypeRep b -> ([([CV], CV)], CV) -> a --> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
Id -> TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a --> r
gougfuncResolve (Id
idx Id -> Id -> Id
forall a. Num a => a -> a -> a
+ Id
1) TypeRep a
ta2' TypeRep b
tr2' ([], CV
s)
body :: Term (a --> b)
body =
(Term (a --> b) -> (a, a --> b) -> Term (a --> b))
-> Term (a --> b) -> [(a, a --> b)] -> Term (a --> b)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
( \Term (a --> b)
acc (a
v, a --> b
f) ->
Term Bool -> Term (a --> b) -> Term (a --> b) -> Term (a --> b)
forall a.
SupportedPrim a =>
Term Bool -> Term a -> Term a -> Term a
pevalITETerm
(Term a -> Term a -> Term Bool
forall a. SupportedPrim a => Term a -> Term a -> Term Bool
pevalEqvTerm (TypedSymbol a -> Term a
forall t. (SupportedPrim t, Typeable t) => TypedSymbol t -> Term t
symTerm TypedSymbol a
sym) (a -> Term a
forall t.
(SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) =>
t -> Term t
conTerm a
v))
((a --> b) -> Term (a --> b)
forall t.
(SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) =>
t -> Term t
conTerm a --> b
f)
Term (a --> b)
acc
)
((a --> b) -> Term (a --> b)
forall t.
(SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) =>
t -> Term t
conTerm a --> b
def)
[(a, a --> b)]
funs
in TypedSymbol a -> Term r -> a --> r
forall a b.
(SupportedPrim a, SupportedPrim b) =>
TypedSymbol a -> Term b -> a --> b
buildGeneralFun TypedSymbol a
sym Term r
Term (a --> b)
body
TypeRep r
_ ->
let sym :: TypedSymbol a
sym = Text -> Id -> TypedSymbol a
forall t. SupportedPrim t => Text -> Id -> TypedSymbol t
IndexedSymbol Text
"arg" Id
idx
vs :: [(a, r)]
vs = ([CV] -> a) -> (CV -> r) -> ([CV], CV) -> (a, r)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TypeRep a -> CV -> a
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep a
ta1 (CV -> a) -> ([CV] -> CV) -> [CV] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CV] -> CV
forall a. HasCallStack => [a] -> a
head) (TypeRep r -> CV -> r
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep r
ta2) (([CV], CV) -> (a, r)) -> [([CV], CV)] -> [(a, r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([CV], CV)]
l
def :: r
def = TypeRep r -> CV -> r
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep r
ta2 CV
s
body :: Term r
body =
(Term r -> (a, r) -> Term r) -> Term r -> [(a, r)] -> Term r
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
( \Term r
acc (a
v, r
a) ->
Term Bool -> Term r -> Term r -> Term r
forall a.
SupportedPrim a =>
Term Bool -> Term a -> Term a -> Term a
pevalITETerm
(Term a -> Term a -> Term Bool
forall a. SupportedPrim a => Term a -> Term a -> Term Bool
pevalEqvTerm (TypedSymbol a -> Term a
forall t. (SupportedPrim t, Typeable t) => TypedSymbol t -> Term t
symTerm TypedSymbol a
sym) (a -> Term a
forall t.
(SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) =>
t -> Term t
conTerm a
v))
(r -> Term r
forall t.
(SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) =>
t -> Term t
conTerm r
a)
Term r
acc
)
(r -> Term r
forall t.
(SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) =>
t -> Term t
conTerm r
def)
[(a, r)]
vs
in TypedSymbol a -> Term r -> a --> r
forall a b.
(SupportedPrim a, SupportedPrim b) =>
TypedSymbol a -> Term b -> a --> b
buildGeneralFun TypedSymbol a
sym Term r
body
partition :: R.TypeRep a -> [([SBVI.CV], SBVI.CV)] -> [(a, [([SBVI.CV], SBVI.CV)])]
partition :: forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
partition TypeRep a
t = case (TypeRep a -> TypeRep Bool -> Maybe (a :~~: Bool)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
t (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Bool), TypeRep a -> TypeRep Integer -> Maybe (a :~~: Integer)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
t (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Integer)) of
(Just a :~~: Bool
R.HRefl, Maybe (a :~~: Integer)
_) -> [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
forall a. Ord a => [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
partitionWithOrd ([(a, [([CV], CV)])] -> [(a, [([CV], CV)])])
-> ([([CV], CV)] -> [(a, [([CV], CV)])])
-> [([CV], CV)]
-> [(a, [([CV], CV)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
resolveFirst TypeRep a
t
(Maybe (a :~~: Bool)
_, Just a :~~: Integer
R.HRefl) -> [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
forall a. Ord a => [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
partitionWithOrd ([(a, [([CV], CV)])] -> [(a, [([CV], CV)])])
-> ([([CV], CV)] -> [(a, [([CV], CV)])])
-> [([CV], CV)]
-> [(a, [([CV], CV)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
resolveFirst TypeRep a
t
(Maybe (a :~~: Bool), Maybe (a :~~: Integer))
_ -> case TypeRep a
t of
R.App TypeRep a
bv TypeRep b
_ -> case (TypeRep a -> TypeRep IntN -> Maybe (a :~~: IntN)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
bv (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: Nat -> *). Typeable a => TypeRep a
R.typeRep @IntN), TypeRep a -> TypeRep WordN -> Maybe (a :~~: WordN)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
bv (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: Nat -> *). Typeable a => TypeRep a
R.typeRep @WordN)) of
(Just a :~~: IntN
R.HRefl, Maybe (a :~~: WordN)
_) -> ((Integer, [([CV], CV)]) -> (a, [([CV], CV)]))
-> [(Integer, [([CV], CV)])] -> [(a, [([CV], CV)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Integer -> a) -> (Integer, [([CV], CV)]) -> (a, [([CV], 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 Integer -> a
Integer -> IntN b
forall (n :: Nat). Integer -> IntN n
IntN) ([(Integer, [([CV], CV)])] -> [(a, [([CV], CV)])])
-> ([([CV], CV)] -> [(Integer, [([CV], CV)])])
-> [([CV], CV)]
-> [(a, [([CV], CV)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, [([CV], CV)])] -> [(Integer, [([CV], CV)])]
forall a. Ord a => [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
partitionWithOrd ([(Integer, [([CV], CV)])] -> [(Integer, [([CV], CV)])])
-> ([([CV], CV)] -> [(Integer, [([CV], CV)])])
-> [([CV], CV)]
-> [(Integer, [([CV], CV)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IntN b, [([CV], CV)]) -> (Integer, [([CV], CV)]))
-> [(IntN b, [([CV], CV)])] -> [(Integer, [([CV], CV)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IntN b -> Integer)
-> (IntN b, [([CV], CV)]) -> (Integer, [([CV], 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 IntN b -> Integer
forall (n :: Nat). IntN n -> Integer
unIntN) ([(IntN b, [([CV], CV)])] -> [(Integer, [([CV], CV)])])
-> ([([CV], CV)] -> [(IntN b, [([CV], CV)])])
-> [([CV], CV)]
-> [(Integer, [([CV], CV)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep (IntN b) -> [([CV], CV)] -> [(IntN b, [([CV], CV)])]
forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
resolveFirst TypeRep a
TypeRep (IntN b)
t
(Maybe (a :~~: IntN)
_, Just a :~~: WordN
R.HRefl) -> [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
forall a. Ord a => [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
partitionWithOrd ([(a, [([CV], CV)])] -> [(a, [([CV], CV)])])
-> ([([CV], CV)] -> [(a, [([CV], CV)])])
-> [([CV], CV)]
-> [(a, [([CV], CV)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
resolveFirst TypeRep a
t
(Maybe (a :~~: IntN), Maybe (a :~~: WordN))
_ -> [Char] -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. HasCallStack => [Char] -> a
error [Char]
"Unknown type"
TypeRep a
_ -> [Char] -> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a. HasCallStack => [Char] -> a
error [Char]
"Unknown type"
resolveFirst :: R.TypeRep a -> [([SBVI.CV], SBVI.CV)] -> [(a, [([SBVI.CV], SBVI.CV)])]
resolveFirst :: forall a. TypeRep a -> [([CV], CV)] -> [(a, [([CV], CV)])]
resolveFirst TypeRep a
tf = (([CV], CV) -> (a, [([CV], CV)]))
-> [([CV], CV)] -> [(a, [([CV], CV)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case (CV
x : [CV]
xs, CV
v) -> (TypeRep a -> CV -> a
forall a. TypeRep a -> CV -> a
resolveSingle TypeRep a
tf CV
x, [([CV]
xs, CV
v)]); ([CV], CV)
_ -> [Char] -> (a, [([CV], CV)])
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
partitionWithOrd :: forall a. (Ord a) => [(a, [([SBVI.CV], SBVI.CV)])] -> [(a, [([SBVI.CV], SBVI.CV)])]
partitionWithOrd :: forall a. Ord a => [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
partitionWithOrd [(a, [([CV], CV)])]
v = [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
forall {a} {a}. Eq a => [(a, [a])] -> [(a, [a])]
go [(a, [([CV], CV)])]
sorted
where
sorted :: [(a, [([CV], CV)])]
sorted = ((a, [([CV], CV)]) -> a)
-> [(a, [([CV], CV)])] -> [(a, [([CV], CV)])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (a, [([CV], CV)]) -> a
forall a b. (a, b) -> a
fst [(a, [([CV], CV)])]
v
go :: [(a, [a])] -> [(a, [a])]
go ((a, [a])
x : (a, [a])
x1 : [(a, [a])]
xs) =
if (a, [a]) -> a
forall a b. (a, b) -> a
fst (a, [a])
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, [a]) -> a
forall a b. (a, b) -> a
fst (a, [a])
x1
then [(a, [a])] -> [(a, [a])]
go ([(a, [a])] -> [(a, [a])]) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ ((a, [a]) -> a
forall a b. (a, b) -> a
fst (a, [a])
x, (a, [a]) -> [a]
forall a b. (a, b) -> b
snd (a, [a])
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a, [a]) -> [a]
forall a b. (a, b) -> b
snd (a, [a])
x1) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])]
xs
else (a, [a])
x (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])] -> [(a, [a])]
go ((a, [a])
x1 (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])]
xs)
go [(a, [a])]
x = [(a, [a])]
x
gouifuncs :: (String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV))) -> PM.Model -> PM.Model
gouifuncs :: ([Char], (SBVType, ([([CV], CV)], CV))) -> Model -> Model
gouifuncs ([Char]
name, (SBVI.SBVType [Kind]
_, ([([CV], CV)], CV)
l)) Model
m = case [Char] -> SymBiMap -> Maybe SomeTypedSymbol
findStringToSymbol [Char]
name SymBiMap
mp of
Just (SomeTypedSymbol TypeRep t
tr TypedSymbol t
s) -> TypedSymbol t -> (SupportedPrim t => Model) -> Model
forall t a. TypedSymbol t -> (SupportedPrim t => a) -> a
withSymbolSupported TypedSymbol t
s ((SupportedPrim t => Model) -> Model)
-> (SupportedPrim t => Model) -> Model
forall a b. (a -> b) -> a -> b
$ case TypeRep t
tr of
t :: TypeRep t
t@(TFunType TypeRep a
a TypeRep b
r) -> TypeRep t -> (Typeable t => Model) -> Model
forall k (a :: k) r. TypeRep a -> (Typeable a => r) -> r
R.withTypeable TypeRep t
t ((Typeable t => Model) -> Model) -> (Typeable t => Model) -> Model
forall a b. (a -> b) -> a -> b
$ TypedSymbol t -> t -> Model -> Model
forall t. TypedSymbol t -> t -> Model -> Model
forall model symbolSet (typedSymbol :: * -> *) t.
ModelOps model symbolSet typedSymbol =>
typedSymbol t -> t -> model -> model
insertValue TypedSymbol t
s (TypeRep a -> TypeRep b -> ([([CV], CV)], CV) -> a =-> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a =-> r
goutfuncResolve TypeRep a
a TypeRep b
r ([([CV], CV)], CV)
l) Model
m
t :: TypeRep t
t@(GFunType TypeRep a
a TypeRep b
r) -> TypeRep t -> (Typeable t => Model) -> Model
forall k (a :: k) r. TypeRep a -> (Typeable a => r) -> r
R.withTypeable TypeRep t
t ((Typeable t => Model) -> Model) -> (Typeable t => Model) -> Model
forall a b. (a -> b) -> a -> b
$ TypedSymbol t -> t -> Model -> Model
forall t. TypedSymbol t -> t -> Model -> Model
forall model symbolSet (typedSymbol :: * -> *) t.
ModelOps model symbolSet typedSymbol =>
typedSymbol t -> t -> model -> model
insertValue TypedSymbol t
s (Id -> TypeRep a -> TypeRep b -> ([([CV], CV)], CV) -> a --> b
forall a r.
(SupportedPrim a, SupportedPrim r) =>
Id -> TypeRep a -> TypeRep r -> ([([CV], CV)], CV) -> a --> r
gougfuncResolve Id
0 TypeRep a
a TypeRep b
r ([([CV], CV)], CV)
l) Model
m
TypeRep t
_ -> [Char] -> Model
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad"
Maybe SomeTypedSymbol
Nothing -> [Char] -> Model
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad"
data BVTypeContainer bv k where
BVTypeContainer :: (SBV.BVIsNonZero n, KnownNat n, 1 <= n, k ~ bv n) => Proxy n -> BVTypeContainer bv k
signedBVTypeView :: forall t. (SupportedPrim t) => R.TypeRep t -> Maybe (BVTypeContainer IntN t)
signedBVTypeView :: forall t.
SupportedPrim t =>
TypeRep t -> Maybe (BVTypeContainer IntN t)
signedBVTypeView TypeRep t
t = case TypeRep t
t of
R.App TypeRep a
s (TypeRep b
n :: R.TypeRep w) ->
case (TypeRep a -> TypeRep IntN -> Maybe (a :~~: IntN)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
s (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: Nat -> *). Typeable a => TypeRep a
R.typeRep @IntN), TypeRep k1 -> TypeRep Nat -> Maybe (k1 :~~: Nat)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep (TypeRep b -> TypeRep k1
forall k (a :: k). TypeRep a -> TypeRep k
R.typeRepKind TypeRep b
n) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Nat)) of
(Just a :~~: IntN
R.HRefl, Just k1 :~~: Nat
R.HRefl) ->
BVTypeContainer IntN t -> Maybe (BVTypeContainer IntN t)
forall a. a -> Maybe a
Just (BVTypeContainer IntN t -> Maybe (BVTypeContainer IntN t))
-> BVTypeContainer IntN t -> Maybe (BVTypeContainer IntN t)
forall a b. (a -> b) -> a -> b
$ forall (w :: Nat) r. (BVIsNonZero w => r) -> r
unsafeBVIsNonZero @w ((BVIsNonZero b => BVTypeContainer IntN t)
-> BVTypeContainer IntN t)
-> (BVIsNonZero b => BVTypeContainer IntN t)
-> BVTypeContainer IntN t
forall a b. (a -> b) -> a -> b
$ Proxy t
-> (PrimConstraint t => BVTypeContainer IntN t)
-> BVTypeContainer IntN t
forall t (proxy :: * -> *) a.
SupportedPrim t =>
proxy t -> (PrimConstraint t => a) -> a
forall (proxy :: * -> *) a. proxy t -> (PrimConstraint t => a) -> a
withPrim (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) (Proxy b -> BVTypeContainer IntN t
forall {k} (s' :: Nat) (k :: k) (bv :: Nat -> k).
(BVIsNonZero s', KnownNat s', 1 <= s', k ~ bv s') =>
Proxy s' -> BVTypeContainer bv k
BVTypeContainer Proxy b
forall {k} (t :: k). Proxy t
Proxy)
(Maybe (a :~~: IntN), Maybe (k1 :~~: Nat))
_ -> Maybe (BVTypeContainer IntN t)
forall a. Maybe a
Nothing
TypeRep t
_ -> Maybe (BVTypeContainer IntN t)
forall a. Maybe a
Nothing
where
unsafeBVIsNonZero :: forall w r. ((SBV.BVIsNonZero w) => r) -> r
unsafeBVIsNonZero :: forall (w :: Nat) r. (BVIsNonZero w => r) -> r
unsafeBVIsNonZero BVIsNonZero w => r
r1 = case w :~: 1
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom :: w :~: 1 of
w :~: 1
Refl -> r
BVIsNonZero w => r
r1
pattern SignedBVType ::
forall t.
(SupportedPrim t) =>
forall (n :: Nat).
(t ~~ IntN n, KnownNat n, 1 <= n, SBV.BVIsNonZero n) =>
Proxy n ->
R.TypeRep t
pattern $mSignedBVType :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {n :: Nat}.
(t ~~ IntN n, KnownNat n, 1 <= n, BVIsNonZero n) =>
Proxy n -> r)
-> ((# #) -> r)
-> r
SignedBVType p <- (signedBVTypeView @t -> Just (BVTypeContainer p))
unsignedBVTypeView :: forall t. (SupportedPrim t) => R.TypeRep t -> Maybe (BVTypeContainer WordN t)
unsignedBVTypeView :: forall t.
SupportedPrim t =>
TypeRep t -> Maybe (BVTypeContainer WordN t)
unsignedBVTypeView TypeRep t
t = case TypeRep t
t of
R.App TypeRep a
s (TypeRep b
n :: R.TypeRep w) ->
case (TypeRep a -> TypeRep WordN -> Maybe (a :~~: WordN)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
s (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: Nat -> *). Typeable a => TypeRep a
R.typeRep @WordN), TypeRep k1 -> TypeRep Nat -> Maybe (k1 :~~: Nat)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep (TypeRep b -> TypeRep k1
forall k (a :: k). TypeRep a -> TypeRep k
R.typeRepKind TypeRep b
n) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @Nat)) of
(Just a :~~: WordN
R.HRefl, Just k1 :~~: Nat
R.HRefl) ->
BVTypeContainer WordN t -> Maybe (BVTypeContainer WordN t)
forall a. a -> Maybe a
Just (BVTypeContainer WordN t -> Maybe (BVTypeContainer WordN t))
-> BVTypeContainer WordN t -> Maybe (BVTypeContainer WordN t)
forall a b. (a -> b) -> a -> b
$ forall (w :: Nat) r. (BVIsNonZero w => r) -> r
unsafeBVIsNonZero @w ((BVIsNonZero b => BVTypeContainer WordN t)
-> BVTypeContainer WordN t)
-> (BVIsNonZero b => BVTypeContainer WordN t)
-> BVTypeContainer WordN t
forall a b. (a -> b) -> a -> b
$ Proxy t
-> (PrimConstraint t => BVTypeContainer WordN t)
-> BVTypeContainer WordN t
forall t (proxy :: * -> *) a.
SupportedPrim t =>
proxy t -> (PrimConstraint t => a) -> a
forall (proxy :: * -> *) a. proxy t -> (PrimConstraint t => a) -> a
withPrim (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) (Proxy b -> BVTypeContainer WordN t
forall {k} (s' :: Nat) (k :: k) (bv :: Nat -> k).
(BVIsNonZero s', KnownNat s', 1 <= s', k ~ bv s') =>
Proxy s' -> BVTypeContainer bv k
BVTypeContainer Proxy b
forall {k} (t :: k). Proxy t
Proxy)
(Maybe (a :~~: WordN), Maybe (k1 :~~: Nat))
_ -> Maybe (BVTypeContainer WordN t)
forall a. Maybe a
Nothing
TypeRep t
_ -> Maybe (BVTypeContainer WordN t)
forall a. Maybe a
Nothing
where
unsafeBVIsNonZero :: forall w r. ((SBV.BVIsNonZero w) => r) -> r
unsafeBVIsNonZero :: forall (w :: Nat) r. (BVIsNonZero w => r) -> r
unsafeBVIsNonZero BVIsNonZero w => r
r1 = case w :~: 1
forall {k} (a :: k) (b :: k). a :~: b
unsafeAxiom :: w :~: 1 of
w :~: 1
Refl -> r
BVIsNonZero w => r
r1
pattern UnsignedBVType ::
forall t.
(SupportedPrim t) =>
forall (n :: Nat).
(t ~~ WordN n, KnownNat n, 1 <= n, SBV.BVIsNonZero n) =>
Proxy n ->
R.TypeRep t
pattern $mUnsignedBVType :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {n :: Nat}.
(t ~~ WordN n, KnownNat n, 1 <= n, BVIsNonZero n) =>
Proxy n -> r)
-> ((# #) -> r)
-> r
UnsignedBVType p <- (unsignedBVTypeView @t -> Just (BVTypeContainer p))
data TFunTypeContainer :: forall k. k -> Type where
TFunTypeContainer :: (SupportedPrim a, SupportedPrim b) => R.TypeRep a -> R.TypeRep b -> TFunTypeContainer (a =-> b)
tFunTypeView :: forall t. (SupportedPrim t) => R.TypeRep t -> Maybe (TFunTypeContainer t)
tFunTypeView :: forall t.
SupportedPrim t =>
TypeRep t -> Maybe (TFunTypeContainer t)
tFunTypeView TypeRep t
t = case TypeRep t
t of
R.App (R.App TypeRep a
arr (TypeRep b
ta2' :: R.TypeRep a2)) (TypeRep b
tr2' :: R.TypeRep r2) ->
case TypeRep a -> TypeRep (=->) -> Maybe (a :~~: (=->))
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
arr (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> * -> *). Typeable a => TypeRep a
R.typeRep @(=->)) of
Just a :~~: (=->)
R.HRefl -> TFunTypeContainer t -> Maybe (TFunTypeContainer t)
forall a. a -> Maybe a
Just (TFunTypeContainer t -> Maybe (TFunTypeContainer t))
-> TFunTypeContainer t -> Maybe (TFunTypeContainer t)
forall a b. (a -> b) -> a -> b
$ Proxy t
-> (PrimConstraint t => TFunTypeContainer t) -> TFunTypeContainer t
forall t (proxy :: * -> *) a.
SupportedPrim t =>
proxy t -> (PrimConstraint t => a) -> a
forall (proxy :: * -> *) a. proxy t -> (PrimConstraint t => a) -> a
withPrim (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) ((PrimConstraint t => TFunTypeContainer t) -> TFunTypeContainer t)
-> (PrimConstraint t => TFunTypeContainer t) -> TFunTypeContainer t
forall a b. (a -> b) -> a -> b
$ TypeRep b -> TypeRep b -> TFunTypeContainer (b =-> b)
forall s' b.
(SupportedPrim s', SupportedPrim b) =>
TypeRep s' -> TypeRep b -> TFunTypeContainer (s' =-> b)
TFunTypeContainer TypeRep b
TypeRep b
ta2' TypeRep b
TypeRep b
tr2'
Maybe (a :~~: (=->))
Nothing -> Maybe (TFunTypeContainer t)
forall a. Maybe a
Nothing
TypeRep t
_ -> Maybe (TFunTypeContainer t)
forall a. Maybe a
Nothing
pattern TFunType ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type).
(t ~~ (a =-> b), SupportedPrim a, SupportedPrim b) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep t
pattern $mTFunType :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b}.
(t ~~ (a =-> b), SupportedPrim a, SupportedPrim b) =>
TypeRep a -> TypeRep b -> r)
-> ((# #) -> r)
-> r
$bTFunType :: forall t a b.
(SupportedPrim t, t ~~ (a =-> b), SupportedPrim a,
SupportedPrim b) =>
TypeRep a -> TypeRep b -> TypeRep t
TFunType a b <-
(tFunTypeView -> Just (TFunTypeContainer a b))
where
TFunType TypeRep a
a TypeRep b
b = TypeRep ((=->) a) -> TypeRep b -> TypeRep t
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
R.App (TypeRep (=->) -> TypeRep a -> TypeRep ((=->) a)
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
R.App (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> * -> *). Typeable a => TypeRep a
R.typeRep @(=->)) TypeRep a
a) TypeRep b
b
pattern TFun3Type ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type) (c :: Type).
(t ~~ (a =-> b =-> c), SupportedPrim a, SupportedPrim b, SupportedPrim c) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep t
pattern $mTFun3Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c}.
(t ~~ (a =-> (b =-> c)), SupportedPrim a, SupportedPrim b,
SupportedPrim c) =>
TypeRep a -> TypeRep b -> TypeRep c -> r)
-> ((# #) -> r)
-> r
$bTFun3Type :: forall t a b c.
(SupportedPrim t, t ~~ (a =-> (b =-> c)), SupportedPrim a,
SupportedPrim b, SupportedPrim c) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep t
TFun3Type a b c = TFunType a (TFunType b c)
pattern TFun4Type ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type) (c :: Type) (d :: Type).
( t ~~ (a =-> b =-> c =-> d),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep t
pattern $mTFun4Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d}.
(t ~~ (a =-> (b =-> (c =-> d))), SupportedPrim a, SupportedPrim b,
SupportedPrim c, SupportedPrim d) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> r)
-> ((# #) -> r)
-> r
$bTFun4Type :: forall t a b c d.
(SupportedPrim t, t ~~ (a =-> (b =-> (c =-> d))), SupportedPrim a,
SupportedPrim b, SupportedPrim c, SupportedPrim d) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> TypeRep t
TFun4Type a b c d = TFunType a (TFunType b (TFunType c d))
pattern TFun5Type ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type) (c :: Type) (d :: Type) (e :: Type).
( t ~~ (a =-> b =-> c =-> d =-> e),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep t
pattern $mTFun5Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e}.
(t ~~ (a =-> (b =-> (c =-> (d =-> e)))), SupportedPrim a,
SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> TypeRep e -> r)
-> ((# #) -> r)
-> r
$bTFun5Type :: forall t a b c d e.
(SupportedPrim t, t ~~ (a =-> (b =-> (c =-> (d =-> e)))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e) =>
TypeRep a
-> TypeRep b -> TypeRep c -> TypeRep d -> TypeRep e -> TypeRep t
TFun5Type a b c d e =
TFunType
a
( TFunType
b
( TFunType
c
(TFunType d e)
)
)
pattern TFun6Type ::
forall t.
(SupportedPrim t) =>
forall
(a :: Type)
(b :: Type)
(c :: Type)
(d :: Type)
(e :: Type)
(f :: Type).
( t ~~ (a =-> b =-> c =-> d =-> e =-> f),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e,
SupportedPrim f
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep f ->
R.TypeRep t
pattern $mTFun6Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e} {f}.
(t ~~ (a =-> (b =-> (c =-> (d =-> (e =-> f))))), SupportedPrim a,
SupportedPrim b, SupportedPrim c, SupportedPrim d, SupportedPrim e,
SupportedPrim f) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> r)
-> ((# #) -> r)
-> r
$bTFun6Type :: forall t a b c d e f.
(SupportedPrim t, t ~~ (a =-> (b =-> (c =-> (d =-> (e =-> f))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep t
TFun6Type a b c d e f =
TFunType
a
( TFunType
b
( TFunType
c
( TFunType
d
(TFunType e f)
)
)
)
pattern TFun7Type ::
forall t.
(SupportedPrim t) =>
forall
(a :: Type)
(b :: Type)
(c :: Type)
(d :: Type)
(e :: Type)
(f :: Type)
(g :: Type).
( t ~~ (a =-> b =-> c =-> d =-> e =-> f =-> g),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e,
SupportedPrim f,
SupportedPrim g
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep f ->
R.TypeRep g ->
R.TypeRep t
pattern $mTFun7Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e} {f} {g}.
(t ~~ (a =-> (b =-> (c =-> (d =-> (e =-> (f =-> g)))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> r)
-> ((# #) -> r)
-> r
$bTFun7Type :: forall t a b c d e f g.
(SupportedPrim t,
t ~~ (a =-> (b =-> (c =-> (d =-> (e =-> (f =-> g)))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep t
TFun7Type a b c d e f g =
TFunType
a
( TFunType
b
( TFunType
c
( TFunType
d
( TFunType
e
(TFunType f g)
)
)
)
)
pattern TFun8Type ::
forall t.
(SupportedPrim t) =>
forall
(a :: Type)
(b :: Type)
(c :: Type)
(d :: Type)
(e :: Type)
(f :: Type)
(g :: Type)
(h :: Type).
( t ~~ (a =-> b =-> c =-> d =-> e =-> f =-> g =-> h),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e,
SupportedPrim f,
SupportedPrim g,
SupportedPrim h
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep f ->
R.TypeRep g ->
R.TypeRep h ->
R.TypeRep t
pattern $mTFun8Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e} {f} {g} {h}.
(t ~~ (a =-> (b =-> (c =-> (d =-> (e =-> (f =-> (g =-> h))))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g,
SupportedPrim h) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep h
-> r)
-> ((# #) -> r)
-> r
$bTFun8Type :: forall t a b c d e f g h.
(SupportedPrim t,
t ~~ (a =-> (b =-> (c =-> (d =-> (e =-> (f =-> (g =-> h))))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g,
SupportedPrim h) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep h
-> TypeRep t
TFun8Type a b c d e f g h =
TFunType
a
( TFunType
b
( TFunType
c
( TFunType
d
( TFunType
e
( TFunType
f
(TFunType g h)
)
)
)
)
)
data GFunTypeContainer :: forall k. k -> Type where
GFunTypeContainer :: (SupportedPrim a, SupportedPrim b) => R.TypeRep a -> R.TypeRep b -> GFunTypeContainer (a --> b)
gFunTypeView :: forall t. (SupportedPrim t) => R.TypeRep t -> Maybe (GFunTypeContainer t)
gFunTypeView :: forall t.
SupportedPrim t =>
TypeRep t -> Maybe (GFunTypeContainer t)
gFunTypeView TypeRep t
t = case TypeRep t
t of
R.App (R.App TypeRep a
arr (TypeRep b
ta2' :: R.TypeRep a2)) (TypeRep b
tr2' :: R.TypeRep r2) ->
case TypeRep a -> TypeRep (-->) -> Maybe (a :~~: (-->))
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
R.eqTypeRep TypeRep a
arr (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> * -> *). Typeable a => TypeRep a
R.typeRep @(-->)) of
Just a :~~: (-->)
R.HRefl -> GFunTypeContainer t -> Maybe (GFunTypeContainer t)
forall a. a -> Maybe a
Just (GFunTypeContainer t -> Maybe (GFunTypeContainer t))
-> GFunTypeContainer t -> Maybe (GFunTypeContainer t)
forall a b. (a -> b) -> a -> b
$ Proxy t
-> (PrimConstraint t => GFunTypeContainer t) -> GFunTypeContainer t
forall t (proxy :: * -> *) a.
SupportedPrim t =>
proxy t -> (PrimConstraint t => a) -> a
forall (proxy :: * -> *) a. proxy t -> (PrimConstraint t => a) -> a
withPrim (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) ((PrimConstraint t => GFunTypeContainer t) -> GFunTypeContainer t)
-> (PrimConstraint t => GFunTypeContainer t) -> GFunTypeContainer t
forall a b. (a -> b) -> a -> b
$ TypeRep b -> TypeRep b -> GFunTypeContainer (b --> b)
forall s' b.
(SupportedPrim s', SupportedPrim b) =>
TypeRep s' -> TypeRep b -> GFunTypeContainer (s' --> b)
GFunTypeContainer TypeRep b
TypeRep b
ta2' TypeRep b
TypeRep b
tr2'
Maybe (a :~~: (-->))
Nothing -> Maybe (GFunTypeContainer t)
forall a. Maybe a
Nothing
TypeRep t
_ -> Maybe (GFunTypeContainer t)
forall a. Maybe a
Nothing
pattern GFunType ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type).
(t ~~ (a --> b), SupportedPrim a, SupportedPrim b) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep t
pattern $mGFunType :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b}.
(t ~~ (a --> b), SupportedPrim a, SupportedPrim b) =>
TypeRep a -> TypeRep b -> r)
-> ((# #) -> r)
-> r
$bGFunType :: forall t a b.
(SupportedPrim t, t ~~ (a --> b), SupportedPrim a,
SupportedPrim b) =>
TypeRep a -> TypeRep b -> TypeRep t
GFunType a b <-
(gFunTypeView -> Just (GFunTypeContainer a b))
where
GFunType TypeRep a
a TypeRep b
b = TypeRep ((-->) a) -> TypeRep b -> TypeRep t
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
R.App (TypeRep (-->) -> TypeRep a -> TypeRep ((-->) a)
forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
R.App (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> * -> *). Typeable a => TypeRep a
R.typeRep @(-->)) TypeRep a
a) TypeRep b
b
pattern GFun3Type ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type) (c :: Type).
(t ~~ (a --> b --> c), SupportedPrim a, SupportedPrim b, SupportedPrim c) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep t
pattern $mGFun3Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c}.
(t ~~ (a --> (b --> c)), SupportedPrim a, SupportedPrim b,
SupportedPrim c) =>
TypeRep a -> TypeRep b -> TypeRep c -> r)
-> ((# #) -> r)
-> r
$bGFun3Type :: forall t a b c.
(SupportedPrim t, t ~~ (a --> (b --> c)), SupportedPrim a,
SupportedPrim b, SupportedPrim c) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep t
GFun3Type a b c = GFunType a (GFunType b c)
pattern GFun4Type ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type) (c :: Type) (d :: Type).
( t ~~ (a --> b --> c --> d),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep t
pattern $mGFun4Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d}.
(t ~~ (a --> (b --> (c --> d))), SupportedPrim a, SupportedPrim b,
SupportedPrim c, SupportedPrim d) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> r)
-> ((# #) -> r)
-> r
$bGFun4Type :: forall t a b c d.
(SupportedPrim t, t ~~ (a --> (b --> (c --> d))), SupportedPrim a,
SupportedPrim b, SupportedPrim c, SupportedPrim d) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> TypeRep t
GFun4Type a b c d = GFunType a (GFunType b (GFunType c d))
pattern GFun5Type ::
forall t.
(SupportedPrim t) =>
forall (a :: Type) (b :: Type) (c :: Type) (d :: Type) (e :: Type).
( t ~~ (a --> b --> c --> d --> e),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep t
pattern $mGFun5Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e}.
(t ~~ (a --> (b --> (c --> (d --> e)))), SupportedPrim a,
SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e) =>
TypeRep a -> TypeRep b -> TypeRep c -> TypeRep d -> TypeRep e -> r)
-> ((# #) -> r)
-> r
$bGFun5Type :: forall t a b c d e.
(SupportedPrim t, t ~~ (a --> (b --> (c --> (d --> e)))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e) =>
TypeRep a
-> TypeRep b -> TypeRep c -> TypeRep d -> TypeRep e -> TypeRep t
GFun5Type a b c d e =
GFunType
a
( GFunType
b
( GFunType
c
(GFunType d e)
)
)
pattern GFun6Type ::
forall t.
(SupportedPrim t) =>
forall
(a :: Type)
(b :: Type)
(c :: Type)
(d :: Type)
(e :: Type)
(f :: Type).
( t ~~ (a --> b --> c --> d --> e --> f),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e,
SupportedPrim f
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep f ->
R.TypeRep t
pattern $mGFun6Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e} {f}.
(t ~~ (a --> (b --> (c --> (d --> (e --> f))))), SupportedPrim a,
SupportedPrim b, SupportedPrim c, SupportedPrim d, SupportedPrim e,
SupportedPrim f) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> r)
-> ((# #) -> r)
-> r
$bGFun6Type :: forall t a b c d e f.
(SupportedPrim t, t ~~ (a --> (b --> (c --> (d --> (e --> f))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep t
GFun6Type a b c d e f =
GFunType
a
( GFunType
b
( GFunType
c
( GFunType
d
(GFunType e f)
)
)
)
pattern GFun7Type ::
forall t.
(SupportedPrim t) =>
forall
(a :: Type)
(b :: Type)
(c :: Type)
(d :: Type)
(e :: Type)
(f :: Type)
(g :: Type).
( t ~~ (a --> b --> c --> d --> e --> f --> g),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e,
SupportedPrim f,
SupportedPrim g
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep f ->
R.TypeRep g ->
R.TypeRep t
pattern $mGFun7Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e} {f} {g}.
(t ~~ (a --> (b --> (c --> (d --> (e --> (f --> g)))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> r)
-> ((# #) -> r)
-> r
$bGFun7Type :: forall t a b c d e f g.
(SupportedPrim t,
t ~~ (a --> (b --> (c --> (d --> (e --> (f --> g)))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep t
GFun7Type a b c d e f g =
GFunType
a
( GFunType
b
( GFunType
c
( GFunType
d
( GFunType
e
(GFunType f g)
)
)
)
)
pattern GFun8Type ::
forall t.
(SupportedPrim t) =>
forall
(a :: Type)
(b :: Type)
(c :: Type)
(d :: Type)
(e :: Type)
(f :: Type)
(g :: Type)
(h :: Type).
( t ~~ (a --> b --> c --> d --> e --> f --> g --> h),
SupportedPrim a,
SupportedPrim b,
SupportedPrim c,
SupportedPrim d,
SupportedPrim e,
SupportedPrim f,
SupportedPrim g,
SupportedPrim h
) =>
R.TypeRep a ->
R.TypeRep b ->
R.TypeRep c ->
R.TypeRep d ->
R.TypeRep e ->
R.TypeRep f ->
R.TypeRep g ->
R.TypeRep h ->
R.TypeRep t
pattern $mGFun8Type :: forall {r} {t}.
SupportedPrim t =>
TypeRep t
-> (forall {a} {b} {c} {d} {e} {f} {g} {h}.
(t ~~ (a --> (b --> (c --> (d --> (e --> (f --> (g --> h))))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g,
SupportedPrim h) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep h
-> r)
-> ((# #) -> r)
-> r
$bGFun8Type :: forall t a b c d e f g h.
(SupportedPrim t,
t ~~ (a --> (b --> (c --> (d --> (e --> (f --> (g --> h))))))),
SupportedPrim a, SupportedPrim b, SupportedPrim c, SupportedPrim d,
SupportedPrim e, SupportedPrim f, SupportedPrim g,
SupportedPrim h) =>
TypeRep a
-> TypeRep b
-> TypeRep c
-> TypeRep d
-> TypeRep e
-> TypeRep f
-> TypeRep g
-> TypeRep h
-> TypeRep t
GFun8Type a b c d e f g h =
GFunType
a
( GFunType
b
( GFunType
c
( GFunType
d
( GFunType
e
( GFunType
f
(GFunType g h)
)
)
)
)
)
pattern BoolType ::
forall t.
() =>
(t ~~ Bool) =>
R.TypeRep t
pattern $mBoolType :: forall {r} {k} {t :: k}.
TypeRep t -> ((t ~~ Bool) => r) -> ((# #) -> r) -> r
BoolType <- (R.eqTypeRep (R.typeRep @Bool) -> Just R.HRefl)
pattern IntegerType ::
forall t.
() =>
(t ~~ Integer) =>
R.TypeRep t
pattern $mIntegerType :: forall {r} {k} {t :: k}.
TypeRep t -> ((t ~~ Integer) => r) -> ((# #) -> r) -> r
IntegerType <- (R.eqTypeRep (R.typeRep @Integer) -> Just R.HRefl)
type ConfigConstraint integerBitWidth s =
( SBV.SBV s ~ TermTy integerBitWidth Integer,
SBV.SymVal s,
SBV.HasKind s,
Typeable s,
Num (SBV.SBV s),
Num s,
SBV.OrdSymbolic (SBV.SBV s),
Ord s,
SBV.SDivisible (SBV.SBV s),
SBV.OrdSymbolic (SBV.SBV s),
SBV.Mergeable (SBV.SBV s)
)
data DictConfig integerBitWidth where
DictConfig ::
forall s integerBitWidth.
(ConfigConstraint integerBitWidth s) =>
SBV.SMTConfig ->
DictConfig integerBitWidth
resolveConfigView ::
forall integerBitWidth.
GrisetteSMTConfig integerBitWidth ->
DictConfig integerBitWidth
resolveConfigView :: forall (integerBitWidth :: Nat).
GrisetteSMTConfig integerBitWidth -> DictConfig integerBitWidth
resolveConfigView GrisetteSMTConfig integerBitWidth
config = case GrisetteSMTConfig integerBitWidth
config of
GrisetteSMTConfig SMTConfig
c ExtraConfig integerBitWidth
extra ->
case ExtraConfig integerBitWidth -> ApproximationConfig integerBitWidth
forall (i :: Nat). ExtraConfig i -> ApproximationConfig i
integerApprox ExtraConfig integerBitWidth
extra of
ApproximationConfig integerBitWidth
NoApprox -> SMTConfig -> DictConfig integerBitWidth
forall s' (integerBitWidth :: Nat).
ConfigConstraint integerBitWidth s' =>
SMTConfig -> DictConfig integerBitWidth
DictConfig SMTConfig
c
Approx p integerBitWidth
_ -> SMTConfig -> DictConfig integerBitWidth
forall s' (integerBitWidth :: Nat).
ConfigConstraint integerBitWidth s' =>
SMTConfig -> DictConfig integerBitWidth
DictConfig SMTConfig
c
pattern ResolvedConfig ::
forall integerBitWidth.
() =>
forall s.
(ConfigConstraint integerBitWidth s) =>
SBV.SMTConfig ->
GrisetteSMTConfig integerBitWidth
pattern $mResolvedConfig :: forall {r} {integerBitWidth :: Nat}.
GrisetteSMTConfig integerBitWidth
-> (forall {s}.
ConfigConstraint integerBitWidth s =>
SMTConfig -> r)
-> ((# #) -> r)
-> r
ResolvedConfig c <- (resolveConfigView -> DictConfig c)
type MergeableTypeConstraint integerBitWidth s =
( Typeable (TermTy integerBitWidth s),
SBV.Mergeable (TermTy integerBitWidth s)
)
data DictMergeableType integerBitWidth s where
DictMergeableType ::
forall integerBitWidth s.
(MergeableTypeConstraint integerBitWidth s) =>
DictMergeableType integerBitWidth s
resolveMergeableTypeView :: TypeResolver DictMergeableType
resolveMergeableTypeView :: TypeResolver DictMergeableType
resolveMergeableTypeView (config :: GrisetteSMTConfig integerBitWidth
config@ResolvedConfig {}, TypeRep s
s) = case TypeRep s
s of
TypeRep s
BoolType -> DictMergeableType integerBitWidth s
-> Maybe (DictMergeableType integerBitWidth s)
forall a. a -> Maybe a
Just DictMergeableType integerBitWidth s
forall (integerBitWidth :: Nat) s.
MergeableTypeConstraint integerBitWidth s =>
DictMergeableType integerBitWidth s
DictMergeableType
TypeRep s
IntegerType -> DictMergeableType integerBitWidth s
-> Maybe (DictMergeableType integerBitWidth s)
forall a. a -> Maybe a
Just DictMergeableType integerBitWidth s
forall (integerBitWidth :: Nat) s.
MergeableTypeConstraint integerBitWidth s =>
DictMergeableType integerBitWidth s
DictMergeableType
SignedBVType Proxy n
_ -> DictMergeableType integerBitWidth s
-> Maybe (DictMergeableType integerBitWidth s)
forall a. a -> Maybe a
Just DictMergeableType integerBitWidth s
forall (integerBitWidth :: Nat) s.
MergeableTypeConstraint integerBitWidth s =>
DictMergeableType integerBitWidth s
DictMergeableType
UnsignedBVType Proxy n
_ -> DictMergeableType integerBitWidth s
-> Maybe (DictMergeableType integerBitWidth s)
forall a. a -> Maybe a
Just DictMergeableType integerBitWidth s
forall (integerBitWidth :: Nat) s.
MergeableTypeConstraint integerBitWidth s =>
DictMergeableType integerBitWidth s
DictMergeableType
TFunType TypeRep a
l TypeRep b
r ->
case ((GrisetteSMTConfig integerBitWidth, TypeRep a)
-> Maybe (DictSimpleType integerBitWidth a)
TypeResolver DictSimpleType
resolveSimpleTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep a
l), (GrisetteSMTConfig integerBitWidth, TypeRep b)
-> Maybe (DictMergeableType integerBitWidth b)
TypeResolver DictMergeableType
resolveMergeableTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep b
r)) of
(Just DictSimpleType integerBitWidth a
DictSimpleType, Just DictMergeableType integerBitWidth b
DictMergeableType) -> DictMergeableType integerBitWidth s
-> Maybe (DictMergeableType integerBitWidth s)
forall a. a -> Maybe a
Just DictMergeableType integerBitWidth s
forall (integerBitWidth :: Nat) s.
MergeableTypeConstraint integerBitWidth s =>
DictMergeableType integerBitWidth s
DictMergeableType
(Maybe (DictSimpleType integerBitWidth a),
Maybe (DictMergeableType integerBitWidth b))
_ -> Maybe (DictMergeableType integerBitWidth s)
forall a. Maybe a
Nothing
GFunType TypeRep a
l TypeRep b
r ->
case ((GrisetteSMTConfig integerBitWidth, TypeRep a)
-> Maybe (DictSimpleType integerBitWidth a)
TypeResolver DictSimpleType
resolveSimpleTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep a
l), (GrisetteSMTConfig integerBitWidth, TypeRep b)
-> Maybe (DictMergeableType integerBitWidth b)
TypeResolver DictMergeableType
resolveMergeableTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep b
r)) of
(Just DictSimpleType integerBitWidth a
DictSimpleType, Just DictMergeableType integerBitWidth b
DictMergeableType) -> DictMergeableType integerBitWidth s
-> Maybe (DictMergeableType integerBitWidth s)
forall a. a -> Maybe a
Just DictMergeableType integerBitWidth s
forall (integerBitWidth :: Nat) s.
MergeableTypeConstraint integerBitWidth s =>
DictMergeableType integerBitWidth s
DictMergeableType
(Maybe (DictSimpleType integerBitWidth a),
Maybe (DictMergeableType integerBitWidth b))
_ -> Maybe (DictMergeableType integerBitWidth s)
forall a. Maybe a
Nothing
TypeRep s
_ -> Maybe (DictMergeableType integerBitWidth s)
forall a. Maybe a
Nothing
resolveMergeableTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
_ = [Char] -> Maybe (DictMergeableType integerBitWidth s)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen, make compiler happy"
pattern ResolvedMergeableType ::
forall integerBitWidth s.
(SupportedPrim s) =>
(MergeableTypeConstraint integerBitWidth s) =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedMergeableType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (MergeableTypeConstraint integerBitWidth s => r)
-> ((# #) -> r)
-> r
ResolvedMergeableType <- (resolveMergeableTypeView -> Just DictMergeableType)
type SimpleTypeConstraint integerBitWidth s s' =
( SBV.SBV s' ~ TermTy integerBitWidth s,
SBV.SymVal s',
SBV.HasKind s',
Typeable s',
SBV.OrdSymbolic (SBV.SBV s'),
SBV.Mergeable (SBV.SBV s')
)
type TypeResolver dictType =
forall integerBitWidth s.
(SupportedPrim s) =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s) ->
Maybe (dictType integerBitWidth s)
data DictSimpleType integerBitWidth s where
DictSimpleType ::
forall integerBitWidth s s'.
(SimpleTypeConstraint integerBitWidth s s') =>
DictSimpleType integerBitWidth s
resolveSimpleTypeView :: TypeResolver DictSimpleType
resolveSimpleTypeView :: TypeResolver DictSimpleType
resolveSimpleTypeView (ResolvedConfig {}, TypeRep s
s) = case TypeRep s
s of
TypeRep s
BoolType -> DictSimpleType integerBitWidth s
-> Maybe (DictSimpleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSimpleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SimpleTypeConstraint integerBitWidth s s' =>
DictSimpleType integerBitWidth s
DictSimpleType
TypeRep s
IntegerType -> DictSimpleType integerBitWidth s
-> Maybe (DictSimpleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSimpleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SimpleTypeConstraint integerBitWidth s s' =>
DictSimpleType integerBitWidth s
DictSimpleType
SignedBVType Proxy n
_ -> DictSimpleType integerBitWidth s
-> Maybe (DictSimpleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSimpleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SimpleTypeConstraint integerBitWidth s s' =>
DictSimpleType integerBitWidth s
DictSimpleType
UnsignedBVType Proxy n
_ -> DictSimpleType integerBitWidth s
-> Maybe (DictSimpleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSimpleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SimpleTypeConstraint integerBitWidth s s' =>
DictSimpleType integerBitWidth s
DictSimpleType
TypeRep s
_ -> Maybe (DictSimpleType integerBitWidth s)
forall a. Maybe a
Nothing
resolveSimpleTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
_ = [Char] -> Maybe (DictSimpleType integerBitWidth s)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen, make compiler happy"
pattern ResolvedSimpleType ::
forall integerBitWidth s.
(SupportedPrim s) =>
forall s'.
(SimpleTypeConstraint integerBitWidth s s') =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedSimpleType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (forall {s'}. SimpleTypeConstraint integerBitWidth s s' => r)
-> ((# #) -> r)
-> r
ResolvedSimpleType <- (resolveSimpleTypeView -> Just DictSimpleType)
type DeepTypeConstraint integerBitWidth s s' =
( s' ~ TermTy integerBitWidth s,
Typeable s',
SBV.Mergeable s'
)
data DictDeepType integerBitWidth s where
DictDeepType ::
forall integerBitWidth s s'.
(DeepTypeConstraint integerBitWidth s s') =>
DictDeepType integerBitWidth s
resolveDeepTypeView :: TypeResolver DictDeepType
resolveDeepTypeView :: TypeResolver DictDeepType
resolveDeepTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
r = case (GrisetteSMTConfig integerBitWidth, TypeRep s)
r of
(GrisetteSMTConfig integerBitWidth, TypeRep s)
ResolvedSimpleType -> DictDeepType integerBitWidth s
-> Maybe (DictDeepType integerBitWidth s)
forall a. a -> Maybe a
Just DictDeepType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
DeepTypeConstraint integerBitWidth s s' =>
DictDeepType integerBitWidth s
DictDeepType
(GrisetteSMTConfig integerBitWidth
config, TFunType (TypeRep a
ta :: R.TypeRep a) (TypeRep b
tb :: R.TypeRep b)) ->
case ((GrisetteSMTConfig integerBitWidth, TypeRep a)
-> Maybe (DictDeepType integerBitWidth a)
TypeResolver DictDeepType
resolveDeepTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep a
ta), (GrisetteSMTConfig integerBitWidth, TypeRep b)
-> Maybe (DictDeepType integerBitWidth b)
TypeResolver DictDeepType
resolveDeepTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep b
tb)) of
(Just DictDeepType integerBitWidth a
DictDeepType, Just DictDeepType integerBitWidth b
DictDeepType) -> DictDeepType integerBitWidth s
-> Maybe (DictDeepType integerBitWidth s)
forall a. a -> Maybe a
Just DictDeepType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
DeepTypeConstraint integerBitWidth s s' =>
DictDeepType integerBitWidth s
DictDeepType
(Maybe (DictDeepType integerBitWidth a),
Maybe (DictDeepType integerBitWidth b))
_ -> Maybe (DictDeepType integerBitWidth s)
forall a. Maybe a
Nothing
(GrisetteSMTConfig integerBitWidth
config, GFunType (TypeRep a
ta :: R.TypeRep a) (TypeRep b
tb :: R.TypeRep b)) ->
case ((GrisetteSMTConfig integerBitWidth, TypeRep a)
-> Maybe (DictDeepType integerBitWidth a)
TypeResolver DictDeepType
resolveDeepTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep a
ta), (GrisetteSMTConfig integerBitWidth, TypeRep b)
-> Maybe (DictDeepType integerBitWidth b)
TypeResolver DictDeepType
resolveDeepTypeView (GrisetteSMTConfig integerBitWidth
config, TypeRep b
tb)) of
(Just DictDeepType integerBitWidth a
DictDeepType, Just DictDeepType integerBitWidth b
DictDeepType) -> DictDeepType integerBitWidth s
-> Maybe (DictDeepType integerBitWidth s)
forall a. a -> Maybe a
Just DictDeepType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
DeepTypeConstraint integerBitWidth s s' =>
DictDeepType integerBitWidth s
DictDeepType
(Maybe (DictDeepType integerBitWidth a),
Maybe (DictDeepType integerBitWidth b))
_ -> Maybe (DictDeepType integerBitWidth s)
forall a. Maybe a
Nothing
(GrisetteSMTConfig integerBitWidth, TypeRep s)
_ -> Maybe (DictDeepType integerBitWidth s)
forall a. Maybe a
Nothing
pattern ResolvedDeepType ::
forall integerBitWidth s.
(SupportedPrim s) =>
forall s'.
(DeepTypeConstraint integerBitWidth s s') =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedDeepType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (forall {s'}. DeepTypeConstraint integerBitWidth s s' => r)
-> ((# #) -> r)
-> r
ResolvedDeepType <- (resolveDeepTypeView -> Just DictDeepType)
type NumTypeConstraint integerBitWidth s s' =
( SimpleTypeConstraint integerBitWidth s s',
Num (SBV.SBV s'),
Num s',
Num s
)
data DictNumType integerBitWidth s where
DictNumType ::
forall integerBitWidth s s'.
(NumTypeConstraint integerBitWidth s s') =>
DictNumType integerBitWidth s
resolveNumTypeView :: TypeResolver DictNumType
resolveNumTypeView :: TypeResolver DictNumType
resolveNumTypeView (ResolvedConfig {}, TypeRep s
s) = case TypeRep s
s of
TypeRep s
IntegerType -> DictNumType integerBitWidth s
-> Maybe (DictNumType integerBitWidth s)
forall a. a -> Maybe a
Just DictNumType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
NumTypeConstraint integerBitWidth s s' =>
DictNumType integerBitWidth s
DictNumType
SignedBVType Proxy n
_ -> DictNumType integerBitWidth s
-> Maybe (DictNumType integerBitWidth s)
forall a. a -> Maybe a
Just DictNumType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
NumTypeConstraint integerBitWidth s s' =>
DictNumType integerBitWidth s
DictNumType
UnsignedBVType Proxy n
_ -> DictNumType integerBitWidth s
-> Maybe (DictNumType integerBitWidth s)
forall a. a -> Maybe a
Just DictNumType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
NumTypeConstraint integerBitWidth s s' =>
DictNumType integerBitWidth s
DictNumType
TypeRep s
_ -> Maybe (DictNumType integerBitWidth s)
forall a. Maybe a
Nothing
resolveNumTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
_ = [Char] -> Maybe (DictNumType integerBitWidth s)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen, make compiler happy"
pattern ResolvedNumType ::
forall integerBitWidth s.
(SupportedPrim s) =>
forall s'.
(NumTypeConstraint integerBitWidth s s') =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedNumType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (forall {s'}. NumTypeConstraint integerBitWidth s s' => r)
-> ((# #) -> r)
-> r
ResolvedNumType <- (resolveNumTypeView -> Just DictNumType)
type SDivisibleTypeConstraint integerBitWidth s s' =
( SimpleTypeConstraint integerBitWidth s s',
SBV.SDivisible (SBV.SBV s'),
Integral s
)
data DictSDivisibleType integerBitWidth s where
DictSDivisibleType ::
forall integerBitWidth s s'.
(SDivisibleTypeConstraint integerBitWidth s s') =>
DictSDivisibleType integerBitWidth s
resolveSDivisibleTypeView :: TypeResolver DictSDivisibleType
resolveSDivisibleTypeView :: TypeResolver DictSDivisibleType
resolveSDivisibleTypeView (ResolvedConfig {}, TypeRep s
s) = case TypeRep s
s of
TypeRep s
IntegerType -> DictSDivisibleType integerBitWidth s
-> Maybe (DictSDivisibleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSDivisibleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SDivisibleTypeConstraint integerBitWidth s s' =>
DictSDivisibleType integerBitWidth s
DictSDivisibleType
SignedBVType Proxy n
_ -> DictSDivisibleType integerBitWidth s
-> Maybe (DictSDivisibleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSDivisibleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SDivisibleTypeConstraint integerBitWidth s s' =>
DictSDivisibleType integerBitWidth s
DictSDivisibleType
UnsignedBVType Proxy n
_ -> DictSDivisibleType integerBitWidth s
-> Maybe (DictSDivisibleType integerBitWidth s)
forall a. a -> Maybe a
Just DictSDivisibleType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
SDivisibleTypeConstraint integerBitWidth s s' =>
DictSDivisibleType integerBitWidth s
DictSDivisibleType
TypeRep s
_ -> Maybe (DictSDivisibleType integerBitWidth s)
forall a. Maybe a
Nothing
resolveSDivisibleTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
_ = [Char] -> Maybe (DictSDivisibleType integerBitWidth s)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen, make compiler happy"
pattern ResolvedSDivisibleType ::
forall integerBitWidth s.
(SupportedPrim s) =>
forall s'.
(SDivisibleTypeConstraint integerBitWidth s s') =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedSDivisibleType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (forall {s'}.
SDivisibleTypeConstraint integerBitWidth s s' =>
r)
-> ((# #) -> r)
-> r
ResolvedSDivisibleType <- (resolveSDivisibleTypeView -> Just DictSDivisibleType)
type NumOrdTypeConstraint integerBitWidth s s' =
( NumTypeConstraint integerBitWidth s s',
SBV.OrdSymbolic (SBV.SBV s'),
Ord s',
Ord s
)
data DictNumOrdType integerBitWidth s where
DictNumOrdType ::
forall integerBitWidth s s'.
(NumOrdTypeConstraint integerBitWidth s s') =>
DictNumOrdType integerBitWidth s
resolveNumOrdTypeView :: TypeResolver DictNumOrdType
resolveNumOrdTypeView :: TypeResolver DictNumOrdType
resolveNumOrdTypeView (ResolvedConfig {}, TypeRep s
s) = case TypeRep s
s of
TypeRep s
IntegerType -> DictNumOrdType integerBitWidth s
-> Maybe (DictNumOrdType integerBitWidth s)
forall a. a -> Maybe a
Just DictNumOrdType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
NumOrdTypeConstraint integerBitWidth s s' =>
DictNumOrdType integerBitWidth s
DictNumOrdType
SignedBVType Proxy n
_ -> DictNumOrdType integerBitWidth s
-> Maybe (DictNumOrdType integerBitWidth s)
forall a. a -> Maybe a
Just DictNumOrdType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
NumOrdTypeConstraint integerBitWidth s s' =>
DictNumOrdType integerBitWidth s
DictNumOrdType
UnsignedBVType Proxy n
_ -> DictNumOrdType integerBitWidth s
-> Maybe (DictNumOrdType integerBitWidth s)
forall a. a -> Maybe a
Just DictNumOrdType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
NumOrdTypeConstraint integerBitWidth s s' =>
DictNumOrdType integerBitWidth s
DictNumOrdType
TypeRep s
_ -> Maybe (DictNumOrdType integerBitWidth s)
forall a. Maybe a
Nothing
resolveNumOrdTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
_ = [Char] -> Maybe (DictNumOrdType integerBitWidth s)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen, make compiler happy"
pattern ResolvedNumOrdType ::
forall integerBitWidth s.
(SupportedPrim s) =>
forall s'.
(NumOrdTypeConstraint integerBitWidth s s') =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedNumOrdType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (forall {s'}. NumOrdTypeConstraint integerBitWidth s s' => r)
-> ((# #) -> r)
-> r
ResolvedNumOrdType <- (resolveNumOrdTypeView -> Just DictNumOrdType)
type BitsTypeConstraint integerBitWidth s s' =
( SimpleTypeConstraint integerBitWidth s s',
Bits (SBV.SBV s'),
Bits s',
Bits s,
SIntegral s',
Integral s
)
data DictBitsType integerBitWidth s where
DictBitsType ::
forall integerBitWidth s s'.
(BitsTypeConstraint integerBitWidth s s') =>
DictBitsType integerBitWidth s
resolveBitsTypeView :: TypeResolver DictBitsType
resolveBitsTypeView :: TypeResolver DictBitsType
resolveBitsTypeView (ResolvedConfig {}, TypeRep s
s) = case TypeRep s
s of
SignedBVType Proxy n
_ -> DictBitsType integerBitWidth s
-> Maybe (DictBitsType integerBitWidth s)
forall a. a -> Maybe a
Just DictBitsType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
BitsTypeConstraint integerBitWidth s s' =>
DictBitsType integerBitWidth s
DictBitsType
UnsignedBVType Proxy n
_ -> DictBitsType integerBitWidth s
-> Maybe (DictBitsType integerBitWidth s)
forall a. a -> Maybe a
Just DictBitsType integerBitWidth s
forall (integerBitWidth :: Nat) s s'.
BitsTypeConstraint integerBitWidth s s' =>
DictBitsType integerBitWidth s
DictBitsType
TypeRep s
_ -> Maybe (DictBitsType integerBitWidth s)
forall a. Maybe a
Nothing
resolveBitsTypeView (GrisetteSMTConfig integerBitWidth, TypeRep s)
_ = [Char] -> Maybe (DictBitsType integerBitWidth s)
forall a. HasCallStack => [Char] -> a
error [Char]
"Should never happen, make compiler happy"
pattern ResolvedBitsType ::
forall integerBitWidth s.
(SupportedPrim s) =>
forall s'.
(BitsTypeConstraint integerBitWidth s s') =>
(GrisetteSMTConfig integerBitWidth, R.TypeRep s)
pattern $mResolvedBitsType :: forall {r} {integerBitWidth :: Nat} {s}.
SupportedPrim s =>
(GrisetteSMTConfig integerBitWidth, TypeRep s)
-> (forall {s'}. BitsTypeConstraint integerBitWidth s s' => r)
-> ((# #) -> r)
-> r
ResolvedBitsType <- (resolveBitsTypeView -> Just DictBitsType)