{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Grisette.Internal.Internal.Impl.Core.Data.Class.ToSym () where
import Control.Monad.Identity
( Identity (Identity, runIdentity),
IdentityT (IdentityT),
)
import Control.Monad.Reader (ReaderT (ReaderT))
import qualified Control.Monad.State.Lazy as StateLazy
import qualified Control.Monad.State.Strict as StateStrict
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Maybe (MaybeT)
import qualified Control.Monad.Writer.Lazy as WriterLazy
import qualified Control.Monad.Writer.Strict as WriterStrict
import qualified Data.ByteString as B
import Data.Functor.Compose (Compose (Compose))
import Data.Functor.Const (Const)
import Data.Functor.Product (Product)
import Data.Functor.Sum (Sum)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Monoid (Alt, Ap)
import qualified Data.Monoid as Monoid
import Data.Ord (Down)
import Data.Ratio (Ratio, denominator, numerator, (%))
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.TypeNats (KnownNat, type (<=))
import Generics.Deriving
( Default (Default),
Default1 (Default1),
K1 (K1),
M1 (M1),
Par1 (Par1),
Rec1 (Rec1),
U1,
V1,
(:.:) (Comp1),
type (:*:),
type (:+:),
)
import Grisette.Internal.Core.Control.Exception
( AssertionError,
VerificationConditions,
)
import Grisette.Internal.Core.Data.Class.BitCast (BitCast (bitCast))
import Grisette.Internal.Core.Data.Class.Solvable (Solvable (con))
import Grisette.Internal.Internal.Decl.Core.Data.Class.ToSym
( ToSym (toSym),
ToSym1 (liftToSym),
ToSym2 (liftToSym2),
toSym1,
)
import Grisette.Internal.Internal.Impl.Core.Data.Class.Mergeable ()
import Grisette.Internal.SymPrim.AlgReal (AlgReal)
import Grisette.Internal.SymPrim.BV
( IntN,
WordN,
)
import Grisette.Internal.SymPrim.FP
( FP,
FPRoundingMode,
NotRepresentableFPError,
ValidFP,
)
import Grisette.Internal.SymPrim.GeneralFun (type (-->))
import Grisette.Internal.SymPrim.IntBitwidth (intBitwidthQ)
import Grisette.Internal.SymPrim.Prim.Term
( LinkedRep,
SupportedNonFuncPrim,
SupportedPrim,
)
import Grisette.Internal.SymPrim.SymAlgReal (SymAlgReal)
import Grisette.Internal.SymPrim.SymBV
( SymIntN,
SymWordN,
)
import Grisette.Internal.SymPrim.SymBool (SymBool)
import Grisette.Internal.SymPrim.SymFP
( SymFP,
SymFP32,
SymFP64,
SymFPRoundingMode,
)
import Grisette.Internal.SymPrim.SymGeneralFun (type (-~>))
import Grisette.Internal.SymPrim.SymInteger (SymInteger)
import Grisette.Internal.SymPrim.SymTabularFun (type (=~>))
import Grisette.Internal.SymPrim.TabularFun (type (=->))
import Grisette.Internal.TH.Derivation.Derive (derive)
#define CONCRETE_TOSYM(type) \
instance ToSym type type where \
toSym = id
#define CONCRETE_TOSYM_BV(type) \
instance (KnownNat n, 1 <= n) => ToSym (type n) (type n) where \
toSym = id
#if 1
CONCRETE_TOSYM(Bool)
CONCRETE_TOSYM(Integer)
CONCRETE_TOSYM(Char)
CONCRETE_TOSYM(Int)
CONCRETE_TOSYM(Int8)
CONCRETE_TOSYM(Int16)
CONCRETE_TOSYM(Int32)
CONCRETE_TOSYM(Int64)
CONCRETE_TOSYM(Word)
CONCRETE_TOSYM(Word8)
CONCRETE_TOSYM(Word16)
CONCRETE_TOSYM(Word32)
CONCRETE_TOSYM(Word64)
CONCRETE_TOSYM(Float)
CONCRETE_TOSYM(Double)
CONCRETE_TOSYM(B.ByteString)
CONCRETE_TOSYM(T.Text)
CONCRETE_TOSYM(FPRoundingMode)
CONCRETE_TOSYM_BV(IntN)
CONCRETE_TOSYM_BV(WordN)
CONCRETE_TOSYM(Monoid.All)
CONCRETE_TOSYM(Monoid.Any)
CONCRETE_TOSYM(Ordering)
#endif
instance (ValidFP eb sb) => ToSym (FP eb sb) (FP eb sb) where
toSym :: FP eb sb -> FP eb sb
toSym = FP eb sb -> FP eb sb
forall a. a -> a
id
instance ToSym (a =-> b) (a =-> b) where
toSym :: (a =-> b) -> a =-> b
toSym = (a =-> b) -> a =-> b
forall a. a -> a
id
instance ToSym (a --> b) (a --> b) where
toSym :: (a --> b) -> a --> b
toSym = (a --> b) -> a --> b
forall a. a -> a
id
#define TO_SYM_SYMID_SIMPLE(symtype) \
instance ToSym symtype symtype where \
toSym = id
#define TO_SYM_SYMID_BV(symtype) \
instance (KnownNat n, 1 <= n) => ToSym (symtype n) (symtype n) where \
toSym = id
#define TO_SYM_SYMID_FUN(cop, op) \
instance (SupportedPrim (cop ca cb), LinkedRep ca sa, LinkedRep cb sb) => \
ToSym (op sa sb) (op sa sb) where \
toSym = id
#if 1
TO_SYM_SYMID_SIMPLE(SymBool)
TO_SYM_SYMID_SIMPLE(SymInteger)
TO_SYM_SYMID_SIMPLE(SymAlgReal)
TO_SYM_SYMID_BV(SymIntN)
TO_SYM_SYMID_BV(SymWordN)
TO_SYM_SYMID_FUN((=->), (=~>))
TO_SYM_SYMID_FUN((-->), (-~>))
TO_SYM_SYMID_SIMPLE(SymFPRoundingMode)
#endif
instance (ValidFP eb sb) => ToSym (SymFP eb sb) (SymFP eb sb) where
toSym :: SymFP eb sb -> SymFP eb sb
toSym = SymFP eb sb -> SymFP eb sb
forall a. a -> a
id
#define TO_SYM_FROMCON_SIMPLE(contype, symtype) \
instance ToSym contype symtype where \
toSym = con
#define TO_SYM_FROMCON_BV(contype, symtype) \
instance (KnownNat n, 1 <= n) => ToSym (contype n) (symtype n) where \
toSym = con
#define TO_SYM_FROMCON_FUN(conop, symop) \
instance (SupportedPrim (conop ca cb), SupportedNonFuncPrim ca, LinkedRep ca sa, LinkedRep cb sb) => \
ToSym (conop ca cb) (symop sa sb) where \
toSym = con
#if 1
TO_SYM_FROMCON_SIMPLE(Bool, SymBool)
TO_SYM_FROMCON_SIMPLE(Integer, SymInteger)
TO_SYM_FROMCON_SIMPLE(AlgReal, SymAlgReal)
TO_SYM_FROMCON_BV(IntN, SymIntN)
TO_SYM_FROMCON_BV(WordN, SymWordN)
TO_SYM_FROMCON_FUN((=->), (=~>))
TO_SYM_FROMCON_FUN((-->), (-~>))
TO_SYM_FROMCON_SIMPLE(FPRoundingMode, SymFPRoundingMode)
#endif
instance (ValidFP eb sb) => ToSym (FP eb sb) (SymFP eb sb) where
toSym :: FP eb sb -> SymFP eb sb
toSym = FP eb sb -> SymFP eb sb
forall c t. Solvable c t => c -> t
con
#define TOSYM_MACHINE_INTEGER(int, bv) \
instance ToSym int (bv) where \
toSym = fromIntegral
#if 1
TOSYM_MACHINE_INTEGER(Int8, SymIntN 8)
TOSYM_MACHINE_INTEGER(Int16, SymIntN 16)
TOSYM_MACHINE_INTEGER(Int32, SymIntN 32)
TOSYM_MACHINE_INTEGER(Int64, SymIntN 64)
TOSYM_MACHINE_INTEGER(Word8, SymWordN 8)
TOSYM_MACHINE_INTEGER(Word16, SymWordN 16)
TOSYM_MACHINE_INTEGER(Word32, SymWordN 32)
TOSYM_MACHINE_INTEGER(Word64, SymWordN 64)
TOSYM_MACHINE_INTEGER(Int, SymIntN $intBitwidthQ)
TOSYM_MACHINE_INTEGER(Word, SymWordN $intBitwidthQ)
#endif
instance ToSym Float SymFP32 where
toSym :: Float -> SymFP32
toSym = FP 8 24 -> SymFP32
forall c t. Solvable c t => c -> t
con (FP 8 24 -> SymFP32) -> (Float -> FP 8 24) -> Float -> SymFP32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FP 8 24
forall from to. BitCast from to => from -> to
bitCast
{-# INLINE toSym #-}
instance ToSym Double SymFP64 where
toSym :: Double -> SymFP64
toSym = FP 11 53 -> SymFP64
forall c t. Solvable c t => c -> t
con (FP 11 53 -> SymFP64) -> (Double -> FP 11 53) -> Double -> SymFP64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FP 11 53
forall from to. BitCast from to => from -> to
bitCast
{-# INLINE toSym #-}
instance
(Integral b, Typeable b, Show b, ToSym a b) =>
ToSym (Ratio a) (Ratio b)
where
toSym :: Ratio a -> Ratio b
toSym Ratio a
r = a -> b
forall a b. ToSym a b => a -> b
toSym (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) b -> b -> Ratio b
forall a. Integral a => a -> a -> Ratio a
% a -> b
forall a b. ToSym a b => a -> b
toSym (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)
{-# INLINE toSym #-}
instance ToSym Rational SymAlgReal where
toSym :: Rational -> SymAlgReal
toSym Rational
v = AlgReal -> SymAlgReal
forall c t. Solvable c t => c -> t
con (Rational -> AlgReal
forall a. Fractional a => Rational -> a
fromRational Rational
v)
instance (ToSym b d, ToSym c a) => ToSym (a -> b) (c -> d) where
toSym :: (a -> b) -> c -> d
toSym = (a -> b) -> c -> d
forall (f1 :: * -> *) (f2 :: * -> *) a b.
(ToSym1 f1 f2, ToSym a b) =>
f1 a -> f2 b
toSym1
{-# INLINE toSym #-}
instance (ToSym c a) => ToSym1 ((->) a) ((->) c) where
liftToSym :: forall a b. (a -> b) -> (a -> a) -> c -> b
liftToSym a -> b
l a -> a
f = a -> b
l (a -> b) -> (c -> a) -> c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> a) -> (c -> a) -> c -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
forall a b. ToSym a b => a -> b
toSym
{-# INLINE liftToSym #-}