module Application.TermSearch.Type
  ( TypeSkeleton(..)
  , Benchmark(..)
  , Argument
  , Mode(..)
  , AblationType(..)
  ) where

import           Data.Data                      ( Data )
import           Data.Hashable                  ( Hashable )
import           Data.Text                      ( Text )
import           GHC.Generics                   ( Generic )

import           Data.ECTA
import           Data.ECTA.Term

data TypeSkeleton
  = TVar Text
  | TFun TypeSkeleton TypeSkeleton
  | TCons Text [TypeSkeleton]
  deriving (TypeSkeleton -> TypeSkeleton -> Bool
(TypeSkeleton -> TypeSkeleton -> Bool)
-> (TypeSkeleton -> TypeSkeleton -> Bool) -> Eq TypeSkeleton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSkeleton -> TypeSkeleton -> Bool
$c/= :: TypeSkeleton -> TypeSkeleton -> Bool
== :: TypeSkeleton -> TypeSkeleton -> Bool
$c== :: TypeSkeleton -> TypeSkeleton -> Bool
Eq, Eq TypeSkeleton
Eq TypeSkeleton
-> (TypeSkeleton -> TypeSkeleton -> Ordering)
-> (TypeSkeleton -> TypeSkeleton -> Bool)
-> (TypeSkeleton -> TypeSkeleton -> Bool)
-> (TypeSkeleton -> TypeSkeleton -> Bool)
-> (TypeSkeleton -> TypeSkeleton -> Bool)
-> (TypeSkeleton -> TypeSkeleton -> TypeSkeleton)
-> (TypeSkeleton -> TypeSkeleton -> TypeSkeleton)
-> Ord TypeSkeleton
TypeSkeleton -> TypeSkeleton -> Bool
TypeSkeleton -> TypeSkeleton -> Ordering
TypeSkeleton -> TypeSkeleton -> TypeSkeleton
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeSkeleton -> TypeSkeleton -> TypeSkeleton
$cmin :: TypeSkeleton -> TypeSkeleton -> TypeSkeleton
max :: TypeSkeleton -> TypeSkeleton -> TypeSkeleton
$cmax :: TypeSkeleton -> TypeSkeleton -> TypeSkeleton
>= :: TypeSkeleton -> TypeSkeleton -> Bool
$c>= :: TypeSkeleton -> TypeSkeleton -> Bool
> :: TypeSkeleton -> TypeSkeleton -> Bool
$c> :: TypeSkeleton -> TypeSkeleton -> Bool
<= :: TypeSkeleton -> TypeSkeleton -> Bool
$c<= :: TypeSkeleton -> TypeSkeleton -> Bool
< :: TypeSkeleton -> TypeSkeleton -> Bool
$c< :: TypeSkeleton -> TypeSkeleton -> Bool
compare :: TypeSkeleton -> TypeSkeleton -> Ordering
$ccompare :: TypeSkeleton -> TypeSkeleton -> Ordering
$cp1Ord :: Eq TypeSkeleton
Ord, Int -> TypeSkeleton -> ShowS
[TypeSkeleton] -> ShowS
TypeSkeleton -> String
(Int -> TypeSkeleton -> ShowS)
-> (TypeSkeleton -> String)
-> ([TypeSkeleton] -> ShowS)
-> Show TypeSkeleton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSkeleton] -> ShowS
$cshowList :: [TypeSkeleton] -> ShowS
show :: TypeSkeleton -> String
$cshow :: TypeSkeleton -> String
showsPrec :: Int -> TypeSkeleton -> ShowS
$cshowsPrec :: Int -> TypeSkeleton -> ShowS
Show, ReadPrec [TypeSkeleton]
ReadPrec TypeSkeleton
Int -> ReadS TypeSkeleton
ReadS [TypeSkeleton]
(Int -> ReadS TypeSkeleton)
-> ReadS [TypeSkeleton]
-> ReadPrec TypeSkeleton
-> ReadPrec [TypeSkeleton]
-> Read TypeSkeleton
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeSkeleton]
$creadListPrec :: ReadPrec [TypeSkeleton]
readPrec :: ReadPrec TypeSkeleton
$creadPrec :: ReadPrec TypeSkeleton
readList :: ReadS [TypeSkeleton]
$creadList :: ReadS [TypeSkeleton]
readsPrec :: Int -> ReadS TypeSkeleton
$creadsPrec :: Int -> ReadS TypeSkeleton
Read, Typeable TypeSkeleton
DataType
Constr
Typeable TypeSkeleton
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TypeSkeleton -> c TypeSkeleton)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypeSkeleton)
-> (TypeSkeleton -> Constr)
-> (TypeSkeleton -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TypeSkeleton))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TypeSkeleton))
-> ((forall b. Data b => b -> b) -> TypeSkeleton -> TypeSkeleton)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r)
-> (forall u. (forall d. Data d => d -> u) -> TypeSkeleton -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypeSkeleton -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton)
-> Data TypeSkeleton
TypeSkeleton -> DataType
TypeSkeleton -> Constr
(forall b. Data b => b -> b) -> TypeSkeleton -> TypeSkeleton
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSkeleton -> c TypeSkeleton
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSkeleton
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TypeSkeleton -> u
forall u. (forall d. Data d => d -> u) -> TypeSkeleton -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSkeleton
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSkeleton -> c TypeSkeleton
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSkeleton)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSkeleton)
$cTCons :: Constr
$cTFun :: Constr
$cTVar :: Constr
$tTypeSkeleton :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
gmapMp :: (forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
gmapM :: (forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSkeleton -> m TypeSkeleton
gmapQi :: Int -> (forall d. Data d => d -> u) -> TypeSkeleton -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSkeleton -> u
gmapQ :: (forall d. Data d => d -> u) -> TypeSkeleton -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSkeleton -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSkeleton -> r
gmapT :: (forall b. Data b => b -> b) -> TypeSkeleton -> TypeSkeleton
$cgmapT :: (forall b. Data b => b -> b) -> TypeSkeleton -> TypeSkeleton
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSkeleton)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeSkeleton)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TypeSkeleton)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSkeleton)
dataTypeOf :: TypeSkeleton -> DataType
$cdataTypeOf :: TypeSkeleton -> DataType
toConstr :: TypeSkeleton -> Constr
$ctoConstr :: TypeSkeleton -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSkeleton
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSkeleton
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSkeleton -> c TypeSkeleton
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSkeleton -> c TypeSkeleton
$cp1Data :: Typeable TypeSkeleton
Data, (forall x. TypeSkeleton -> Rep TypeSkeleton x)
-> (forall x. Rep TypeSkeleton x -> TypeSkeleton)
-> Generic TypeSkeleton
forall x. Rep TypeSkeleton x -> TypeSkeleton
forall x. TypeSkeleton -> Rep TypeSkeleton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeSkeleton x -> TypeSkeleton
$cfrom :: forall x. TypeSkeleton -> Rep TypeSkeleton x
Generic)

