{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Grisette.Internal.Internal.Decl.Core.Data.Class.ExtractSym
(
ExtractSym (..),
ExtractSym1 (..),
extractSymMaybe1,
extractSym1,
ExtractSym2 (..),
extractSymMaybe2,
extractSym2,
ExtractSymArgs (..),
GExtractSym (..),
genericExtractSymMaybe,
genericLiftExtractSymMaybe,
)
where
import Data.Kind (Type)
import Data.Maybe (fromJust)
import Generics.Deriving
( Default (unDefault),
Default1 (unDefault1),
Generic (Rep, from),
Generic1 (Rep1, from1),
K1 (K1),
M1 (M1),
Par1 (Par1),
Rec1 (Rec1),
U1,
V1,
type (:*:) ((:*:)),
type (:+:) (L1, R1),
type (:.:) (Comp1),
)
import Grisette.Internal.SymPrim.Prim.Model
( AnySymbolSet,
SymbolSet,
)
import Grisette.Internal.SymPrim.Prim.Term (IsSymbolKind, SymbolKind)
import Grisette.Internal.Utils.Derive (Arity0, Arity1)
class a where
:: a -> AnySymbolSet
extractSym = Maybe AnySymbolSet -> AnySymbolSet
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AnySymbolSet -> AnySymbolSet)
-> (a -> Maybe AnySymbolSet) -> a -> AnySymbolSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe AnySymbolSet
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
a -> Maybe (SymbolSet knd)
extractSymMaybe
{-# INLINE extractSym #-}
:: (IsSymbolKind knd) => a -> Maybe (SymbolSet knd)
class
(forall a. (ExtractSym a) => ExtractSym (f a)) =>
f
where
::
(IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) ->
f a ->
Maybe (SymbolSet knd)
extractSym1 ::
(ExtractSym1 f, ExtractSym a, IsSymbolKind knd) =>
f a ->
SymbolSet knd
= Maybe (SymbolSet knd) -> SymbolSet knd
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (SymbolSet knd) -> SymbolSet knd)
-> (f a -> Maybe (SymbolSet knd)) -> f a -> SymbolSet knd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
forall (f :: * -> *) (knd :: SymbolKind) a.
(ExtractSym1 f, IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
liftExtractSymMaybe a -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
a -> Maybe (SymbolSet knd)
extractSymMaybe
{-# INLINE extractSym1 #-}
extractSymMaybe1 ::
(ExtractSym1 f, ExtractSym a, IsSymbolKind knd) =>
f a ->
Maybe (SymbolSet knd)
= (a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
forall (f :: * -> *) (knd :: SymbolKind) a.
(ExtractSym1 f, IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
liftExtractSymMaybe a -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
a -> Maybe (SymbolSet knd)
extractSymMaybe
{-# INLINE extractSymMaybe1 #-}
class
(forall a. (ExtractSym a) => ExtractSym1 (f a)) =>
f
where
::
(IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) ->
(b -> Maybe (SymbolSet knd)) ->
f a b ->
Maybe (SymbolSet knd)
extractSym2 ::
(ExtractSym2 f, ExtractSym a, ExtractSym b, IsSymbolKind knd) =>
f a b ->
SymbolSet knd
= Maybe (SymbolSet knd) -> SymbolSet knd
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (SymbolSet knd) -> SymbolSet knd)
-> (f a b -> Maybe (SymbolSet knd)) -> f a b -> SymbolSet knd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (SymbolSet knd))
-> (b -> Maybe (SymbolSet knd)) -> f a b -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a b.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd))
-> (b -> Maybe (SymbolSet knd)) -> f a b -> Maybe (SymbolSet knd)
forall (f :: * -> * -> *) (knd :: SymbolKind) a b.
(ExtractSym2 f, IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd))
-> (b -> Maybe (SymbolSet knd)) -> f a b -> Maybe (SymbolSet knd)
liftExtractSymMaybe2 a -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
a -> Maybe (SymbolSet knd)
extractSymMaybe b -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
b -> Maybe (SymbolSet knd)
extractSymMaybe
extractSymMaybe2 ::
(ExtractSym2 f, ExtractSym a, ExtractSym b, IsSymbolKind knd) =>
f a b ->
Maybe (SymbolSet knd)
= (a -> Maybe (SymbolSet knd))
-> (b -> Maybe (SymbolSet knd)) -> f a b -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a b.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd))
-> (b -> Maybe (SymbolSet knd)) -> f a b -> Maybe (SymbolSet knd)
forall (f :: * -> * -> *) (knd :: SymbolKind) a b.
(ExtractSym2 f, IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd))
-> (b -> Maybe (SymbolSet knd)) -> f a b -> Maybe (SymbolSet knd)
liftExtractSymMaybe2 a -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
a -> Maybe (SymbolSet knd)
extractSymMaybe b -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
b -> Maybe (SymbolSet knd)
extractSymMaybe
{-# INLINE extractSymMaybe2 #-}
data family arity (knd :: SymbolKind) a :: Type
data instance Arity0 _ _ =
newtype instance Arity1 knd a
= (a -> Maybe (SymbolSet knd))
class arity f where
::
(IsSymbolKind knd) =>
ExtractSymArgs arity knd a ->
f a ->
Maybe (SymbolSet knd)
instance GExtractSym arity V1 where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> V1 a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
_ V1 a
_ = SymbolSet knd -> Maybe (SymbolSet knd)
forall a. a -> Maybe a
Just SymbolSet knd
forall a. Monoid a => a
mempty
{-# INLINE gextractSymMaybe #-}
instance GExtractSym arity U1 where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> U1 a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
_ U1 a
_ = SymbolSet knd -> Maybe (SymbolSet knd)
forall a. a -> Maybe a
Just SymbolSet knd
forall a. Monoid a => a
mempty
{-# INLINE gextractSymMaybe #-}
instance (GExtractSym arity a) => GExtractSym arity (M1 i c a) where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> M1 i c a a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args (M1 a a
x) = ExtractSymArgs arity knd a -> a a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> a a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args a a
x
{-# INLINE gextractSymMaybe #-}
instance (ExtractSym a) => GExtractSym arity (K1 i a) where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> K1 i a a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
_ (K1 a
x) = a -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(ExtractSym a, IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind).
IsSymbolKind knd =>
a -> Maybe (SymbolSet knd)
extractSymMaybe a
x
{-# INLINE gextractSymMaybe #-}
instance
(GExtractSym arity a, GExtractSym arity b) =>
GExtractSym arity (a :+: b)
where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> (:+:) a b a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args (L1 a a
x) = ExtractSymArgs arity knd a -> a a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> a a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args a a
x
gextractSymMaybe ExtractSymArgs arity knd a
args (R1 b a
x) = ExtractSymArgs arity knd a -> b a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> b a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args b a
x
{-# INLINE gextractSymMaybe #-}
instance
(GExtractSym arity a, GExtractSym arity b) =>
GExtractSym arity (a :*: b)
where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> (:*:) a b a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args (a a
x :*: b a
y) =
ExtractSymArgs arity knd a -> a a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> a a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args a a
x Maybe (SymbolSet knd)
-> Maybe (SymbolSet knd) -> Maybe (SymbolSet knd)
forall a. Semigroup a => a -> a -> a
<> ExtractSymArgs arity knd a -> b a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs arity knd a -> b a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs arity knd a
args b a
y
{-# INLINE gextractSymMaybe #-}
instance GExtractSym Arity1 Par1 where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs Arity1 knd a -> Par1 a -> Maybe (SymbolSet knd)
gextractSymMaybe (ExtractSymArgs1 a -> Maybe (SymbolSet knd)
f) (Par1 a
x) = a -> Maybe (SymbolSet knd)
f a
x
{-# INLINE gextractSymMaybe #-}
instance (ExtractSym1 a) => GExtractSym Arity1 (Rec1 a) where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs Arity1 knd a -> Rec1 a a -> Maybe (SymbolSet knd)
gextractSymMaybe (ExtractSymArgs1 a -> Maybe (SymbolSet knd)
f) (Rec1 a a
x) =
(a -> Maybe (SymbolSet knd)) -> a a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd)) -> a a -> Maybe (SymbolSet knd)
forall (f :: * -> *) (knd :: SymbolKind) a.
(ExtractSym1 f, IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
liftExtractSymMaybe a -> Maybe (SymbolSet knd)
f a a
x
{-# INLINE gextractSymMaybe #-}
instance
(ExtractSym1 f, GExtractSym Arity1 g) =>
GExtractSym Arity1 (f :.: g)
where
gextractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs Arity1 knd a -> (:.:) f g a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs Arity1 knd a
targs (Comp1 f (g a)
x) =
(g a -> Maybe (SymbolSet knd)) -> f (g a) -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
forall (f :: * -> *) (knd :: SymbolKind) a.
(ExtractSym1 f, IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
liftExtractSymMaybe (ExtractSymArgs Arity1 knd a -> g a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs Arity1 knd a -> g a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs Arity1 knd a
targs) f (g a)
x
{-# INLINE gextractSymMaybe #-}
genericExtractSymMaybe ::
(Generic a, GExtractSym Arity0 (Rep a), IsSymbolKind knd) =>
a ->
Maybe (SymbolSet knd)
= ExtractSymArgs Arity0 knd Any -> Rep a Any -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs Arity0 knd a -> Rep a a -> Maybe (SymbolSet knd)
gextractSymMaybe ExtractSymArgs Arity0 knd Any
forall (_ :: SymbolKind) _. ExtractSymArgs Arity0 _ _
ExtractSymArgs0 (Rep a Any -> Maybe (SymbolSet knd))
-> (a -> Rep a Any) -> a -> Maybe (SymbolSet knd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
genericLiftExtractSymMaybe ::
(Generic1 f, GExtractSym Arity1 (Rep1 f), IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) ->
f a ->
Maybe (SymbolSet knd)
a -> Maybe (SymbolSet knd)
f =
ExtractSymArgs Arity1 knd a -> Rep1 f a -> Maybe (SymbolSet knd)
forall arity (f :: * -> *) (knd :: SymbolKind) a.
(GExtractSym arity f, IsSymbolKind knd) =>
ExtractSymArgs arity knd a -> f a -> Maybe (SymbolSet knd)
forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
ExtractSymArgs Arity1 knd a -> Rep1 f a -> Maybe (SymbolSet knd)
gextractSymMaybe ((a -> Maybe (SymbolSet knd)) -> ExtractSymArgs Arity1 knd a
forall (knd :: SymbolKind) a.
(a -> Maybe (SymbolSet knd)) -> ExtractSymArgs Arity1 knd a
ExtractSymArgs1 a -> Maybe (SymbolSet knd)
f) (Rep1 f a -> Maybe (SymbolSet knd))
-> (f a -> Rep1 f a) -> f a -> Maybe (SymbolSet knd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
instance
(Generic a, GExtractSym Arity0 (Rep a)) =>
ExtractSym (Default a)
where
extractSymMaybe :: forall (knd :: SymbolKind).
IsSymbolKind knd =>
Default a -> Maybe (SymbolSet knd)
extractSymMaybe = a -> Maybe (SymbolSet knd)
forall a (knd :: SymbolKind).
(Generic a, GExtractSym Arity0 (Rep a), IsSymbolKind knd) =>
a -> Maybe (SymbolSet knd)
genericExtractSymMaybe (a -> Maybe (SymbolSet knd))
-> (Default a -> a) -> Default a -> Maybe (SymbolSet knd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Default a -> a
forall a. Default a -> a
unDefault
{-# INLINE extractSymMaybe #-}
instance
(Generic1 f, GExtractSym Arity1 (Rep1 f), ExtractSym a) =>
ExtractSym (Default1 f a)
where
extractSymMaybe :: forall (knd :: SymbolKind).
IsSymbolKind knd =>
Default1 f a -> Maybe (SymbolSet knd)
extractSymMaybe = Default1 f a -> Maybe (SymbolSet knd)
forall (f :: * -> *) a (knd :: SymbolKind).
(ExtractSym1 f, ExtractSym a, IsSymbolKind knd) =>
f a -> Maybe (SymbolSet knd)
extractSymMaybe1
{-# INLINE extractSymMaybe #-}
instance
(Generic1 f, GExtractSym Arity1 (Rep1 f)) =>
ExtractSym1 (Default1 f)
where
liftExtractSymMaybe :: forall (knd :: SymbolKind) a.
IsSymbolKind knd =>
(a -> Maybe (SymbolSet knd))
-> Default1 f a -> Maybe (SymbolSet knd)
liftExtractSymMaybe a -> Maybe (SymbolSet knd)
f = (a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
forall (f :: * -> *) (knd :: SymbolKind) a.
(Generic1 f, GExtractSym Arity1 (Rep1 f), IsSymbolKind knd) =>
(a -> Maybe (SymbolSet knd)) -> f a -> Maybe (SymbolSet knd)
genericLiftExtractSymMaybe a -> Maybe (SymbolSet knd)
f (f a -> Maybe (SymbolSet knd))
-> (Default1 f a -> f a) -> Default1 f a -> Maybe (SymbolSet knd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Default1 f a -> f a
forall (f :: * -> *) a. Default1 f a -> f a
unDefault1
{-# INLINE liftExtractSymMaybe #-}