{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Grisette.IR.SymPrim.Data.Prim.ModelValue
( ModelValue (..),
toModelValue,
unsafeFromModelValue,
)
where
import Data.Hashable
import Type.Reflection
data ModelValue where
ModelValue :: forall v. (Show v, Eq v, Hashable v) => TypeRep v -> v -> ModelValue
instance Show ModelValue where
show :: ModelValue -> String
show (ModelValue TypeRep v
t v
v) = forall a. Show a => a -> String
show v
v forall a. [a] -> [a] -> [a]
++ String
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep v
t
instance Eq ModelValue where
(ModelValue TypeRep v
t1 v
v1) == :: ModelValue -> ModelValue -> Bool
== (ModelValue TypeRep v
t2 v
v2) =
case forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep v
t1 TypeRep v
t2 of
Just v :~~: v
HRefl -> v
v1 forall a. Eq a => a -> a -> Bool
== v
v2
Maybe (v :~~: v)
_ -> Bool
False
instance Hashable ModelValue where
Int
s hashWithSalt :: Int -> ModelValue -> Int
`hashWithSalt` (ModelValue TypeRep v
t v
v) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` TypeRep v
t forall a. Hashable a => Int -> a -> Int
`hashWithSalt` v
v
unsafeFromModelValue :: forall a. (Typeable a) => ModelValue -> a
unsafeFromModelValue :: forall a. Typeable a => ModelValue -> a
unsafeFromModelValue (ModelValue TypeRep v
t v
v) = case forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep v
t (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) of
Just v :~~: a
HRefl -> v
v
Maybe (v :~~: a)
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Bad model value type, expected type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) forall a. [a] -> [a] -> [a]
++ String
", but got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep v
t
toModelValue :: forall a. (Show a, Eq a, Hashable a, Typeable a) => a -> ModelValue
toModelValue :: forall a. (Show a, Eq a, Hashable a, Typeable a) => a -> ModelValue
toModelValue = forall v.
(Show v, Eq v, Hashable v) =>
TypeRep v -> v -> ModelValue
ModelValue (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)