instance Hashable TypeSkeleton

data Benchmark = Benchmark { Benchmark -> Text
bmName      :: Text
                           , Benchmark -> Int
bmSize      :: Int
                           , Benchmark -> Term
bmSolution  :: Term
                           , Benchmark -> [(Text, TypeSkeleton)]
bmArguments :: [(Text, TypeSkeleton)]
                           , Benchmark -> TypeSkeleton
bmGoalType  :: TypeSkeleton
                           }
  deriving (Benchmark -> Benchmark -> Bool
(Benchmark -> Benchmark -> Bool)
-> (Benchmark -> Benchmark -> Bool) -> Eq Benchmark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Benchmark -> Benchmark -> Bool
$c/= :: Benchmark -> Benchmark -> Bool
== :: Benchmark -> Benchmark -> Bool
$c== :: Benchmark -> Benchmark -> Bool
Eq, Eq Benchmark
Eq Benchmark
-> (Benchmark -> Benchmark -> Ordering)
-> (Benchmark -> Benchmark -> Bool)
-> (Benchmark -> Benchmark -> Bool)
-> (Benchmark -> Benchmark -> Bool)
-> (Benchmark -> Benchmark -> Bool)
-> (Benchmark -> Benchmark -> Benchmark)
-> (Benchmark -> Benchmark -> Benchmark)
-> Ord Benchmark
Benchmark -> Benchmark -> Bool
Benchmark -> Benchmark -> Ordering
Benchmark -> Benchmark -> Benchmark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Benchmark -> Benchmark -> Benchmark
$cmin :: Benchmark -> Benchmark -> Benchmark
max :: Benchmark -> Benchmark -> Benchmark
$cmax :: Benchmark -> Benchmark -> Benchmark
>= :: Benchmark -> Benchmark -> Bool
$c>= :: Benchmark -> Benchmark -> Bool
> :: Benchmark -> Benchmark -> Bool
$c> :: Benchmark -> Benchmark -> Bool
<= :: Benchmark -> Benchmark -> Bool
$c<= :: Benchmark -> Benchmark -> Bool
< :: Benchmark -> Benchmark -> Bool
$c< :: Benchmark -> Benchmark -> Bool
compare :: Benchmark -> Benchmark -> Ordering
$ccompare :: Benchmark -> Benchmark -> Ordering
$cp1Ord :: Eq Benchmark
Ord, Int -> Benchmark -> ShowS
[Benchmark] -> ShowS
Benchmark -> String
(Int -> Benchmark -> ShowS)
-> (Benchmark -> String)
-> ([Benchmark] -> ShowS)
-> Show Benchmark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Benchmark] -> ShowS
$cshowList :: [Benchmark] -> ShowS
show :: Benchmark -> String
$cshow :: Benchmark -> String
showsPrec :: Int -> Benchmark -> ShowS
$cshowsPrec :: Int -> Benchmark -> ShowS
Show, ReadPrec [Benchmark]
ReadPrec Benchmark
Int -> ReadS Benchmark
ReadS [Benchmark]
(Int -> ReadS Benchmark)
-> ReadS [Benchmark]
-> ReadPrec Benchmark
-> ReadPrec [Benchmark]
-> Read Benchmark
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Benchmark]
$creadListPrec :: ReadPrec [Benchmark]
readPrec :: ReadPrec Benchmark
$creadPrec :: ReadPrec Benchmark
readList :: ReadS [Benchmark]
$creadList :: ReadS [Benchmark]
readsPrec :: Int -> ReadS Benchmark
$creadsPrec :: Int -> ReadS Benchmark
Read)

