{- |
Module      :  Camfort.Specification.Stencils.Parser.Types
Description :  Defines the representation of stencil specifications resulting from parsing.
Copyright   :  (c) 2017, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish
License     :  Apache-2.0

Maintainer  :  dom.orchard@gmail.com
Stability   :  experimental
-}

{-# LANGUAGE DeriveDataTypeable #-}

module Camfort.Specification.Stencils.Parser.Types
  ( Specification(..)
  , Region(..)
  , SpecInner(..)
  , reqRegions
  ) where

import Data.Data (Data, Typeable)
import Data.List (nub, sort)

import           Camfort.Specification.Stencils.Model
  (Approximation(..), Multiplicity(..))
import qualified Camfort.Specification.Stencils.Syntax as Syn

data Specification
  = RegionDec String Region
  | SpecDec SpecInner [String]
  deriving (Int -> Specification -> ShowS
[Specification] -> ShowS
Specification -> String
(Int -> Specification -> ShowS)
-> (Specification -> String)
-> ([Specification] -> ShowS)
-> Show Specification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specification] -> ShowS
$cshowList :: [Specification] -> ShowS
show :: Specification -> String
$cshow :: Specification -> String
showsPrec :: Int -> Specification -> ShowS
$cshowsPrec :: Int -> Specification -> ShowS
Show, Specification -> Specification -> Bool
(Specification -> Specification -> Bool)
-> (Specification -> Specification -> Bool) -> Eq Specification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Specification -> Specification -> Bool
$c/= :: Specification -> Specification -> Bool
== :: Specification -> Specification -> Bool
$c== :: Specification -> Specification -> Bool
Eq, Typeable, Typeable Specification
DataType
Constr
Typeable Specification
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Specification -> c Specification)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Specification)
-> (Specification -> Constr)
-> (Specification -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Specification))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Specification))
-> ((forall b. Data b => b -> b) -> Specification -> Specification)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Specification -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Specification -> r)
-> (forall u. (forall d. Data d => d -> u) -> Specification -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Specification -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Specification -> m Specification)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Specification -> m Specification)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Specification -> m Specification)
-> Data Specification
Specification -> DataType
Specification -> Constr
(forall b. Data b => b -> b) -> Specification -> Specification
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specification -> c Specification
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specification
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) -> Specification -> u
forall u. (forall d. Data d => d -> u) -> Specification -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Specification -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Specification -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Specification -> m Specification
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Specification -> m Specification
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specification
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specification -> c Specification
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Specification)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Specification)
$cSpecDec :: Constr
$cRegionDec :: Constr
$tSpecification :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Specification -> m Specification
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Specification -> m Specification
gmapMp :: (forall d. Data d => d -> m d) -> Specification -> m Specification
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Specification -> m Specification
gmapM :: (forall d. Data d => d -> m d) -> Specification -> m Specification
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Specification -> m Specification
gmapQi :: Int -> (forall d. Data d => d -> u) -> Specification -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Specification -> u
gmapQ :: (forall d. Data d => d -> u) -> Specification -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Specification -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Specification -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Specification -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Specification -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Specification -> r
gmapT :: (forall b. Data b => b -> b) -> Specification -> Specification
$cgmapT :: (forall b. Data b => b -> b) -> Specification -> Specification
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Specification)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Specification)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Specification)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Specification)
dataTypeOf :: Specification -> DataType
$cdataTypeOf :: Specification -> DataType
toConstr :: Specification -> Constr
$ctoConstr :: Specification -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specification
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specification
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specification -> c Specification
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specification -> c Specification
$cp1Data :: Typeable Specification
Data)

-- | Regions that are referenced in a specification.
reqRegions :: Specification -> [Syn.Variable]
reqRegions :: Specification -> [String]
reqRegions Specification
spec = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
  case Specification
spec of
    RegionDec String
_ Region
r             -> Region -> [String]
reqRegions' Region
r
    SpecDec (SpecInner Multiplicity (Approximation Region)
x Bool
_) [String]
_ ->
      case Multiplicity (Approximation Region)
x of
        Once Approximation Region
a -> Approximation Region -> [String]
reqRegionsApprox Approximation Region
a
        Mult Approximation Region
a -> Approximation Region -> [String]
reqRegionsApprox Approximation Region
a
  where
    reqRegionsApprox :: Approximation Region -> [String]
reqRegionsApprox (Exact Region
r) = Region -> [String]
reqRegions' Region
r
    reqRegionsApprox (Bound Maybe Region
l Maybe Region
u) =
      let maybeReqRegions :: Maybe Region -> [String]
maybeReqRegions = [String] -> (Region -> [String]) -> Maybe Region -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Region -> [String]
reqRegions'
      in Maybe Region -> [String]
maybeReqRegions Maybe Region
l [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Maybe Region -> [String]
maybeReqRegions Maybe Region
u
    reqRegions' :: Region -> [Syn.Variable]
    reqRegions' :: Region -> [String]
reqRegions' RegionConst{} = []
    reqRegions' (Or Region
r1 Region
r2)    = Region -> [String]
reqRegions' Region
r1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Region -> [String]
reqRegions' Region
r2
    reqRegions' (And Region
r1 Region
r2)   = Region -> [String]
reqRegions' Region
r1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Region -> [String]
reqRegions' Region
r2
    reqRegions' (Var String
v)       = [String
v]

data Region
  = RegionConst Syn.Region
  | Or Region Region
  | And Region Region
  | Var String
  deriving (Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show, Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Eq Region
Eq Region
-> (Region -> Region -> Ordering)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Region)
-> (Region -> Region -> Region)
-> Ord Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
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 :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmax :: Region -> Region -> Region
>= :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c< :: Region -> Region -> Bool
compare :: Region -> Region -> Ordering
$ccompare :: Region -> Region -> Ordering
$cp1Ord :: Eq Region
Ord, Typeable, Typeable Region
DataType
Constr
Typeable Region
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Region -> c Region)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Region)
-> (Region -> Constr)
-> (Region -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Region))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region))
-> ((forall b. Data b => b -> b) -> Region -> Region)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Region -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Region -> r)
-> (forall u. (forall d. Data d => d -> u) -> Region -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Region -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Region -> m Region)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Region -> m Region)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Region -> m Region)
-> Data Region
Region -> DataType
Region -> Constr
(forall b. Data b => b -> b) -> Region -> Region
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
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) -> Region -> u
forall u. (forall d. Data d => d -> u) -> Region -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Region -> m Region
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Region)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region)
$cVar :: Constr
$cAnd :: Constr
$cOr :: Constr
$cRegionConst :: Constr
$tRegion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Region -> m Region
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
gmapMp :: (forall d. Data d => d -> m d) -> Region -> m Region
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
gmapM :: (forall d. Data d => d -> m d) -> Region -> m Region
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Region -> m Region
gmapQi :: Int -> (forall d. Data d => d -> u) -> Region -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Region -> u
gmapQ :: (forall d. Data d => d -> u) -> Region -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Region -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
gmapT :: (forall b. Data b => b -> b) -> Region -> Region
$cgmapT :: (forall b. Data b => b -> b) -> Region -> Region
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Region)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Region)
dataTypeOf :: Region -> DataType
$cdataTypeOf :: Region -> DataType
toConstr :: Region -> Constr
$ctoConstr :: Region -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
$cp1Data :: Typeable Region
Data)

data SpecInner = SpecInner
    (Multiplicity (Approximation Region))  -- main specification content
    Syn.IsStencil                          -- a bool: stencil or access
  deriving (Int -> SpecInner -> ShowS
[SpecInner] -> ShowS
SpecInner -> String
(Int -> SpecInner -> ShowS)
-> (SpecInner -> String)
-> ([SpecInner] -> ShowS)
-> Show SpecInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecInner] -> ShowS
$cshowList :: [SpecInner] -> ShowS
show :: SpecInner -> String
$cshow :: SpecInner -> String
showsPrec :: Int -> SpecInner -> ShowS
$cshowsPrec :: Int -> SpecInner -> ShowS
Show, SpecInner -> SpecInner -> Bool
(SpecInner -> SpecInner -> Bool)
-> (SpecInner -> SpecInner -> Bool) -> Eq SpecInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecInner -> SpecInner -> Bool
$c/= :: SpecInner -> SpecInner -> Bool
== :: SpecInner -> SpecInner -> Bool
$c== :: SpecInner -> SpecInner -> Bool
Eq, Typeable, Typeable SpecInner
DataType
Constr
Typeable SpecInner
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SpecInner -> c SpecInner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SpecInner)
-> (SpecInner -> Constr)
-> (SpecInner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SpecInner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpecInner))
-> ((forall b. Data b => b -> b) -> SpecInner -> SpecInner)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecInner -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecInner -> r)
-> (forall u. (forall d. Data d => d -> u) -> SpecInner -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SpecInner -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SpecInner -> m SpecInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SpecInner -> m SpecInner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SpecInner -> m SpecInner)
-> Data SpecInner
SpecInner -> DataType
SpecInner -> Constr
(forall b. Data b => b -> b) -> SpecInner -> SpecInner
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecInner -> c SpecInner
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecInner
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) -> SpecInner -> u
forall u. (forall d. Data d => d -> u) -> SpecInner -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecInner -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecInner -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecInner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecInner -> c SpecInner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecInner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpecInner)
$cSpecInner :: Constr
$tSpecInner :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
gmapMp :: (forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
gmapM :: (forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SpecInner -> m SpecInner
gmapQi :: Int -> (forall d. Data d => d -> u) -> SpecInner -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SpecInner -> u
gmapQ :: (forall d. Data d => d -> u) -> SpecInner -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SpecInner -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecInner -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecInner -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecInner -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecInner -> r
gmapT :: (forall b. Data b => b -> b) -> SpecInner -> SpecInner
$cgmapT :: (forall b. Data b => b -> b) -> SpecInner -> SpecInner
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpecInner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SpecInner)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SpecInner)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecInner)
dataTypeOf :: SpecInner -> DataType
$cdataTypeOf :: SpecInner -> DataType
toConstr :: SpecInner -> Constr
$ctoConstr :: SpecInner -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecInner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecInner
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecInner -> c SpecInner
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecInner -> c SpecInner
$cp1Data :: Typeable SpecInner
Data)