type Argument = (Symbol, Node)

data Mode
  = Normal
  | HKTV
  | Lambda
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Typeable Mode
DataType
Constr
Typeable Mode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Mode -> c Mode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Mode)
-> (Mode -> Constr)
-> (Mode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Mode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode))
-> ((forall b. Data b => b -> b) -> Mode -> Mode)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r)
-> (forall u. (forall d. Data d => d -> u) -> Mode -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> Data Mode
Mode -> DataType
Mode -> Constr
(forall b. Data b => b -> b) -> Mode -> Mode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
forall u. (forall d. Data d => d -> u) -> Mode -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cLambda :: Constr
$cHKTV :: Constr
$cNormal :: Constr
$tMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapMp :: (forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapM :: (forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapQi :: Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQ :: (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
$cgmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Mode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
dataTypeOf :: Mode -> DataType
$cdataTypeOf :: Mode -> DataType
toConstr :: Mode -> Constr
$ctoConstr :: Mode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cp1Data :: Typeable Mode
Data, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mode x -> Mode
$cfrom :: forall x. Mode -> Rep Mode x
Generic)

data AblationType
  = Default
  | NoReduction
  | NoEnumeration
  | NoOptimize
  deriving (AblationType -> AblationType -> Bool
(AblationType -> AblationType -> Bool)
-> (AblationType -> AblationType -> Bool) -> Eq AblationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AblationType -> AblationType -> Bool
$c/= :: AblationType -> AblationType -> Bool
== :: AblationType -> AblationType -> Bool
$c== :: AblationType -> AblationType -> Bool
Eq, Eq AblationType
Eq AblationType
-> (AblationType -> AblationType -> Ordering)
-> (AblationType -> AblationType -> Bool)
-> (AblationType -> AblationType -> Bool)
-> (AblationType -> AblationType -> Bool)
-> (AblationType -> AblationType -> Bool)
-> (AblationType -> AblationType -> AblationType)
-> (AblationType -> AblationType -> AblationType)
-> Ord AblationType
AblationType -> AblationType -> Bool
AblationType -> AblationType -> Ordering
AblationType -> AblationType -> AblationType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AblationType -> AblationType -> AblationType
$cmin :: AblationType -> AblationType -> AblationType
max :: AblationType -> AblationType -> AblationType
$cmax :: AblationType -> AblationType -> AblationType
>= :: AblationType -> AblationType -> Bool
$c>= :: AblationType -> AblationType -> Bool
> :: AblationType -> AblationType -> Bool
$c> :: AblationType -> AblationType -> Bool
<= :: AblationType -> AblationType -> Bool
$c<= :: AblationType -> AblationType -> Bool
< :: AblationType -> AblationType -> Bool
$c< :: AblationType -> AblationType -> Bool
compare :: AblationType -> AblationType -> Ordering
$ccompare :: AblationType -> AblationType -> Ordering
$cp1Ord :: Eq AblationType
Ord, Int -> AblationType -> ShowS
[AblationType] -> ShowS
AblationType -> String
(Int -> AblationType -> ShowS)
-> (AblationType -> String)
-> ([AblationType] -> ShowS)
-> Show AblationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AblationType] -> ShowS
$cshowList :: [AblationType] -> ShowS
show :: AblationType -> String
$cshow :: AblationType -> String
showsPrec :: Int -> AblationType -> ShowS
$cshowsPrec :: Int -> AblationType -> ShowS
Show, Typeable AblationType
DataType
Constr
Typeable AblationType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AblationType -> c AblationType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AblationType)
-> (AblationType -> Constr)
-> (AblationType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AblationType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AblationType))
-> ((forall b. Data b => b -> b) -> AblationType -> AblationType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AblationType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AblationType -> r)
-> (forall u. (forall d. Data d => d -> u) -> AblationType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AblationType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AblationType -> m AblationType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AblationType -> m AblationType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AblationType -> m AblationType)
-> Data AblationType
AblationType -> DataType
AblationType -> Constr
(forall b. Data b => b -> b) -> AblationType -> AblationType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AblationType -> c AblationType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AblationType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AblationType -> u
forall u. (forall d. Data d => d -> u) -> AblationType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AblationType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AblationType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AblationType -> m AblationType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AblationType -> m AblationType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AblationType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AblationType -> c AblationType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AblationType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AblationType)
$cNoOptimize :: Constr
$cNoEnumeration :: Constr
$cNoReduction :: Constr
$cDefault :: Constr
$tAblationType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AblationType -> m AblationType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AblationType -> m AblationType
gmapMp :: (forall d. Data d => d -> m d) -> AblationType -> m AblationType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AblationType -> m AblationType
gmapM :: (forall d. Data d => d -> m d) -> AblationType -> m AblationType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AblationType -> m AblationType
gmapQi :: Int -> (forall d. Data d => d -> u) -> AblationType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AblationType -> u
gmapQ :: (forall d. Data d => d -> u) -> AblationType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AblationType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AblationType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AblationType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AblationType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AblationType -> r
gmapT :: (forall b. Data b => b -> b) -> AblationType -> AblationType
$cgmapT :: (forall b. Data b => b -> b) -> AblationType -> AblationType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AblationType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AblationType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AblationType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AblationType)
dataTypeOf :: AblationType -> DataType
$cdataTypeOf :: AblationType -> DataType
toConstr :: AblationType -> Constr
$ctoConstr :: AblationType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AblationType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AblationType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AblationType -> c AblationType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AblationType -> c AblationType
$cp1Data :: Typeable AblationType
Data, (forall x. AblationType -> Rep AblationType x)
-> (forall x. Rep AblationType x -> AblationType)
-> Generic AblationType
forall x. Rep AblationType x -> AblationType
forall x. AblationType -> Rep AblationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AblationType x -> AblationType
$cfrom :: forall x. AblationType -> Rep AblationType x
Generic)