-- |
-- Module      :  Language.C.Syntax
-- Copyright   :  (c) 2006-2011 Harvard University
--                (c) 2011-2013 Geoffrey Mainland
--                (c) 2013 Manuel M T Chakravarty
--             :  (c) 2013-2016 Drexel University
-- License     :  BSD-style
-- Maintainer  :  mainland@drexel.edu

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}

module Language.C.Syntax where

import Data.Data (Data(..))
import Data.Loc
import Data.String (IsString(..))
import Data.Typeable (Typeable)

data Extensions = Antiquotation
                | C99
                | C11
                | Gcc
                | Blocks
                | ObjC
                | CUDA
                | OpenCL
  deriving (Extensions -> Extensions -> Bool
(Extensions -> Extensions -> Bool)
-> (Extensions -> Extensions -> Bool) -> Eq Extensions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Extensions -> Extensions -> Bool
== :: Extensions -> Extensions -> Bool
$c/= :: Extensions -> Extensions -> Bool
/= :: Extensions -> Extensions -> Bool
Eq, Eq Extensions
Eq Extensions =>
(Extensions -> Extensions -> Ordering)
-> (Extensions -> Extensions -> Bool)
-> (Extensions -> Extensions -> Bool)
-> (Extensions -> Extensions -> Bool)
-> (Extensions -> Extensions -> Bool)
-> (Extensions -> Extensions -> Extensions)
-> (Extensions -> Extensions -> Extensions)
-> Ord Extensions
Extensions -> Extensions -> Bool
Extensions -> Extensions -> Ordering
Extensions -> Extensions -> Extensions
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
$ccompare :: Extensions -> Extensions -> Ordering
compare :: Extensions -> Extensions -> Ordering
$c< :: Extensions -> Extensions -> Bool
< :: Extensions -> Extensions -> Bool
$c<= :: Extensions -> Extensions -> Bool
<= :: Extensions -> Extensions -> Bool
$c> :: Extensions -> Extensions -> Bool
> :: Extensions -> Extensions -> Bool
$c>= :: Extensions -> Extensions -> Bool
>= :: Extensions -> Extensions -> Bool
$cmax :: Extensions -> Extensions -> Extensions
max :: Extensions -> Extensions -> Extensions
$cmin :: Extensions -> Extensions -> Extensions
min :: Extensions -> Extensions -> Extensions
Ord, Int -> Extensions
Extensions -> Int
Extensions -> [Extensions]
Extensions -> Extensions
Extensions -> Extensions -> [Extensions]
Extensions -> Extensions -> Extensions -> [Extensions]
(Extensions -> Extensions)
-> (Extensions -> Extensions)
-> (Int -> Extensions)
-> (Extensions -> Int)
-> (Extensions -> [Extensions])
-> (Extensions -> Extensions -> [Extensions])
-> (Extensions -> Extensions -> [Extensions])
-> (Extensions -> Extensions -> Extensions -> [Extensions])
-> Enum Extensions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Extensions -> Extensions
succ :: Extensions -> Extensions
$cpred :: Extensions -> Extensions
pred :: Extensions -> Extensions
$ctoEnum :: Int -> Extensions
toEnum :: Int -> Extensions
$cfromEnum :: Extensions -> Int
fromEnum :: Extensions -> Int
$cenumFrom :: Extensions -> [Extensions]
enumFrom :: Extensions -> [Extensions]
$cenumFromThen :: Extensions -> Extensions -> [Extensions]
enumFromThen :: Extensions -> Extensions -> [Extensions]
$cenumFromTo :: Extensions -> Extensions -> [Extensions]
enumFromTo :: Extensions -> Extensions -> [Extensions]
$cenumFromThenTo :: Extensions -> Extensions -> Extensions -> [Extensions]
enumFromThenTo :: Extensions -> Extensions -> Extensions -> [Extensions]
Enum, Int -> Extensions -> ShowS
[Extensions] -> ShowS
Extensions -> String
(Int -> Extensions -> ShowS)
-> (Extensions -> String)
-> ([Extensions] -> ShowS)
-> Show Extensions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Extensions -> ShowS
showsPrec :: Int -> Extensions -> ShowS
$cshow :: Extensions -> String
show :: Extensions -> String
$cshowList :: [Extensions] -> ShowS
showList :: [Extensions] -> ShowS
Show)

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

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

type Linkage = StringLit

data Storage = Tauto                   !SrcLoc
             | Tregister               !SrcLoc
             | Tstatic                 !SrcLoc
             | Textern (Maybe Linkage) !SrcLoc
             | Ttypedef                !SrcLoc

             -- Clang blocks
             | T__block !SrcLoc

             -- Objective-C
             | TObjC__weak              !SrcLoc
             | TObjC__strong            !SrcLoc
             | TObjC__unsafe_unretained !SrcLoc
    deriving (Storage -> Storage -> Bool
(Storage -> Storage -> Bool)
-> (Storage -> Storage -> Bool) -> Eq Storage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Storage -> Storage -> Bool
== :: Storage -> Storage -> Bool
$c/= :: Storage -> Storage -> Bool
/= :: Storage -> Storage -> Bool
Eq, Eq Storage
Eq Storage =>
(Storage -> Storage -> Ordering)
-> (Storage -> Storage -> Bool)
-> (Storage -> Storage -> Bool)
-> (Storage -> Storage -> Bool)
-> (Storage -> Storage -> Bool)
-> (Storage -> Storage -> Storage)
-> (Storage -> Storage -> Storage)
-> Ord Storage
Storage -> Storage -> Bool
Storage -> Storage -> Ordering
Storage -> Storage -> Storage
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
$ccompare :: Storage -> Storage -> Ordering
compare :: Storage -> Storage -> Ordering
$c< :: Storage -> Storage -> Bool
< :: Storage -> Storage -> Bool
$c<= :: Storage -> Storage -> Bool
<= :: Storage -> Storage -> Bool
$c> :: Storage -> Storage -> Bool
> :: Storage -> Storage -> Bool
$c>= :: Storage -> Storage -> Bool
>= :: Storage -> Storage -> Bool
$cmax :: Storage -> Storage -> Storage
max :: Storage -> Storage -> Storage
$cmin :: Storage -> Storage -> Storage
min :: Storage -> Storage -> Storage
Ord, Int -> Storage -> ShowS
[Storage] -> ShowS
Storage -> String
(Int -> Storage -> ShowS)
-> (Storage -> String) -> ([Storage] -> ShowS) -> Show Storage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Storage -> ShowS
showsPrec :: Int -> Storage -> ShowS
$cshow :: Storage -> String
show :: Storage -> String
$cshowList :: [Storage] -> ShowS
showList :: [Storage] -> ShowS
Show, Typeable Storage
Typeable Storage =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Storage -> c Storage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Storage)
-> (Storage -> Constr)
-> (Storage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Storage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Storage))
-> ((forall b. Data b => b -> b) -> Storage -> Storage)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Storage -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Storage -> r)
-> (forall u. (forall d. Data d => d -> u) -> Storage -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Storage -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Storage -> m Storage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Storage -> m Storage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Storage -> m Storage)
-> Data Storage
Storage -> Constr
Storage -> DataType
(forall b. Data b => b -> b) -> Storage -> Storage
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) -> Storage -> u
forall u. (forall d. Data d => d -> u) -> Storage -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Storage -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Storage -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Storage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Storage -> c Storage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Storage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Storage)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Storage -> c Storage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Storage -> c Storage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Storage
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Storage
$ctoConstr :: Storage -> Constr
toConstr :: Storage -> Constr
$cdataTypeOf :: Storage -> DataType
dataTypeOf :: Storage -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Storage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Storage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Storage)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Storage)
$cgmapT :: (forall b. Data b => b -> b) -> Storage -> Storage
gmapT :: (forall b. Data b => b -> b) -> Storage -> Storage
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Storage -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Storage -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Storage -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Storage -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Storage -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Storage -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Storage -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Storage -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Storage -> m Storage
Data, Typeable)

data TypeQual = Tconst    !SrcLoc
              | Tvolatile !SrcLoc

              | EscTypeQual String !SrcLoc

              | AntiTypeQual  String !SrcLoc
              | AntiTypeQuals String !SrcLoc

              -- C99
              | Tinline   !SrcLoc
              | Trestrict !SrcLoc

              -- GCC
              | T__restrict !SrcLoc
              | TAttr Attr

              -- CUDA
              | TCUDAdevice   !SrcLoc
              | TCUDAglobal   !SrcLoc
              | TCUDAhost     !SrcLoc
              | TCUDAconstant !SrcLoc
              | TCUDAshared   !SrcLoc
              | TCUDArestrict !SrcLoc
              | TCUDAnoinline !SrcLoc

              -- OpenCL
              | TCLprivate   !SrcLoc
              | TCLlocal     !SrcLoc
              | TCLglobal    !SrcLoc
              | TCLconstant  !SrcLoc
              | TCLreadonly  !SrcLoc
              | TCLwriteonly !SrcLoc
              | TCLkernel    !SrcLoc
    deriving (TypeQual -> TypeQual -> Bool
(TypeQual -> TypeQual -> Bool)
-> (TypeQual -> TypeQual -> Bool) -> Eq TypeQual
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeQual -> TypeQual -> Bool
== :: TypeQual -> TypeQual -> Bool
$c/= :: TypeQual -> TypeQual -> Bool
/= :: TypeQual -> TypeQual -> Bool
Eq, Eq TypeQual
Eq TypeQual =>
(TypeQual -> TypeQual -> Ordering)
-> (TypeQual -> TypeQual -> Bool)
-> (TypeQual -> TypeQual -> Bool)
-> (TypeQual -> TypeQual -> Bool)
-> (TypeQual -> TypeQual -> Bool)
-> (TypeQual -> TypeQual -> TypeQual)
-> (TypeQual -> TypeQual -> TypeQual)
-> Ord TypeQual
TypeQual -> TypeQual -> Bool
TypeQual -> TypeQual -> Ordering
TypeQual -> TypeQual -> TypeQual
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
$ccompare :: TypeQual -> TypeQual -> Ordering
compare :: TypeQual -> TypeQual -> Ordering
$c< :: TypeQual -> TypeQual -> Bool
< :: TypeQual -> TypeQual -> Bool
$c<= :: TypeQual -> TypeQual -> Bool
<= :: TypeQual -> TypeQual -> Bool
$c> :: TypeQual -> TypeQual -> Bool
> :: TypeQual -> TypeQual -> Bool
$c>= :: TypeQual -> TypeQual -> Bool
>= :: TypeQual -> TypeQual -> Bool
$cmax :: TypeQual -> TypeQual -> TypeQual
max :: TypeQual -> TypeQual -> TypeQual
$cmin :: TypeQual -> TypeQual -> TypeQual
min :: TypeQual -> TypeQual -> TypeQual
Ord, Int -> TypeQual -> ShowS
[TypeQual] -> ShowS
TypeQual -> String
(Int -> TypeQual -> ShowS)
-> (TypeQual -> String) -> ([TypeQual] -> ShowS) -> Show TypeQual
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeQual -> ShowS
showsPrec :: Int -> TypeQual -> ShowS
$cshow :: TypeQual -> String
show :: TypeQual -> String
$cshowList :: [TypeQual] -> ShowS
showList :: [TypeQual] -> ShowS
Show, Typeable TypeQual
Typeable TypeQual =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TypeQual -> c TypeQual)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypeQual)
-> (TypeQual -> Constr)
-> (TypeQual -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TypeQual))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeQual))
-> ((forall b. Data b => b -> b) -> TypeQual -> TypeQual)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeQual -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeQual -> r)
-> (forall u. (forall d. Data d => d -> u) -> TypeQual -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TypeQual -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TypeQual -> m TypeQual)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeQual -> m TypeQual)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeQual -> m TypeQual)
-> Data TypeQual
TypeQual -> Constr
TypeQual -> DataType
(forall b. Data b => b -> b) -> TypeQual -> TypeQual
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) -> TypeQual -> u
forall u. (forall d. Data d => d -> u) -> TypeQual -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeQual -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeQual -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeQual
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeQual -> c TypeQual
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeQual)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeQual)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeQual -> c TypeQual
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeQual -> c TypeQual
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeQual
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeQual
$ctoConstr :: TypeQual -> Constr
toConstr :: TypeQual -> Constr
$cdataTypeOf :: TypeQual -> DataType
dataTypeOf :: TypeQual -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeQual)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeQual)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeQual)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeQual)
$cgmapT :: (forall b. Data b => b -> b) -> TypeQual -> TypeQual
gmapT :: (forall b. Data b => b -> b) -> TypeQual -> TypeQual
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeQual -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeQual -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeQual -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeQual -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeQual -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeQual -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeQual -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeQual -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeQual -> m TypeQual
Data, Typeable)

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

data TypeSpec = Tvoid                   !SrcLoc
              | Tchar      (Maybe Sign) !SrcLoc
              | Tshort     (Maybe Sign) !SrcLoc
              | Tint       (Maybe Sign) !SrcLoc
              | Tlong      (Maybe Sign) !SrcLoc
              | Tlong_long (Maybe Sign) !SrcLoc
              | Tfloat                  !SrcLoc
              | Tdouble                 !SrcLoc
              | Tlong_double            !SrcLoc
              | Tstruct (Maybe Id) (Maybe [FieldGroup]) [Attr] !SrcLoc
              | Tunion  (Maybe Id) (Maybe [FieldGroup]) [Attr] !SrcLoc
              | Tenum   (Maybe Id) [CEnum]              [Attr] !SrcLoc
              | Tnamed Id       -- A typedef name
                       [Id]     -- Objective-C protocol references
                       !SrcLoc

              -- C99
              | T_Bool                 !SrcLoc
              | Tfloat_Complex         !SrcLoc
              | Tdouble_Complex        !SrcLoc
              | Tlong_double_Complex   !SrcLoc
              | Tfloat_Imaginary       !SrcLoc
              | Tdouble_Imaginary      !SrcLoc
              | Tlong_double_Imaginary !SrcLoc

              -- Gcc
              | TtypeofExp  Exp  !SrcLoc
              | TtypeofType Type !SrcLoc
              | Tva_list         !SrcLoc
    deriving (TypeSpec -> TypeSpec -> Bool
(TypeSpec -> TypeSpec -> Bool)
-> (TypeSpec -> TypeSpec -> Bool) -> Eq TypeSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeSpec -> TypeSpec -> Bool
== :: TypeSpec -> TypeSpec -> Bool
$c/= :: TypeSpec -> TypeSpec -> Bool
/= :: TypeSpec -> TypeSpec -> Bool
Eq, Eq TypeSpec
Eq TypeSpec =>
(TypeSpec -> TypeSpec -> Ordering)
-> (TypeSpec -> TypeSpec -> Bool)
-> (TypeSpec -> TypeSpec -> Bool)
-> (TypeSpec -> TypeSpec -> Bool)
-> (TypeSpec -> TypeSpec -> Bool)
-> (TypeSpec -> TypeSpec -> TypeSpec)
-> (TypeSpec -> TypeSpec -> TypeSpec)
-> Ord TypeSpec
TypeSpec -> TypeSpec -> Bool
TypeSpec -> TypeSpec -> Ordering
TypeSpec -> TypeSpec -> TypeSpec
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
$ccompare :: TypeSpec -> TypeSpec -> Ordering
compare :: TypeSpec -> TypeSpec -> Ordering
$c< :: TypeSpec -> TypeSpec -> Bool
< :: TypeSpec -> TypeSpec -> Bool
$c<= :: TypeSpec -> TypeSpec -> Bool
<= :: TypeSpec -> TypeSpec -> Bool
$c> :: TypeSpec -> TypeSpec -> Bool
> :: TypeSpec -> TypeSpec -> Bool
$c>= :: TypeSpec -> TypeSpec -> Bool
>= :: TypeSpec -> TypeSpec -> Bool
$cmax :: TypeSpec -> TypeSpec -> TypeSpec
max :: TypeSpec -> TypeSpec -> TypeSpec
$cmin :: TypeSpec -> TypeSpec -> TypeSpec
min :: TypeSpec -> TypeSpec -> TypeSpec
Ord, Int -> TypeSpec -> ShowS
[TypeSpec] -> ShowS
TypeSpec -> String
(Int -> TypeSpec -> ShowS)
-> (TypeSpec -> String) -> ([TypeSpec] -> ShowS) -> Show TypeSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeSpec -> ShowS
showsPrec :: Int -> TypeSpec -> ShowS
$cshow :: TypeSpec -> String
show :: TypeSpec -> String
$cshowList :: [TypeSpec] -> ShowS
showList :: [TypeSpec] -> ShowS
Show, Typeable TypeSpec
Typeable TypeSpec =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TypeSpec -> c TypeSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypeSpec)
-> (TypeSpec -> Constr)
-> (TypeSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TypeSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeSpec))
-> ((forall b. Data b => b -> b) -> TypeSpec -> TypeSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> TypeSpec -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TypeSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec)
-> Data TypeSpec
TypeSpec -> Constr
TypeSpec -> DataType
(forall b. Data b => b -> b) -> TypeSpec -> TypeSpec
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) -> TypeSpec -> u
forall u. (forall d. Data d => d -> u) -> TypeSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSpec -> c TypeSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeSpec)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSpec -> c TypeSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeSpec -> c TypeSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSpec
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeSpec
$ctoConstr :: TypeSpec -> Constr
toConstr :: TypeSpec -> Constr
$cdataTypeOf :: TypeSpec -> DataType
dataTypeOf :: TypeSpec -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeSpec)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeSpec)
$cgmapT :: (forall b. Data b => b -> b) -> TypeSpec -> TypeSpec
gmapT :: (forall b. Data b => b -> b) -> TypeSpec -> TypeSpec
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSpec -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeSpec -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSpec -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeSpec -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSpec -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeSpec -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeSpec -> m TypeSpec
Data, Typeable)

data DeclSpec = DeclSpec         [Storage] [TypeQual] TypeSpec !SrcLoc
              | AntiDeclSpec                          String   !SrcLoc
              | AntiTypeDeclSpec [Storage] [TypeQual] String   !SrcLoc
    deriving (DeclSpec -> DeclSpec -> Bool
(DeclSpec -> DeclSpec -> Bool)
-> (DeclSpec -> DeclSpec -> Bool) -> Eq DeclSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclSpec -> DeclSpec -> Bool
== :: DeclSpec -> DeclSpec -> Bool
$c/= :: DeclSpec -> DeclSpec -> Bool
/= :: DeclSpec -> DeclSpec -> Bool
Eq, Eq DeclSpec
Eq DeclSpec =>
(DeclSpec -> DeclSpec -> Ordering)
-> (DeclSpec -> DeclSpec -> Bool)
-> (DeclSpec -> DeclSpec -> Bool)
-> (DeclSpec -> DeclSpec -> Bool)
-> (DeclSpec -> DeclSpec -> Bool)
-> (DeclSpec -> DeclSpec -> DeclSpec)
-> (DeclSpec -> DeclSpec -> DeclSpec)
-> Ord DeclSpec
DeclSpec -> DeclSpec -> Bool
DeclSpec -> DeclSpec -> Ordering
DeclSpec -> DeclSpec -> DeclSpec
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
$ccompare :: DeclSpec -> DeclSpec -> Ordering
compare :: DeclSpec -> DeclSpec -> Ordering
$c< :: DeclSpec -> DeclSpec -> Bool
< :: DeclSpec -> DeclSpec -> Bool
$c<= :: DeclSpec -> DeclSpec -> Bool
<= :: DeclSpec -> DeclSpec -> Bool
$c> :: DeclSpec -> DeclSpec -> Bool
> :: DeclSpec -> DeclSpec -> Bool
$c>= :: DeclSpec -> DeclSpec -> Bool
>= :: DeclSpec -> DeclSpec -> Bool
$cmax :: DeclSpec -> DeclSpec -> DeclSpec
max :: DeclSpec -> DeclSpec -> DeclSpec
$cmin :: DeclSpec -> DeclSpec -> DeclSpec
min :: DeclSpec -> DeclSpec -> DeclSpec
Ord, Int -> DeclSpec -> ShowS
[DeclSpec] -> ShowS
DeclSpec -> String
(Int -> DeclSpec -> ShowS)
-> (DeclSpec -> String) -> ([DeclSpec] -> ShowS) -> Show DeclSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeclSpec -> ShowS
showsPrec :: Int -> DeclSpec -> ShowS
$cshow :: DeclSpec -> String
show :: DeclSpec -> String
$cshowList :: [DeclSpec] -> ShowS
showList :: [DeclSpec] -> ShowS
Show, Typeable DeclSpec
Typeable DeclSpec =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DeclSpec -> c DeclSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeclSpec)
-> (DeclSpec -> Constr)
-> (DeclSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeclSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeclSpec))
-> ((forall b. Data b => b -> b) -> DeclSpec -> DeclSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeclSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeclSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> DeclSpec -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DeclSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec)
-> Data DeclSpec
DeclSpec -> Constr
DeclSpec -> DataType
(forall b. Data b => b -> b) -> DeclSpec -> DeclSpec
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) -> DeclSpec -> u
forall u. (forall d. Data d => d -> u) -> DeclSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeclSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeclSpec -> c DeclSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeclSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeclSpec)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeclSpec -> c DeclSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeclSpec -> c DeclSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeclSpec
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeclSpec
$ctoConstr :: DeclSpec -> Constr
toConstr :: DeclSpec -> Constr
$cdataTypeOf :: DeclSpec -> DataType
dataTypeOf :: DeclSpec -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeclSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeclSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeclSpec)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeclSpec)
$cgmapT :: (forall b. Data b => b -> b) -> DeclSpec -> DeclSpec
gmapT :: (forall b. Data b => b -> b) -> DeclSpec -> DeclSpec
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclSpec -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclSpec -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DeclSpec -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DeclSpec -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DeclSpec -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DeclSpec -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclSpec -> m DeclSpec
Data, Typeable)

-- | There are two types of declarators in C, regular declarators and abstract
-- declarators. The former is for declaring variables, function parameters,
-- typedefs, etc. and the latter for abstract types---@typedef int
-- ({*}foo)(void)@ vs. @\tt int ({*})(void)@. The difference between the two is
-- just whether or not an identifier is attached to the declarator. We therefore
-- only define one 'Decl' type and use it for both cases.

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

data Decl = DeclRoot !SrcLoc
          | Ptr [TypeQual] Decl !SrcLoc
          | Array [TypeQual] ArraySize Decl !SrcLoc
          | Proto Decl Params !SrcLoc
          | OldProto Decl [Id] !SrcLoc
          | AntiTypeDecl String !SrcLoc

          -- Clang blocks
          | BlockPtr [TypeQual] Decl !SrcLoc
    deriving (Decl -> Decl -> Bool
(Decl -> Decl -> Bool) -> (Decl -> Decl -> Bool) -> Eq Decl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Decl -> Decl -> Bool
== :: Decl -> Decl -> Bool
$c/= :: Decl -> Decl -> Bool
/= :: Decl -> Decl -> Bool
Eq, Eq Decl
Eq Decl =>
(Decl -> Decl -> Ordering)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Decl)
-> (Decl -> Decl -> Decl)
-> Ord Decl
Decl -> Decl -> Bool
Decl -> Decl -> Ordering
Decl -> Decl -> Decl
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
$ccompare :: Decl -> Decl -> Ordering
compare :: Decl -> Decl -> Ordering
$c< :: Decl -> Decl -> Bool
< :: Decl -> Decl -> Bool
$c<= :: Decl -> Decl -> Bool
<= :: Decl -> Decl -> Bool
$c> :: Decl -> Decl -> Bool
> :: Decl -> Decl -> Bool
$c>= :: Decl -> Decl -> Bool
>= :: Decl -> Decl -> Bool
$cmax :: Decl -> Decl -> Decl
max :: Decl -> Decl -> Decl
$cmin :: Decl -> Decl -> Decl
min :: Decl -> Decl -> Decl
Ord, Int -> Decl -> ShowS
[Decl] -> ShowS
Decl -> String
(Int -> Decl -> ShowS)
-> (Decl -> String) -> ([Decl] -> ShowS) -> Show Decl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Decl -> ShowS
showsPrec :: Int -> Decl -> ShowS
$cshow :: Decl -> String
show :: Decl -> String
$cshowList :: [Decl] -> ShowS
showList :: [Decl] -> ShowS
Show, Typeable Decl
Typeable Decl =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Decl -> c Decl)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Decl)
-> (Decl -> Constr)
-> (Decl -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Decl))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decl))
-> ((forall b. Data b => b -> b) -> Decl -> Decl)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r)
-> (forall u. (forall d. Data d => d -> u) -> Decl -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Decl -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Decl -> m Decl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Decl -> m Decl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Decl -> m Decl)
-> Data Decl
Decl -> Constr
Decl -> DataType
(forall b. Data b => b -> b) -> Decl -> Decl
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) -> Decl -> u
forall u. (forall d. Data d => d -> u) -> Decl -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Decl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decl -> c Decl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Decl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decl)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decl -> c Decl
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decl -> c Decl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Decl
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Decl
$ctoConstr :: Decl -> Constr
toConstr :: Decl -> Constr
$cdataTypeOf :: Decl -> DataType
dataTypeOf :: Decl -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Decl)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Decl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decl)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decl)
$cgmapT :: (forall b. Data b => b -> b) -> Decl -> Decl
gmapT :: (forall b. Data b => b -> b) -> Decl -> Decl
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Decl -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Decl -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Decl -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Decl -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decl -> m Decl
Data, Typeable)

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

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

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

data Initializer = ExpInitializer Exp !SrcLoc
                 | CompoundInitializer [(Maybe Designation, Initializer)] !SrcLoc
                 | AntiInit  String !SrcLoc
                 | AntiInits String !SrcLoc
    deriving (Initializer -> Initializer -> Bool
(Initializer -> Initializer -> Bool)
-> (Initializer -> Initializer -> Bool) -> Eq Initializer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Initializer -> Initializer -> Bool
== :: Initializer -> Initializer -> Bool
$c/= :: Initializer -> Initializer -> Bool
/= :: Initializer -> Initializer -> Bool
Eq, Eq Initializer
Eq Initializer =>
(Initializer -> Initializer -> Ordering)
-> (Initializer -> Initializer -> Bool)
-> (Initializer -> Initializer -> Bool)
-> (Initializer -> Initializer -> Bool)
-> (Initializer -> Initializer -> Bool)
-> (Initializer -> Initializer -> Initializer)
-> (Initializer -> Initializer -> Initializer)
-> Ord Initializer
Initializer -> Initializer -> Bool
Initializer -> Initializer -> Ordering
Initializer -> Initializer -> Initializer
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
$ccompare :: Initializer -> Initializer -> Ordering
compare :: Initializer -> Initializer -> Ordering
$c< :: Initializer -> Initializer -> Bool
< :: Initializer -> Initializer -> Bool
$c<= :: Initializer -> Initializer -> Bool
<= :: Initializer -> Initializer -> Bool
$c> :: Initializer -> Initializer -> Bool
> :: Initializer -> Initializer -> Bool
$c>= :: Initializer -> Initializer -> Bool
>= :: Initializer -> Initializer -> Bool
$cmax :: Initializer -> Initializer -> Initializer
max :: Initializer -> Initializer -> Initializer
$cmin :: Initializer -> Initializer -> Initializer
min :: Initializer -> Initializer -> Initializer
Ord, Int -> Initializer -> ShowS
[Initializer] -> ShowS
Initializer -> String
(Int -> Initializer -> ShowS)
-> (Initializer -> String)
-> ([Initializer] -> ShowS)
-> Show Initializer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Initializer -> ShowS
showsPrec :: Int -> Initializer -> ShowS
$cshow :: Initializer -> String
show :: Initializer -> String
$cshowList :: [Initializer] -> ShowS
showList :: [Initializer] -> ShowS
Show, Typeable Initializer
Typeable Initializer =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Initializer -> c Initializer)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Initializer)
-> (Initializer -> Constr)
-> (Initializer -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Initializer))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Initializer))
-> ((forall b. Data b => b -> b) -> Initializer -> Initializer)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Initializer -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Initializer -> r)
-> (forall u. (forall d. Data d => d -> u) -> Initializer -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Initializer -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Initializer -> m Initializer)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Initializer -> m Initializer)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Initializer -> m Initializer)
-> Data Initializer
Initializer -> Constr
Initializer -> DataType
(forall b. Data b => b -> b) -> Initializer -> Initializer
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) -> Initializer -> u
forall u. (forall d. Data d => d -> u) -> Initializer -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Initializer -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Initializer -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Initializer
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Initializer -> c Initializer
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Initializer)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Initializer)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Initializer -> c Initializer
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Initializer -> c Initializer
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Initializer
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Initializer
$ctoConstr :: Initializer -> Constr
toConstr :: Initializer -> Constr
$cdataTypeOf :: Initializer -> DataType
dataTypeOf :: Initializer -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Initializer)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Initializer)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Initializer)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Initializer)
$cgmapT :: (forall b. Data b => b -> b) -> Initializer -> Initializer
gmapT :: (forall b. Data b => b -> b) -> Initializer -> Initializer
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Initializer -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Initializer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Initializer -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Initializer -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Initializer -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Initializer -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Initializer -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Initializer -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Initializer -> m Initializer
Data, Typeable)

type AsmLabel = StringLit

data Init = Init Id Decl (Maybe AsmLabel) (Maybe Initializer) [Attr] !SrcLoc
    deriving (Init -> Init -> Bool
(Init -> Init -> Bool) -> (Init -> Init -> Bool) -> Eq Init
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Init -> Init -> Bool
== :: Init -> Init -> Bool
$c/= :: Init -> Init -> Bool
/= :: Init -> Init -> Bool
Eq, Eq Init
Eq Init =>
(Init -> Init -> Ordering)
-> (Init -> Init -> Bool)
-> (Init -> Init -> Bool)
-> (Init -> Init -> Bool)
-> (Init -> Init -> Bool)
-> (Init -> Init -> Init)
-> (Init -> Init -> Init)
-> Ord Init
Init -> Init -> Bool
Init -> Init -> Ordering
Init -> Init -> Init
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
$ccompare :: Init -> Init -> Ordering
compare :: Init -> Init -> Ordering
$c< :: Init -> Init -> Bool
< :: Init -> Init -> Bool
$c<= :: Init -> Init -> Bool
<= :: Init -> Init -> Bool
$c> :: Init -> Init -> Bool
> :: Init -> Init -> Bool
$c>= :: Init -> Init -> Bool
>= :: Init -> Init -> Bool
$cmax :: Init -> Init -> Init
max :: Init -> Init -> Init
$cmin :: Init -> Init -> Init
min :: Init -> Init -> Init
Ord, Int -> Init -> ShowS
[Init] -> ShowS
Init -> String
(Int -> Init -> ShowS)
-> (Init -> String) -> ([Init] -> ShowS) -> Show Init
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Init -> ShowS
showsPrec :: Int -> Init -> ShowS
$cshow :: Init -> String
show :: Init -> String
$cshowList :: [Init] -> ShowS
showList :: [Init] -> ShowS
Show, Typeable Init
Typeable Init =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Init -> c Init)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Init)
-> (Init -> Constr)
-> (Init -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Init))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Init))
-> ((forall b. Data b => b -> b) -> Init -> Init)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r)
-> (forall u. (forall d. Data d => d -> u) -> Init -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Init -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Init -> m Init)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Init -> m Init)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Init -> m Init)
-> Data Init
Init -> Constr
Init -> DataType
(forall b. Data b => b -> b) -> Init -> Init
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) -> Init -> u
forall u. (forall d. Data d => d -> u) -> Init -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Init -> m Init
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Init -> m Init
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Init
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Init -> c Init
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Init)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Init)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Init -> c Init
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Init -> c Init
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Init
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Init
$ctoConstr :: Init -> Constr
toConstr :: Init -> Constr
$cdataTypeOf :: Init -> DataType
dataTypeOf :: Init -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Init)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Init)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Init)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Init)
$cgmapT :: (forall b. Data b => b -> b) -> Init -> Init
gmapT :: (forall b. Data b => b -> b) -> Init -> Init
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Init -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Init -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Init -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Init -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Init -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Init -> m Init
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Init -> m Init
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Init -> m Init
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Init -> m Init
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Init -> m Init
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Init -> m Init
Data, Typeable)

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

data InitGroup = InitGroup    DeclSpec [Attr] [Init]    !SrcLoc
               | TypedefGroup DeclSpec [Attr] [Typedef] !SrcLoc
               | AntiDecl  String !SrcLoc
               | AntiDecls String !SrcLoc
    deriving (InitGroup -> InitGroup -> Bool
(InitGroup -> InitGroup -> Bool)
-> (InitGroup -> InitGroup -> Bool) -> Eq InitGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitGroup -> InitGroup -> Bool
== :: InitGroup -> InitGroup -> Bool
$c/= :: InitGroup -> InitGroup -> Bool
/= :: InitGroup -> InitGroup -> Bool
Eq, Eq InitGroup
Eq InitGroup =>
(InitGroup -> InitGroup -> Ordering)
-> (InitGroup -> InitGroup -> Bool)
-> (InitGroup -> InitGroup -> Bool)
-> (InitGroup -> InitGroup -> Bool)
-> (InitGroup -> InitGroup -> Bool)
-> (InitGroup -> InitGroup -> InitGroup)
-> (InitGroup -> InitGroup -> InitGroup)
-> Ord InitGroup
InitGroup -> InitGroup -> Bool
InitGroup -> InitGroup -> Ordering
InitGroup -> InitGroup -> InitGroup
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
$ccompare :: InitGroup -> InitGroup -> Ordering
compare :: InitGroup -> InitGroup -> Ordering
$c< :: InitGroup -> InitGroup -> Bool
< :: InitGroup -> InitGroup -> Bool
$c<= :: InitGroup -> InitGroup -> Bool
<= :: InitGroup -> InitGroup -> Bool
$c> :: InitGroup -> InitGroup -> Bool
> :: InitGroup -> InitGroup -> Bool
$c>= :: InitGroup -> InitGroup -> Bool
>= :: InitGroup -> InitGroup -> Bool
$cmax :: InitGroup -> InitGroup -> InitGroup
max :: InitGroup -> InitGroup -> InitGroup
$cmin :: InitGroup -> InitGroup -> InitGroup
min :: InitGroup -> InitGroup -> InitGroup
Ord, Int -> InitGroup -> ShowS
[InitGroup] -> ShowS
InitGroup -> String
(Int -> InitGroup -> ShowS)
-> (InitGroup -> String)
-> ([InitGroup] -> ShowS)
-> Show InitGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitGroup -> ShowS
showsPrec :: Int -> InitGroup -> ShowS
$cshow :: InitGroup -> String
show :: InitGroup -> String
$cshowList :: [InitGroup] -> ShowS
showList :: [InitGroup] -> ShowS
Show, Typeable InitGroup
Typeable InitGroup =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> InitGroup -> c InitGroup)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InitGroup)
-> (InitGroup -> Constr)
-> (InitGroup -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InitGroup))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitGroup))
-> ((forall b. Data b => b -> b) -> InitGroup -> InitGroup)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InitGroup -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InitGroup -> r)
-> (forall u. (forall d. Data d => d -> u) -> InitGroup -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InitGroup -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InitGroup -> m InitGroup)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InitGroup -> m InitGroup)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InitGroup -> m InitGroup)
-> Data InitGroup
InitGroup -> Constr
InitGroup -> DataType
(forall b. Data b => b -> b) -> InitGroup -> InitGroup
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) -> InitGroup -> u
forall u. (forall d. Data d => d -> u) -> InitGroup -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitGroup -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitGroup -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitGroup
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitGroup -> c InitGroup
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitGroup)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitGroup)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitGroup -> c InitGroup
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitGroup -> c InitGroup
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitGroup
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitGroup
$ctoConstr :: InitGroup -> Constr
toConstr :: InitGroup -> Constr
$cdataTypeOf :: InitGroup -> DataType
dataTypeOf :: InitGroup -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitGroup)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitGroup)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitGroup)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitGroup)
$cgmapT :: (forall b. Data b => b -> b) -> InitGroup -> InitGroup
gmapT :: (forall b. Data b => b -> b) -> InitGroup -> InitGroup
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitGroup -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitGroup -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitGroup -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitGroup -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InitGroup -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> InitGroup -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InitGroup -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InitGroup -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitGroup -> m InitGroup
Data, Typeable)

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

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

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

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

data Param  =  Param (Maybe Id) DeclSpec Decl !SrcLoc
            |  AntiParam  String !SrcLoc
            |  AntiParams String !SrcLoc
    deriving (Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
/= :: Param -> Param -> Bool
Eq, Eq Param
Eq Param =>
(Param -> Param -> Ordering)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Param)
-> (Param -> Param -> Param)
-> Ord Param
Param -> Param -> Bool
Param -> Param -> Ordering
Param -> Param -> Param
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
$ccompare :: Param -> Param -> Ordering
compare :: Param -> Param -> Ordering
$c< :: Param -> Param -> Bool
< :: Param -> Param -> Bool
$c<= :: Param -> Param -> Bool
<= :: Param -> Param -> Bool
$c> :: Param -> Param -> Bool
> :: Param -> Param -> Bool
$c>= :: Param -> Param -> Bool
>= :: Param -> Param -> Bool
$cmax :: Param -> Param -> Param
max :: Param -> Param -> Param
$cmin :: Param -> Param -> Param
min :: Param -> Param -> Param
Ord, Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
(Int -> Param -> ShowS)
-> (Param -> String) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Param -> ShowS
showsPrec :: Int -> Param -> ShowS
$cshow :: Param -> String
show :: Param -> String
$cshowList :: [Param] -> ShowS
showList :: [Param] -> ShowS
Show, Typeable Param
Typeable Param =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Param -> c Param)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Param)
-> (Param -> Constr)
-> (Param -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Param))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Param))
-> ((forall b. Data b => b -> b) -> Param -> Param)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r)
-> (forall u. (forall d. Data d => d -> u) -> Param -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Param -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Param -> m Param)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Param -> m Param)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Param -> m Param)
-> Data Param
Param -> Constr
Param -> DataType
(forall b. Data b => b -> b) -> Param -> Param
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) -> Param -> u
forall u. (forall d. Data d => d -> u) -> Param -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Param -> m Param
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Param -> m Param
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Param
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Param -> c Param
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Param)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Param)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Param -> c Param
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Param -> c Param
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Param
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Param
$ctoConstr :: Param -> Constr
toConstr :: Param -> Constr
$cdataTypeOf :: Param -> DataType
dataTypeOf :: Param -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Param)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Param)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Param)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Param)
$cgmapT :: (forall b. Data b => b -> b) -> Param -> Param
gmapT :: (forall b. Data b => b -> b) -> Param -> Param
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Param -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Param -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Param -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Param -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Param -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Param -> m Param
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Param -> m Param
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Param -> m Param
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Param -> m Param
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Param -> m Param
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Param -> m Param
Data, Typeable)

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

data Func  =  Func    DeclSpec Id Decl Params                   [BlockItem] !SrcLoc
           |  OldFunc DeclSpec Id Decl [Id] (Maybe [InitGroup]) [BlockItem] !SrcLoc
    deriving (Func -> Func -> Bool
(Func -> Func -> Bool) -> (Func -> Func -> Bool) -> Eq Func
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Func -> Func -> Bool
== :: Func -> Func -> Bool
$c/= :: Func -> Func -> Bool
/= :: Func -> Func -> Bool
Eq, Eq Func
Eq Func =>
(Func -> Func -> Ordering)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Func)
-> (Func -> Func -> Func)
-> Ord Func
Func -> Func -> Bool
Func -> Func -> Ordering
Func -> Func -> Func
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
$ccompare :: Func -> Func -> Ordering
compare :: Func -> Func -> Ordering
$c< :: Func -> Func -> Bool
< :: Func -> Func -> Bool
$c<= :: Func -> Func -> Bool
<= :: Func -> Func -> Bool
$c> :: Func -> Func -> Bool
> :: Func -> Func -> Bool
$c>= :: Func -> Func -> Bool
>= :: Func -> Func -> Bool
$cmax :: Func -> Func -> Func
max :: Func -> Func -> Func
$cmin :: Func -> Func -> Func
min :: Func -> Func -> Func
Ord, Int -> Func -> ShowS
[Func] -> ShowS
Func -> String
(Int -> Func -> ShowS)
-> (Func -> String) -> ([Func] -> ShowS) -> Show Func
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Func -> ShowS
showsPrec :: Int -> Func -> ShowS
$cshow :: Func -> String
show :: Func -> String
$cshowList :: [Func] -> ShowS
showList :: [Func] -> ShowS
Show, Typeable Func
Typeable Func =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Func -> c Func)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Func)
-> (Func -> Constr)
-> (Func -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Func))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Func))
-> ((forall b. Data b => b -> b) -> Func -> Func)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r)
-> (forall u. (forall d. Data d => d -> u) -> Func -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Func -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Func -> m Func)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Func -> m Func)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Func -> m Func)
-> Data Func
Func -> Constr
Func -> DataType
(forall b. Data b => b -> b) -> Func -> Func
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) -> Func -> u
forall u. (forall d. Data d => d -> u) -> Func -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Func -> m Func
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Func -> m Func
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Func
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Func -> c Func
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Func)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Func)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Func -> c Func
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Func -> c Func
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Func
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Func
$ctoConstr :: Func -> Constr
toConstr :: Func -> Constr
$cdataTypeOf :: Func -> DataType
dataTypeOf :: Func -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Func)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Func)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Func)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Func)
$cgmapT :: (forall b. Data b => b -> b) -> Func -> Func
gmapT :: (forall b. Data b => b -> b) -> Func -> Func
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Func -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Func -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Func -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Func -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Func -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Func -> m Func
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Func -> m Func
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Func -> m Func
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Func -> m Func
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Func -> m Func
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Func -> m Func
Data, Typeable)

data Definition  =  FuncDef    Func      !SrcLoc
                 |  DecDef     InitGroup !SrcLoc
                 |  EscDef     String    !SrcLoc
                 |  AntiFunc   String    !SrcLoc
                 |  AntiEsc    String    !SrcLoc
                 |  AntiEdecl  String    !SrcLoc
                 |  AntiEdecls String    !SrcLoc

                 -- Objective-C
                 |  ObjCClassDec   [Id] !SrcLoc
                 |  ObjCClassIface Id (Maybe Id) [Id] [ObjCIvarDecl] [ObjCIfaceDecl] [Attr] !SrcLoc
                 |  ObjCCatIface   Id (Maybe Id) [Id] [ObjCIvarDecl] [ObjCIfaceDecl]        !SrcLoc
                 |  ObjCProtDec    [Id] !SrcLoc
                 |  ObjCProtDef    Id [Id] [ObjCIfaceDecl] !SrcLoc
                 |  ObjCClassImpl  Id (Maybe Id) [ObjCIvarDecl] [Definition] !SrcLoc
                 |  ObjCCatImpl    Id Id [Definition] !SrcLoc
                 |  ObjCSynDef     [(Id, Maybe Id)] !SrcLoc
                 |  ObjCDynDef     [Id] !SrcLoc
                 |  ObjCMethDef    ObjCMethodProto [BlockItem] !SrcLoc
                 |  ObjCCompAlias  Id Id !SrcLoc

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

data Stm  = Label Id [Attr] Stm !SrcLoc
          | Case Exp Stm !SrcLoc
          | CaseRange Exp Exp Stm !SrcLoc
          | Default Stm !SrcLoc
          | Exp (Maybe Exp) !SrcLoc
          | Block [BlockItem] !SrcLoc
          | If Exp Stm (Maybe Stm) !SrcLoc
          | Switch Exp Stm !SrcLoc
          | While Exp Stm !SrcLoc
          | DoWhile Stm Exp !SrcLoc
          | For (Either InitGroup (Maybe Exp)) (Maybe Exp) (Maybe Exp) Stm !SrcLoc
          | Goto Id !SrcLoc
          | Continue !SrcLoc
          | Break !SrcLoc
          | Return (Maybe Exp) !SrcLoc
          | Pragma String !SrcLoc
          | Comment String Stm !SrcLoc
          | EscStm String !SrcLoc
          | AntiEscStm String !SrcLoc
          | AntiPragma String !SrcLoc
          | AntiComment String Stm !SrcLoc
          | AntiStm String !SrcLoc
          | AntiStms String !SrcLoc

          -- GCC
          | Asm Bool         -- @True@ if volatile, @False@ otherwise
                [Attr]       -- Attributes
                AsmTemplate  -- Assembly template
                [AsmOut]     -- Output operands
                [AsmIn]      -- Input operands
                [AsmClobber] -- Clobbered registers
                !SrcLoc
          | AsmGoto Bool         -- @True@ if volatile, @False@ otherwise
                    [Attr]       -- Attributes
                    AsmTemplate  -- Assembly template
                    [AsmIn]      -- Input operands
                    [AsmClobber] -- Clobbered registers
                    [Id]         -- Labels
                    !SrcLoc

          -- Objective-C
          | ObjCTry [BlockItem] [ObjCCatch] (Maybe [BlockItem]) !SrcLoc
            -- ^Invariant: There is either at least one 'ObjCCatch' or the finally block is present.
          | ObjCThrow (Maybe Exp) !SrcLoc
          | ObjCSynchronized Exp [BlockItem] !SrcLoc
          | ObjCAutoreleasepool [BlockItem] !SrcLoc
    deriving (Stm -> Stm -> Bool
(Stm -> Stm -> Bool) -> (Stm -> Stm -> Bool) -> Eq Stm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stm -> Stm -> Bool
== :: Stm -> Stm -> Bool
$c/= :: Stm -> Stm -> Bool
/= :: Stm -> Stm -> Bool
Eq, Eq Stm
Eq Stm =>
(Stm -> Stm -> Ordering)
-> (Stm -> Stm -> Bool)
-> (Stm -> Stm -> Bool)
-> (Stm -> Stm -> Bool)
-> (Stm -> Stm -> Bool)
-> (Stm -> Stm -> Stm)
-> (Stm -> Stm -> Stm)
-> Ord Stm
Stm -> Stm -> Bool
Stm -> Stm -> Ordering
Stm -> Stm -> Stm
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
$ccompare :: Stm -> Stm -> Ordering
compare :: Stm -> Stm -> Ordering
$c< :: Stm -> Stm -> Bool
< :: Stm -> Stm -> Bool
$c<= :: Stm -> Stm -> Bool
<= :: Stm -> Stm -> Bool
$c> :: Stm -> Stm -> Bool
> :: Stm -> Stm -> Bool
$c>= :: Stm -> Stm -> Bool
>= :: Stm -> Stm -> Bool
$cmax :: Stm -> Stm -> Stm
max :: Stm -> Stm -> Stm
$cmin :: Stm -> Stm -> Stm
min :: Stm -> Stm -> Stm
Ord, Int -> Stm -> ShowS
[Stm] -> ShowS
Stm -> String
(Int -> Stm -> ShowS)
-> (Stm -> String) -> ([Stm] -> ShowS) -> Show Stm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stm -> ShowS
showsPrec :: Int -> Stm -> ShowS
$cshow :: Stm -> String
show :: Stm -> String
$cshowList :: [Stm] -> ShowS
showList :: [Stm] -> ShowS
Show, Typeable Stm
Typeable Stm =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Stm -> c Stm)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Stm)
-> (Stm -> Constr)
-> (Stm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Stm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stm))
-> ((forall b. Data b => b -> b) -> Stm -> Stm)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r)
-> (forall u. (forall d. Data d => d -> u) -> Stm -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Stm -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Stm -> m Stm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Stm -> m Stm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Stm -> m Stm)
-> Data Stm
Stm -> Constr
Stm -> DataType
(forall b. Data b => b -> b) -> Stm -> Stm
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) -> Stm -> u
forall u. (forall d. Data d => d -> u) -> Stm -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stm -> c Stm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stm)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stm -> c Stm
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stm -> c Stm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stm
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stm
$ctoConstr :: Stm -> Constr
toConstr :: Stm -> Constr
$cdataTypeOf :: Stm -> DataType
dataTypeOf :: Stm -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stm)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stm)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stm)
$cgmapT :: (forall b. Data b => b -> b) -> Stm -> Stm
gmapT :: (forall b. Data b => b -> b) -> Stm -> Stm
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stm -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Stm -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Stm -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Stm -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Stm -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stm -> m Stm
Data, Typeable)

data BlockItem = BlockDecl InitGroup
               | BlockStm Stm
               | AntiBlockItem  String !SrcLoc
               | AntiBlockItems String !SrcLoc
    deriving (BlockItem -> BlockItem -> Bool
(BlockItem -> BlockItem -> Bool)
-> (BlockItem -> BlockItem -> Bool) -> Eq BlockItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockItem -> BlockItem -> Bool
== :: BlockItem -> BlockItem -> Bool
$c/= :: BlockItem -> BlockItem -> Bool
/= :: BlockItem -> BlockItem -> Bool
Eq, Eq BlockItem
Eq BlockItem =>
(BlockItem -> BlockItem -> Ordering)
-> (BlockItem -> BlockItem -> Bool)
-> (BlockItem -> BlockItem -> Bool)
-> (BlockItem -> BlockItem -> Bool)
-> (BlockItem -> BlockItem -> Bool)
-> (BlockItem -> BlockItem -> BlockItem)
-> (BlockItem -> BlockItem -> BlockItem)
-> Ord BlockItem
BlockItem -> BlockItem -> Bool
BlockItem -> BlockItem -> Ordering
BlockItem -> BlockItem -> BlockItem
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
$ccompare :: BlockItem -> BlockItem -> Ordering
compare :: BlockItem -> BlockItem -> Ordering
$c< :: BlockItem -> BlockItem -> Bool
< :: BlockItem -> BlockItem -> Bool
$c<= :: BlockItem -> BlockItem -> Bool
<= :: BlockItem -> BlockItem -> Bool
$c> :: BlockItem -> BlockItem -> Bool
> :: BlockItem -> BlockItem -> Bool
$c>= :: BlockItem -> BlockItem -> Bool
>= :: BlockItem -> BlockItem -> Bool
$cmax :: BlockItem -> BlockItem -> BlockItem
max :: BlockItem -> BlockItem -> BlockItem
$cmin :: BlockItem -> BlockItem -> BlockItem
min :: BlockItem -> BlockItem -> BlockItem
Ord, Int -> BlockItem -> ShowS
[BlockItem] -> ShowS
BlockItem -> String
(Int -> BlockItem -> ShowS)
-> (BlockItem -> String)
-> ([BlockItem] -> ShowS)
-> Show BlockItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockItem -> ShowS
showsPrec :: Int -> BlockItem -> ShowS
$cshow :: BlockItem -> String
show :: BlockItem -> String
$cshowList :: [BlockItem] -> ShowS
showList :: [BlockItem] -> ShowS
Show, Typeable BlockItem
Typeable BlockItem =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BlockItem -> c BlockItem)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BlockItem)
-> (BlockItem -> Constr)
-> (BlockItem -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BlockItem))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockItem))
-> ((forall b. Data b => b -> b) -> BlockItem -> BlockItem)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockItem -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockItem -> r)
-> (forall u. (forall d. Data d => d -> u) -> BlockItem -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BlockItem -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BlockItem -> m BlockItem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockItem -> m BlockItem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockItem -> m BlockItem)
-> Data BlockItem
BlockItem -> Constr
BlockItem -> DataType
(forall b. Data b => b -> b) -> BlockItem -> BlockItem
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) -> BlockItem -> u
forall u. (forall d. Data d => d -> u) -> BlockItem -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockItem -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockItem -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockItem
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockItem -> c BlockItem
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockItem)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockItem)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockItem -> c BlockItem
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockItem -> c BlockItem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockItem
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockItem
$ctoConstr :: BlockItem -> Constr
toConstr :: BlockItem -> Constr
$cdataTypeOf :: BlockItem -> DataType
dataTypeOf :: BlockItem -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockItem)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockItem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockItem)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockItem)
$cgmapT :: (forall b. Data b => b -> b) -> BlockItem -> BlockItem
gmapT :: (forall b. Data b => b -> b) -> BlockItem -> BlockItem
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockItem -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockItem -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockItem -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockItem -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BlockItem -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BlockItem -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockItem -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockItem -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockItem -> m BlockItem
Data, Typeable)

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

-- | The 'String' parameter to 'Const' data constructors is the raw string
-- representation of the constant as it was parsed.
data Const = IntConst         String   Signed Integer !SrcLoc
           | LongIntConst     String   Signed Integer !SrcLoc
           | LongLongIntConst String   Signed Integer !SrcLoc
           | FloatConst       String   Float          !SrcLoc
           | DoubleConst      String   Double         !SrcLoc
           | LongDoubleConst  String   Double         !SrcLoc
           | CharConst        String   Char           !SrcLoc
           | StringConst      [String] String         !SrcLoc

           | AntiConst      String !SrcLoc
           | AntiInt        String !SrcLoc
           | AntiUInt       String !SrcLoc
           | AntiLInt       String !SrcLoc
           | AntiULInt      String !SrcLoc
           | AntiLLInt      String !SrcLoc
           | AntiULLInt     String !SrcLoc
           | AntiFloat      String !SrcLoc
           | AntiDouble     String !SrcLoc
           | AntiLongDouble String !SrcLoc
           | AntiChar       String !SrcLoc
           | AntiString     String !SrcLoc
    deriving (Const -> Const -> Bool
(Const -> Const -> Bool) -> (Const -> Const -> Bool) -> Eq Const
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Const -> Const -> Bool
== :: Const -> Const -> Bool
$c/= :: Const -> Const -> Bool
/= :: Const -> Const -> Bool
Eq, Eq Const
Eq Const =>
(Const -> Const -> Ordering)
-> (Const -> Const -> Bool)
-> (Const -> Const -> Bool)
-> (Const -> Const -> Bool)
-> (Const -> Const -> Bool)
-> (Const -> Const -> Const)
-> (Const -> Const -> Const)
-> Ord Const
Const -> Const -> Bool
Const -> Const -> Ordering
Const -> Const -> Const
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
$ccompare :: Const -> Const -> Ordering
compare :: Const -> Const -> Ordering
$c< :: Const -> Const -> Bool
< :: Const -> Const -> Bool
$c<= :: Const -> Const -> Bool
<= :: Const -> Const -> Bool
$c> :: Const -> Const -> Bool
> :: Const -> Const -> Bool
$c>= :: Const -> Const -> Bool
>= :: Const -> Const -> Bool
$cmax :: Const -> Const -> Const
max :: Const -> Const -> Const
$cmin :: Const -> Const -> Const
min :: Const -> Const -> Const
Ord, Int -> Const -> ShowS
[Const] -> ShowS
Const -> String
(Int -> Const -> ShowS)
-> (Const -> String) -> ([Const] -> ShowS) -> Show Const
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Const -> ShowS
showsPrec :: Int -> Const -> ShowS
$cshow :: Const -> String
show :: Const -> String
$cshowList :: [Const] -> ShowS
showList :: [Const] -> ShowS
Show, Typeable Const
Typeable Const =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Const -> c Const)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Const)
-> (Const -> Constr)
-> (Const -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Const))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const))
-> ((forall b. Data b => b -> b) -> Const -> Const)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r)
-> (forall u. (forall d. Data d => d -> u) -> Const -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Const -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Const -> m Const)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Const -> m Const)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Const -> m Const)
-> Data Const
Const -> Constr
Const -> DataType
(forall b. Data b => b -> b) -> Const -> Const
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) -> Const -> u
forall u. (forall d. Data d => d -> u) -> Const -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Const -> m Const
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Const
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const -> c Const
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Const)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const -> c Const
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const -> c Const
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Const
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Const
$ctoConstr :: Const -> Constr
toConstr :: Const -> Constr
$cdataTypeOf :: Const -> DataType
dataTypeOf :: Const -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Const)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Const)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const)
$cgmapT :: (forall b. Data b => b -> b) -> Const -> Const
gmapT :: (forall b. Data b => b -> b) -> Const -> Const
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Const -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Const -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Const -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Const -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Const -> m Const
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Const -> m Const
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
Data, Typeable)

data Exp = Var Id !SrcLoc
         | Const Const !SrcLoc
         | BinOp BinOp Exp Exp !SrcLoc
         | Assign Exp AssignOp Exp !SrcLoc
         | PreInc Exp !SrcLoc
         | PostInc Exp !SrcLoc
         | PreDec Exp !SrcLoc
         | PostDec Exp !SrcLoc
         | UnOp UnOp Exp !SrcLoc
         | SizeofExp Exp !SrcLoc
         | SizeofType Type !SrcLoc
         | Cast Type Exp !SrcLoc
         | Cond Exp Exp Exp !SrcLoc
         | Member Exp Id !SrcLoc
         | PtrMember Exp Id !SrcLoc
         | Index Exp Exp !SrcLoc
         | FnCall Exp [Exp] !SrcLoc
         | CudaCall Exp ExeConfig [Exp] !SrcLoc
         | Seq Exp Exp !SrcLoc
         | CompoundLit Type [(Maybe Designation, Initializer)] !SrcLoc
         | StmExpr [BlockItem] !SrcLoc
         | EscExp String !SrcLoc
         | AntiEscExp String !SrcLoc
         | AntiExp String !SrcLoc
         | AntiArgs String !SrcLoc

         -- GCC
         | BuiltinVaArg Exp Type !SrcLoc

         -- Clang blocks
         | BlockLit BlockType [Attr] [BlockItem] !SrcLoc

         -- Objective-C
         | ObjCMsg ObjCRecv [ObjCArg] [Exp] !SrcLoc
           -- ^Invariant: First argument must at least have either a selector or an expression;
           --  all other arguments must have an expression.
         | ObjCLitConst (Maybe UnOp)
                        Const        -- Anything except 'StringConst'
                        !SrcLoc
         | ObjCLitString [Const] -- Must all be 'StringConst'
                         !SrcLoc
         | ObjCLitBool Bool !SrcLoc
         | ObjCLitArray [Exp] !SrcLoc
         | ObjCLitDict [ObjCDictElem] !SrcLoc
         | ObjCLitBoxed Exp !SrcLoc
         | ObjCEncode Type !SrcLoc
         | ObjCProtocol Id !SrcLoc
         | ObjCSelector String !SrcLoc

         -- CUDA: C++11 lambda-expression
         | Lambda LambdaIntroducer (Maybe LambdaDeclarator) [BlockItem] !SrcLoc
    deriving (Exp -> Exp -> Bool
(Exp -> Exp -> Bool) -> (Exp -> Exp -> Bool) -> Eq Exp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exp -> Exp -> Bool
== :: Exp -> Exp -> Bool
$c/= :: Exp -> Exp -> Bool
/= :: Exp -> Exp -> Bool
Eq, Eq Exp
Eq Exp =>
(Exp -> Exp -> Ordering)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Exp)
-> (Exp -> Exp -> Exp)
-> Ord Exp
Exp -> Exp -> Bool
Exp -> Exp -> Ordering
Exp -> Exp -> Exp
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
$ccompare :: Exp -> Exp -> Ordering
compare :: Exp -> Exp -> Ordering
$c< :: Exp -> Exp -> Bool
< :: Exp -> Exp -> Bool
$c<= :: Exp -> Exp -> Bool
<= :: Exp -> Exp -> Bool
$c> :: Exp -> Exp -> Bool
> :: Exp -> Exp -> Bool
$c>= :: Exp -> Exp -> Bool
>= :: Exp -> Exp -> Bool
$cmax :: Exp -> Exp -> Exp
max :: Exp -> Exp -> Exp
$cmin :: Exp -> Exp -> Exp
min :: Exp -> Exp -> Exp
Ord, Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> String
(Int -> Exp -> ShowS)
-> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exp -> ShowS
showsPrec :: Int -> Exp -> ShowS
$cshow :: Exp -> String
show :: Exp -> String
$cshowList :: [Exp] -> ShowS
showList :: [Exp] -> ShowS
Show, Typeable Exp
Typeable Exp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Exp -> c Exp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Exp)
-> (Exp -> Constr)
-> (Exp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Exp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exp))
-> ((forall b. Data b => b -> b) -> Exp -> Exp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r)
-> (forall u. (forall d. Data d => d -> u) -> Exp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Exp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Exp -> m Exp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Exp -> m Exp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Exp -> m Exp)
-> Data Exp
Exp -> Constr
Exp -> DataType
(forall b. Data b => b -> b) -> Exp -> Exp
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) -> Exp -> u
forall u. (forall d. Data d => d -> u) -> Exp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exp -> c Exp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exp -> c Exp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exp -> c Exp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exp
$ctoConstr :: Exp -> Constr
toConstr :: Exp -> Constr
$cdataTypeOf :: Exp -> DataType
dataTypeOf :: Exp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exp)
$cgmapT :: (forall b. Data b => b -> b) -> Exp -> Exp
gmapT :: (forall b. Data b => b -> b) -> Exp -> Exp
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Exp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Exp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Exp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Exp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Exp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exp -> m Exp
Data, Typeable)

data BinOp = Add
           | Sub
           | Mul
           | Div
           | Mod
           | Eq
           | Ne
           | Lt
           | Gt
           | Le
           | Ge
           | Land
           | Lor
           | And
           | Or
           | Xor
           | Lsh
           | Rsh
    deriving (BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
/= :: BinOp -> BinOp -> Bool
Eq, Eq BinOp
Eq BinOp =>
(BinOp -> BinOp -> Ordering)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> BinOp)
-> (BinOp -> BinOp -> BinOp)
-> Ord BinOp
BinOp -> BinOp -> Bool
BinOp -> BinOp -> Ordering
BinOp -> BinOp -> BinOp
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
$ccompare :: BinOp -> BinOp -> Ordering
compare :: BinOp -> BinOp -> Ordering
$c< :: BinOp -> BinOp -> Bool
< :: BinOp -> BinOp -> Bool
$c<= :: BinOp -> BinOp -> Bool
<= :: BinOp -> BinOp -> Bool
$c> :: BinOp -> BinOp -> Bool
> :: BinOp -> BinOp -> Bool
$c>= :: BinOp -> BinOp -> Bool
>= :: BinOp -> BinOp -> Bool
$cmax :: BinOp -> BinOp -> BinOp
max :: BinOp -> BinOp -> BinOp
$cmin :: BinOp -> BinOp -> BinOp
min :: BinOp -> BinOp -> BinOp
Ord, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinOp -> ShowS
showsPrec :: Int -> BinOp -> ShowS
$cshow :: BinOp -> String
show :: BinOp -> String
$cshowList :: [BinOp] -> ShowS
showList :: [BinOp] -> ShowS
Show, Typeable BinOp
Typeable BinOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BinOp -> c BinOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BinOp)
-> (BinOp -> Constr)
-> (BinOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BinOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp))
-> ((forall b. Data b => b -> b) -> BinOp -> BinOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> BinOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> Data BinOp
BinOp -> Constr
BinOp -> DataType
(forall b. Data b => b -> b) -> BinOp -> BinOp
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) -> BinOp -> u
forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
$ctoConstr :: BinOp -> Constr
toConstr :: BinOp -> Constr
$cdataTypeOf :: BinOp -> DataType
dataTypeOf :: BinOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
$cgmapT :: (forall b. Data b => b -> b) -> BinOp -> BinOp
gmapT :: (forall b. Data b => b -> b) -> BinOp -> BinOp
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
Data, Typeable)

data AssignOp = JustAssign
              | AddAssign
              | SubAssign
              | MulAssign
              | DivAssign
              | ModAssign
              | LshAssign
              | RshAssign
              | AndAssign
              | XorAssign
              | OrAssign
    deriving (AssignOp -> AssignOp -> Bool
(AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool) -> Eq AssignOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssignOp -> AssignOp -> Bool
== :: AssignOp -> AssignOp -> Bool
$c/= :: AssignOp -> AssignOp -> Bool
/= :: AssignOp -> AssignOp -> Bool
Eq, Eq AssignOp
Eq AssignOp =>
(AssignOp -> AssignOp -> Ordering)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> AssignOp)
-> (AssignOp -> AssignOp -> AssignOp)
-> Ord AssignOp
AssignOp -> AssignOp -> Bool
AssignOp -> AssignOp -> Ordering
AssignOp -> AssignOp -> AssignOp
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
$ccompare :: AssignOp -> AssignOp -> Ordering
compare :: AssignOp -> AssignOp -> Ordering
$c< :: AssignOp -> AssignOp -> Bool
< :: AssignOp -> AssignOp -> Bool
$c<= :: AssignOp -> AssignOp -> Bool
<= :: AssignOp -> AssignOp -> Bool
$c> :: AssignOp -> AssignOp -> Bool
> :: AssignOp -> AssignOp -> Bool
$c>= :: AssignOp -> AssignOp -> Bool
>= :: AssignOp -> AssignOp -> Bool
$cmax :: AssignOp -> AssignOp -> AssignOp
max :: AssignOp -> AssignOp -> AssignOp
$cmin :: AssignOp -> AssignOp -> AssignOp
min :: AssignOp -> AssignOp -> AssignOp
Ord, Int -> AssignOp -> ShowS
[AssignOp] -> ShowS
AssignOp -> String
(Int -> AssignOp -> ShowS)
-> (AssignOp -> String) -> ([AssignOp] -> ShowS) -> Show AssignOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssignOp -> ShowS
showsPrec :: Int -> AssignOp -> ShowS
$cshow :: AssignOp -> String
show :: AssignOp -> String
$cshowList :: [AssignOp] -> ShowS
showList :: [AssignOp] -> ShowS
Show, Typeable AssignOp
Typeable AssignOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AssignOp -> c AssignOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssignOp)
-> (AssignOp -> Constr)
-> (AssignOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssignOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssignOp))
-> ((forall b. Data b => b -> b) -> AssignOp -> AssignOp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssignOp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssignOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> AssignOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> AssignOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AssignOp -> m AssignOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AssignOp -> m AssignOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AssignOp -> m AssignOp)
-> Data AssignOp
AssignOp -> Constr
AssignOp -> DataType
(forall b. Data b => b -> b) -> AssignOp -> AssignOp
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) -> AssignOp -> u
forall u. (forall d. Data d => d -> u) -> AssignOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssignOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp -> c AssignOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssignOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssignOp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp -> c AssignOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp -> c AssignOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssignOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssignOp
$ctoConstr :: AssignOp -> Constr
toConstr :: AssignOp -> Constr
$cdataTypeOf :: AssignOp -> DataType
dataTypeOf :: AssignOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssignOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssignOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssignOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AssignOp)
$cgmapT :: (forall b. Data b => b -> b) -> AssignOp -> AssignOp
gmapT :: (forall b. Data b => b -> b) -> AssignOp -> AssignOp
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AssignOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AssignOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AssignOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AssignOp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AssignOp -> m AssignOp
Data, Typeable)

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

{------------------------------------------------------------------------------
 -
 - GCC extensions
 -
 ------------------------------------------------------------------------------}

type AsmTemplate = StringLit

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

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

type AsmClobber = String

{------------------------------------------------------------------------------
 -
 - Clang blocks
 -
 ------------------------------------------------------------------------------}
data BlockType = BlockVoid !SrcLoc
               | BlockParam [Param] !SrcLoc
               | BlockType Type !SrcLoc
                 -- NB: Type may be something other than 'Proto', in which case clang defaults to
                 --     regard the type as the return type and assume the arguments to be 'void'.
    deriving (BlockType -> BlockType -> Bool
(BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool) -> Eq BlockType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockType -> BlockType -> Bool
== :: BlockType -> BlockType -> Bool
$c/= :: BlockType -> BlockType -> Bool
/= :: BlockType -> BlockType -> Bool
Eq, Eq BlockType
Eq BlockType =>
(BlockType -> BlockType -> Ordering)
-> (BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> BlockType)
-> (BlockType -> BlockType -> BlockType)
-> Ord BlockType
BlockType -> BlockType -> Bool
BlockType -> BlockType -> Ordering
BlockType -> BlockType -> BlockType
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
$ccompare :: BlockType -> BlockType -> Ordering
compare :: BlockType -> BlockType -> Ordering
$c< :: BlockType -> BlockType -> Bool
< :: BlockType -> BlockType -> Bool
$c<= :: BlockType -> BlockType -> Bool
<= :: BlockType -> BlockType -> Bool
$c> :: BlockType -> BlockType -> Bool
> :: BlockType -> BlockType -> Bool
$c>= :: BlockType -> BlockType -> Bool
>= :: BlockType -> BlockType -> Bool
$cmax :: BlockType -> BlockType -> BlockType
max :: BlockType -> BlockType -> BlockType
$cmin :: BlockType -> BlockType -> BlockType
min :: BlockType -> BlockType -> BlockType
Ord, Int -> BlockType -> ShowS
[BlockType] -> ShowS
BlockType -> String
(Int -> BlockType -> ShowS)
-> (BlockType -> String)
-> ([BlockType] -> ShowS)
-> Show BlockType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockType -> ShowS
showsPrec :: Int -> BlockType -> ShowS
$cshow :: BlockType -> String
show :: BlockType -> String
$cshowList :: [BlockType] -> ShowS
showList :: [BlockType] -> ShowS
Show, Typeable BlockType
Typeable BlockType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BlockType -> c BlockType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BlockType)
-> (BlockType -> Constr)
-> (BlockType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BlockType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockType))
-> ((forall b. Data b => b -> b) -> BlockType -> BlockType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BlockType -> r)
-> (forall u. (forall d. Data d => d -> u) -> BlockType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BlockType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BlockType -> m BlockType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockType -> m BlockType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BlockType -> m BlockType)
-> Data BlockType
BlockType -> Constr
BlockType -> DataType
(forall b. Data b => b -> b) -> BlockType -> BlockType
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) -> BlockType -> u
forall u. (forall d. Data d => d -> u) -> BlockType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockType -> c BlockType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockType -> c BlockType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BlockType -> c BlockType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BlockType
$ctoConstr :: BlockType -> Constr
toConstr :: BlockType -> Constr
$cdataTypeOf :: BlockType -> DataType
dataTypeOf :: BlockType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BlockType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BlockType)
$cgmapT :: (forall b. Data b => b -> b) -> BlockType -> BlockType
gmapT :: (forall b. Data b => b -> b) -> BlockType -> BlockType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BlockType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BlockType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BlockType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BlockType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BlockType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BlockType -> m BlockType
Data, Typeable)

{------------------------------------------------------------------------------
 -
 - Objective-C
 -
 ------------------------------------------------------------------------------}

data ObjCIvarDecl = ObjCIvarVisi ObjCVisibilitySpec !SrcLoc
                  | ObjCIvarDecl FieldGroup !SrcLoc
                  -- -=chak FIXME: needs ANTI forms
    deriving (ObjCIvarDecl -> ObjCIvarDecl -> Bool
(ObjCIvarDecl -> ObjCIvarDecl -> Bool)
-> (ObjCIvarDecl -> ObjCIvarDecl -> Bool) -> Eq ObjCIvarDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
== :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
$c/= :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
/= :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
Eq, Eq ObjCIvarDecl
Eq ObjCIvarDecl =>
(ObjCIvarDecl -> ObjCIvarDecl -> Ordering)
-> (ObjCIvarDecl -> ObjCIvarDecl -> Bool)
-> (ObjCIvarDecl -> ObjCIvarDecl -> Bool)
-> (ObjCIvarDecl -> ObjCIvarDecl -> Bool)
-> (ObjCIvarDecl -> ObjCIvarDecl -> Bool)
-> (ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl)
-> (ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl)
-> Ord ObjCIvarDecl
ObjCIvarDecl -> ObjCIvarDecl -> Bool
ObjCIvarDecl -> ObjCIvarDecl -> Ordering
ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl
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
$ccompare :: ObjCIvarDecl -> ObjCIvarDecl -> Ordering
compare :: ObjCIvarDecl -> ObjCIvarDecl -> Ordering
$c< :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
< :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
$c<= :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
<= :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
$c> :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
> :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
$c>= :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
>= :: ObjCIvarDecl -> ObjCIvarDecl -> Bool
$cmax :: ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl
max :: ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl
$cmin :: ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl
min :: ObjCIvarDecl -> ObjCIvarDecl -> ObjCIvarDecl
Ord, Int -> ObjCIvarDecl -> ShowS
[ObjCIvarDecl] -> ShowS
ObjCIvarDecl -> String
(Int -> ObjCIvarDecl -> ShowS)
-> (ObjCIvarDecl -> String)
-> ([ObjCIvarDecl] -> ShowS)
-> Show ObjCIvarDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjCIvarDecl -> ShowS
showsPrec :: Int -> ObjCIvarDecl -> ShowS
$cshow :: ObjCIvarDecl -> String
show :: ObjCIvarDecl -> String
$cshowList :: [ObjCIvarDecl] -> ShowS
showList :: [ObjCIvarDecl] -> ShowS
Show, Typeable ObjCIvarDecl
Typeable ObjCIvarDecl =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ObjCIvarDecl -> c ObjCIvarDecl)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ObjCIvarDecl)
-> (ObjCIvarDecl -> Constr)
-> (ObjCIvarDecl -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ObjCIvarDecl))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ObjCIvarDecl))
-> ((forall b. Data b => b -> b) -> ObjCIvarDecl -> ObjCIvarDecl)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r)
-> (forall u. (forall d. Data d => d -> u) -> ObjCIvarDecl -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ObjCIvarDecl -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl)
-> Data ObjCIvarDecl
ObjCIvarDecl -> Constr
ObjCIvarDecl -> DataType
(forall b. Data b => b -> b) -> ObjCIvarDecl -> ObjCIvarDecl
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) -> ObjCIvarDecl -> u
forall u. (forall d. Data d => d -> u) -> ObjCIvarDecl -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCIvarDecl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCIvarDecl -> c ObjCIvarDecl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCIvarDecl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCIvarDecl)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCIvarDecl -> c ObjCIvarDecl
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCIvarDecl -> c ObjCIvarDecl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCIvarDecl
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCIvarDecl
$ctoConstr :: ObjCIvarDecl -> Constr
toConstr :: ObjCIvarDecl -> Constr
$cdataTypeOf :: ObjCIvarDecl -> DataType
dataTypeOf :: ObjCIvarDecl -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCIvarDecl)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCIvarDecl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCIvarDecl)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCIvarDecl)
$cgmapT :: (forall b. Data b => b -> b) -> ObjCIvarDecl -> ObjCIvarDecl
gmapT :: (forall b. Data b => b -> b) -> ObjCIvarDecl -> ObjCIvarDecl
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIvarDecl -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCIvarDecl -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCIvarDecl -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ObjCIvarDecl -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ObjCIvarDecl -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIvarDecl -> m ObjCIvarDecl
Data, Typeable)

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

data ObjCIfaceDecl = ObjCIfaceProp [ObjCPropAttr] FieldGroup !SrcLoc
                   | ObjCIfaceReq ObjCMethodReq !SrcLoc
                   | ObjCIfaceMeth ObjCMethodProto !SrcLoc
                   | ObjCIfaceDecl InitGroup !SrcLoc

                   | AntiObjCProp       String !SrcLoc
                   | AntiObjCProps      String !SrcLoc
                   | AntiObjCIfaceDecl  String !SrcLoc
                   | AntiObjCIfaceDecls String !SrcLoc
    deriving (ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
(ObjCIfaceDecl -> ObjCIfaceDecl -> Bool)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> Bool) -> Eq ObjCIfaceDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
== :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
$c/= :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
/= :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
Eq, Eq ObjCIfaceDecl
Eq ObjCIfaceDecl =>
(ObjCIfaceDecl -> ObjCIfaceDecl -> Ordering)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> Bool)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> Bool)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> Bool)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> Bool)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl)
-> (ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl)
-> Ord ObjCIfaceDecl
ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
ObjCIfaceDecl -> ObjCIfaceDecl -> Ordering
ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl
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
$ccompare :: ObjCIfaceDecl -> ObjCIfaceDecl -> Ordering
compare :: ObjCIfaceDecl -> ObjCIfaceDecl -> Ordering
$c< :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
< :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
$c<= :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
<= :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
$c> :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
> :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
$c>= :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
>= :: ObjCIfaceDecl -> ObjCIfaceDecl -> Bool
$cmax :: ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl
max :: ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl
$cmin :: ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl
min :: ObjCIfaceDecl -> ObjCIfaceDecl -> ObjCIfaceDecl
Ord, Int -> ObjCIfaceDecl -> ShowS
[ObjCIfaceDecl] -> ShowS
ObjCIfaceDecl -> String
(Int -> ObjCIfaceDecl -> ShowS)
-> (ObjCIfaceDecl -> String)
-> ([ObjCIfaceDecl] -> ShowS)
-> Show ObjCIfaceDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjCIfaceDecl -> ShowS
showsPrec :: Int -> ObjCIfaceDecl -> ShowS
$cshow :: ObjCIfaceDecl -> String
show :: ObjCIfaceDecl -> String
$cshowList :: [ObjCIfaceDecl] -> ShowS
showList :: [ObjCIfaceDecl] -> ShowS
Show, Typeable ObjCIfaceDecl
Typeable ObjCIfaceDecl =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ObjCIfaceDecl -> c ObjCIfaceDecl)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ObjCIfaceDecl)
-> (ObjCIfaceDecl -> Constr)
-> (ObjCIfaceDecl -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ObjCIfaceDecl))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ObjCIfaceDecl))
-> ((forall b. Data b => b -> b) -> ObjCIfaceDecl -> ObjCIfaceDecl)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r)
-> (forall u. (forall d. Data d => d -> u) -> ObjCIfaceDecl -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ObjCIfaceDecl -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl)
-> Data ObjCIfaceDecl
ObjCIfaceDecl -> Constr
ObjCIfaceDecl -> DataType
(forall b. Data b => b -> b) -> ObjCIfaceDecl -> ObjCIfaceDecl
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) -> ObjCIfaceDecl -> u
forall u. (forall d. Data d => d -> u) -> ObjCIfaceDecl -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCIfaceDecl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCIfaceDecl -> c ObjCIfaceDecl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCIfaceDecl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCIfaceDecl)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCIfaceDecl -> c ObjCIfaceDecl
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCIfaceDecl -> c ObjCIfaceDecl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCIfaceDecl
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCIfaceDecl
$ctoConstr :: ObjCIfaceDecl -> Constr
toConstr :: ObjCIfaceDecl -> Constr
$cdataTypeOf :: ObjCIfaceDecl -> DataType
dataTypeOf :: ObjCIfaceDecl -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCIfaceDecl)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCIfaceDecl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCIfaceDecl)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCIfaceDecl)
$cgmapT :: (forall b. Data b => b -> b) -> ObjCIfaceDecl -> ObjCIfaceDecl
gmapT :: (forall b. Data b => b -> b) -> ObjCIfaceDecl -> ObjCIfaceDecl
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCIfaceDecl -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCIfaceDecl -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCIfaceDecl -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ObjCIfaceDecl -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ObjCIfaceDecl -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCIfaceDecl -> m ObjCIfaceDecl
Data, Typeable)

data ObjCPropAttr = ObjCGetter Id !SrcLoc
                  | ObjCSetter Id !SrcLoc
                  | ObjCReadonly !SrcLoc
                  | ObjCReadwrite !SrcLoc
                  | ObjCAssign !SrcLoc
                  | ObjCRetain !SrcLoc
                  | ObjCCopy !SrcLoc
                  | ObjCNonatomic !SrcLoc
                  | ObjCAtomic !SrcLoc
                  | ObjCStrong !SrcLoc
                  | ObjCWeak !SrcLoc
                  | ObjCUnsafeUnretained !SrcLoc

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

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

data ObjCParam = ObjCParam (Maybe Id) (Maybe Type) [Attr] (Maybe Id) !SrcLoc
               | AntiObjCParam  String !SrcLoc
               | AntiObjCParams String !SrcLoc
    deriving (ObjCParam -> ObjCParam -> Bool
(ObjCParam -> ObjCParam -> Bool)
-> (ObjCParam -> ObjCParam -> Bool) -> Eq ObjCParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjCParam -> ObjCParam -> Bool
== :: ObjCParam -> ObjCParam -> Bool
$c/= :: ObjCParam -> ObjCParam -> Bool
/= :: ObjCParam -> ObjCParam -> Bool
Eq, Eq ObjCParam
Eq ObjCParam =>
(ObjCParam -> ObjCParam -> Ordering)
-> (ObjCParam -> ObjCParam -> Bool)
-> (ObjCParam -> ObjCParam -> Bool)
-> (ObjCParam -> ObjCParam -> Bool)
-> (ObjCParam -> ObjCParam -> Bool)
-> (ObjCParam -> ObjCParam -> ObjCParam)
-> (ObjCParam -> ObjCParam -> ObjCParam)
-> Ord ObjCParam
ObjCParam -> ObjCParam -> Bool
ObjCParam -> ObjCParam -> Ordering
ObjCParam -> ObjCParam -> ObjCParam
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
$ccompare :: ObjCParam -> ObjCParam -> Ordering
compare :: ObjCParam -> ObjCParam -> Ordering
$c< :: ObjCParam -> ObjCParam -> Bool
< :: ObjCParam -> ObjCParam -> Bool
$c<= :: ObjCParam -> ObjCParam -> Bool
<= :: ObjCParam -> ObjCParam -> Bool
$c> :: ObjCParam -> ObjCParam -> Bool
> :: ObjCParam -> ObjCParam -> Bool
$c>= :: ObjCParam -> ObjCParam -> Bool
>= :: ObjCParam -> ObjCParam -> Bool
$cmax :: ObjCParam -> ObjCParam -> ObjCParam
max :: ObjCParam -> ObjCParam -> ObjCParam
$cmin :: ObjCParam -> ObjCParam -> ObjCParam
min :: ObjCParam -> ObjCParam -> ObjCParam
Ord, Int -> ObjCParam -> ShowS
[ObjCParam] -> ShowS
ObjCParam -> String
(Int -> ObjCParam -> ShowS)
-> (ObjCParam -> String)
-> ([ObjCParam] -> ShowS)
-> Show ObjCParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjCParam -> ShowS
showsPrec :: Int -> ObjCParam -> ShowS
$cshow :: ObjCParam -> String
show :: ObjCParam -> String
$cshowList :: [ObjCParam] -> ShowS
showList :: [ObjCParam] -> ShowS
Show, Typeable ObjCParam
Typeable ObjCParam =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ObjCParam -> c ObjCParam)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ObjCParam)
-> (ObjCParam -> Constr)
-> (ObjCParam -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ObjCParam))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ObjCParam))
-> ((forall b. Data b => b -> b) -> ObjCParam -> ObjCParam)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCParam -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCParam -> r)
-> (forall u. (forall d. Data d => d -> u) -> ObjCParam -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ObjCParam -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam)
-> Data ObjCParam
ObjCParam -> Constr
ObjCParam -> DataType
(forall b. Data b => b -> b) -> ObjCParam -> ObjCParam
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) -> ObjCParam -> u
forall u. (forall d. Data d => d -> u) -> ObjCParam -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCParam -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCParam -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCParam
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCParam -> c ObjCParam
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCParam)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ObjCParam)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCParam -> c ObjCParam
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCParam -> c ObjCParam
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCParam
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCParam
$ctoConstr :: ObjCParam -> Constr
toConstr :: ObjCParam -> Constr
$cdataTypeOf :: ObjCParam -> DataType
dataTypeOf :: ObjCParam -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCParam)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCParam)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ObjCParam)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ObjCParam)
$cgmapT :: (forall b. Data b => b -> b) -> ObjCParam -> ObjCParam
gmapT :: (forall b. Data b => b -> b) -> ObjCParam -> ObjCParam
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCParam -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCParam -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCParam -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCParam -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCParam -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCParam -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ObjCParam -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ObjCParam -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ObjCParam -> m ObjCParam
Data, Typeable)

data ObjCMethodProto = ObjCMethodProto Bool (Maybe Type) [Attr] [ObjCParam] Bool [Attr] !SrcLoc
                       -- ^Invariant: First parameter must at least either have a selector or
                       --  an identifier; all other parameters must have an identifier.
                     | AntiObjCMethodProto String !SrcLoc
    deriving (ObjCMethodProto -> ObjCMethodProto -> Bool
(ObjCMethodProto -> ObjCMethodProto -> Bool)
-> (ObjCMethodProto -> ObjCMethodProto -> Bool)
-> Eq ObjCMethodProto
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjCMethodProto -> ObjCMethodProto -> Bool
== :: ObjCMethodProto -> ObjCMethodProto -> Bool
$c/= :: ObjCMethodProto -> ObjCMethodProto -> Bool
/= :: ObjCMethodProto -> ObjCMethodProto -> Bool
Eq, Eq ObjCMethodProto
Eq ObjCMethodProto =>
(ObjCMethodProto -> ObjCMethodProto -> Ordering)
-> (ObjCMethodProto -> ObjCMethodProto -> Bool)
-> (ObjCMethodProto -> ObjCMethodProto -> Bool)
-> (ObjCMethodProto -> ObjCMethodProto -> Bool)
-> (ObjCMethodProto -> ObjCMethodProto -> Bool)
-> (ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto)
-> (ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto)
-> Ord ObjCMethodProto
ObjCMethodProto -> ObjCMethodProto -> Bool
ObjCMethodProto -> ObjCMethodProto -> Ordering
ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto
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
$ccompare :: ObjCMethodProto -> ObjCMethodProto -> Ordering
compare :: ObjCMethodProto -> ObjCMethodProto -> Ordering
$c< :: ObjCMethodProto -> ObjCMethodProto -> Bool
< :: ObjCMethodProto -> ObjCMethodProto -> Bool
$c<= :: ObjCMethodProto -> ObjCMethodProto -> Bool
<= :: ObjCMethodProto -> ObjCMethodProto -> Bool
$c> :: ObjCMethodProto -> ObjCMethodProto -> Bool
> :: ObjCMethodProto -> ObjCMethodProto -> Bool
$c>= :: ObjCMethodProto -> ObjCMethodProto -> Bool
>= :: ObjCMethodProto -> ObjCMethodProto -> Bool
$cmax :: ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto
max :: ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto
$cmin :: ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto
min :: ObjCMethodProto -> ObjCMethodProto -> ObjCMethodProto
Ord, Int -> ObjCMethodProto -> ShowS
[ObjCMethodProto] -> ShowS
ObjCMethodProto -> String
(Int -> ObjCMethodProto -> ShowS)
-> (ObjCMethodProto -> String)
-> ([ObjCMethodProto] -> ShowS)
-> Show ObjCMethodProto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjCMethodProto -> ShowS
showsPrec :: Int -> ObjCMethodProto -> ShowS
$cshow :: ObjCMethodProto -> String
show :: ObjCMethodProto -> String
$cshowList :: [ObjCMethodProto] -> ShowS
showList :: [ObjCMethodProto] -> ShowS
Show, Typeable ObjCMethodProto
Typeable ObjCMethodProto =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ObjCMethodProto -> c ObjCMethodProto)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ObjCMethodProto)
-> (ObjCMethodProto -> Constr)
-> (ObjCMethodProto -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ObjCMethodProto))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ObjCMethodProto))
-> ((forall b. Data b => b -> b)
    -> ObjCMethodProto -> ObjCMethodProto)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ObjCMethodProto -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ObjCMethodProto -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ObjCMethodProto -> m ObjCMethodProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ObjCMethodProto -> m ObjCMethodProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ObjCMethodProto -> m ObjCMethodProto)
-> Data ObjCMethodProto
ObjCMethodProto -> Constr
ObjCMethodProto -> DataType
(forall b. Data b => b -> b) -> ObjCMethodProto -> ObjCMethodProto
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) -> ObjCMethodProto -> u
forall u. (forall d. Data d => d -> u) -> ObjCMethodProto -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCMethodProto
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCMethodProto -> c ObjCMethodProto
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCMethodProto)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCMethodProto)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCMethodProto -> c ObjCMethodProto
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ObjCMethodProto -> c ObjCMethodProto
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCMethodProto
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ObjCMethodProto
$ctoConstr :: ObjCMethodProto -> Constr
toConstr :: ObjCMethodProto -> Constr
$cdataTypeOf :: ObjCMethodProto -> DataType
dataTypeOf :: ObjCMethodProto -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCMethodProto)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ObjCMethodProto)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCMethodProto)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ObjCMethodProto)
$cgmapT :: (forall b. Data b => b -> b) -> ObjCMethodProto -> ObjCMethodProto
gmapT :: (forall b. Data b => b -> b) -> ObjCMethodProto -> ObjCMethodProto
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ObjCMethodProto -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCMethodProto -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ObjCMethodProto -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ObjCMethodProto -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ObjCMethodProto -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ObjCMethodProto -> m ObjCMethodProto
Data, Typeable)

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

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

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

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

{------------------------------------------------------------------------------
 -
 - CUDA
 -
 ------------------------------------------------------------------------------}

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

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

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

data ExeConfig = ExeConfig
    {  ExeConfig -> Exp
exeGridDim    :: Exp
    ,  ExeConfig -> Exp
exeBlockDim   :: Exp
    ,  ExeConfig -> Maybe Exp
exeSharedSize :: Maybe Exp
    ,  ExeConfig -> Maybe Exp
exeStream     :: Maybe Exp
    ,  ExeConfig -> SrcLoc
exeLoc        :: !SrcLoc
    }
    deriving (ExeConfig -> ExeConfig -> Bool
(ExeConfig -> ExeConfig -> Bool)
-> (ExeConfig -> ExeConfig -> Bool) -> Eq ExeConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExeConfig -> ExeConfig -> Bool
== :: ExeConfig -> ExeConfig -> Bool
$c/= :: ExeConfig -> ExeConfig -> Bool
/= :: ExeConfig -> ExeConfig -> Bool
Eq, Eq ExeConfig
Eq ExeConfig =>
(ExeConfig -> ExeConfig -> Ordering)
-> (ExeConfig -> ExeConfig -> Bool)
-> (ExeConfig -> ExeConfig -> Bool)
-> (ExeConfig -> ExeConfig -> Bool)
-> (ExeConfig -> ExeConfig -> Bool)
-> (ExeConfig -> ExeConfig -> ExeConfig)
-> (ExeConfig -> ExeConfig -> ExeConfig)
-> Ord ExeConfig
ExeConfig -> ExeConfig -> Bool
ExeConfig -> ExeConfig -> Ordering
ExeConfig -> ExeConfig -> ExeConfig
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
$ccompare :: ExeConfig -> ExeConfig -> Ordering
compare :: ExeConfig -> ExeConfig -> Ordering
$c< :: ExeConfig -> ExeConfig -> Bool
< :: ExeConfig -> ExeConfig -> Bool
$c<= :: ExeConfig -> ExeConfig -> Bool
<= :: ExeConfig -> ExeConfig -> Bool
$c> :: ExeConfig -> ExeConfig -> Bool
> :: ExeConfig -> ExeConfig -> Bool
$c>= :: ExeConfig -> ExeConfig -> Bool
>= :: ExeConfig -> ExeConfig -> Bool
$cmax :: ExeConfig -> ExeConfig -> ExeConfig
max :: ExeConfig -> ExeConfig -> ExeConfig
$cmin :: ExeConfig -> ExeConfig -> ExeConfig
min :: ExeConfig -> ExeConfig -> ExeConfig
Ord, Int -> ExeConfig -> ShowS
[ExeConfig] -> ShowS
ExeConfig -> String
(Int -> ExeConfig -> ShowS)
-> (ExeConfig -> String)
-> ([ExeConfig] -> ShowS)
-> Show ExeConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExeConfig -> ShowS
showsPrec :: Int -> ExeConfig -> ShowS
$cshow :: ExeConfig -> String
show :: ExeConfig -> String
$cshowList :: [ExeConfig] -> ShowS
showList :: [ExeConfig] -> ShowS
Show, Typeable ExeConfig
Typeable ExeConfig =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ExeConfig -> c ExeConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExeConfig)
-> (ExeConfig -> Constr)
-> (ExeConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExeConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeConfig))
-> ((forall b. Data b => b -> b) -> ExeConfig -> ExeConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExeConfig -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExeConfig -> r)
-> (forall u. (forall d. Data d => d -> u) -> ExeConfig -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExeConfig -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig)
-> Data ExeConfig
ExeConfig -> Constr
ExeConfig -> DataType
(forall b. Data b => b -> b) -> ExeConfig -> ExeConfig
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) -> ExeConfig -> u
forall u. (forall d. Data d => d -> u) -> ExeConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeConfig -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeConfig -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeConfig -> c ExeConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeConfig)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeConfig -> c ExeConfig
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeConfig -> c ExeConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeConfig
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeConfig
$ctoConstr :: ExeConfig -> Constr
toConstr :: ExeConfig -> Constr
$cdataTypeOf :: ExeConfig -> DataType
dataTypeOf :: ExeConfig -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeConfig)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeConfig)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeConfig)
$cgmapT :: (forall b. Data b => b -> b) -> ExeConfig -> ExeConfig
gmapT :: (forall b. Data b => b -> b) -> ExeConfig -> ExeConfig
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeConfig -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeConfig -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeConfig -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeConfig -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExeConfig -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExeConfig -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExeConfig -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExeConfig -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeConfig -> m ExeConfig
Data, Typeable)

{------------------------------------------------------------------------------
 -
 - Instances
 -
 ------------------------------------------------------------------------------}

instance IsString Id where
    fromString :: String -> Id
fromString String
s = String -> SrcLoc -> Id
Id String
s SrcLoc
forall a. IsLocation a => a
noLoc

instance IsString StringLit where
    fromString :: String -> StringLit
fromString String
s = [String] -> String -> SrcLoc -> StringLit
StringLit [String
s] String
s SrcLoc
forall a. IsLocation a => a
noLoc

#if !defined(ONLY_TYPEDEFS)
#include "Language/C/Syntax-instances.hs"

{------------------------------------------------------------------------------
 -
 - Utilities
 -
 ------------------------------------------------------------------------------}

funcProto :: Func -> InitGroup
funcProto :: Func -> InitGroup
funcProto f :: Func
f@(Func DeclSpec
decl_spec Id
ident Decl
decl Params
params [BlockItem]
_ SrcLoc
_) =
    DeclSpec -> [Attr] -> [Init] -> SrcLoc -> InitGroup
InitGroup DeclSpec
decl_spec []
      [Id
-> Decl
-> Maybe StringLit
-> Maybe Initializer
-> [Attr]
-> SrcLoc
-> Init
Init Id
ident (Decl -> Params -> SrcLoc -> Decl
Proto Decl
decl Params
params SrcLoc
l) Maybe StringLit
forall a. Maybe a
Nothing Maybe Initializer
forall a. Maybe a
Nothing [] SrcLoc
l] SrcLoc
l
  where
    l :: SrcLoc
l = Func -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf Func
f

funcProto f :: Func
f@(OldFunc DeclSpec
decl_spec Id
ident Decl
decl [Id]
params Maybe [InitGroup]
_ [BlockItem]
_ SrcLoc
_) =
    DeclSpec -> [Attr] -> [Init] -> SrcLoc -> InitGroup
InitGroup DeclSpec
decl_spec []
      [Id
-> Decl
-> Maybe StringLit
-> Maybe Initializer
-> [Attr]
-> SrcLoc
-> Init
Init Id
ident (Decl -> [Id] -> SrcLoc -> Decl
OldProto Decl
decl [Id]
params SrcLoc
l) Maybe StringLit
forall a. Maybe a
Nothing Maybe Initializer
forall a. Maybe a
Nothing [] SrcLoc
l] SrcLoc
l
  where
    l :: SrcLoc
l = Func -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf Func
f

isPtr :: Type -> Bool
isPtr :: Type -> Bool
isPtr  (Type DeclSpec
_ Decl
decl SrcLoc
_)  = Decl -> Bool
go Decl
decl
  where
    go :: Decl -> Bool
go  (DeclRoot SrcLoc
_)        = Bool
False
    go  (Ptr [TypeQual]
_ Decl
_ SrcLoc
_)         = Bool
True
    go  (BlockPtr [TypeQual]
_ Decl
_ SrcLoc
_)    = Bool
True
    go  (Array [TypeQual]
_ ArraySize
_ Decl
_ SrcLoc
_)     = Bool
True
    go  (Proto Decl
_ Params
_ SrcLoc
_)       = Bool
False
    go  (OldProto Decl
_ [Id]
_ SrcLoc
_)    = Bool
False
    go  (AntiTypeDecl String
_ SrcLoc
_)  = String -> Bool
forall a. HasCallStack => String -> a
error String
"isPtr: encountered antiquoted type declaration"
isPtr  (AntiType String
_ SrcLoc
_)       = String -> Bool
forall a. HasCallStack => String -> a
error String
"isPtr: encountered antiquoted type"

ctypedef :: Id -> Decl -> [Attr] -> Typedef
ctypedef :: Id -> Decl -> [Attr] -> Typedef
ctypedef Id
ident Decl
decl [Attr]
attrs =
    Id -> Decl -> [Attr] -> SrcLoc -> Typedef
Typedef Id
ident Decl
decl [Attr]
attrs (Id
ident Id -> Decl -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` Decl
decl SrcLoc -> [Attr] -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` [Attr]
attrs)

cdeclSpec :: [Storage] -> [TypeQual] -> TypeSpec -> DeclSpec
cdeclSpec :: [Storage] -> [TypeQual] -> TypeSpec -> DeclSpec
cdeclSpec [Storage]
storage [TypeQual]
quals TypeSpec
spec =
    [Storage] -> [TypeQual] -> TypeSpec -> SrcLoc -> DeclSpec
DeclSpec [Storage]
storage [TypeQual]
quals TypeSpec
spec ([Storage]
storage [Storage] -> [TypeQual] -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` [TypeQual]
quals SrcLoc -> TypeSpec -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` TypeSpec
spec)

cinitGroup :: DeclSpec -> [Attr] -> [Init] -> InitGroup
cinitGroup :: DeclSpec -> [Attr] -> [Init] -> InitGroup
cinitGroup DeclSpec
dspec [Attr]
attrs [Init]
inis =
    DeclSpec -> [Attr] -> [Init] -> SrcLoc -> InitGroup
InitGroup DeclSpec
dspec [Attr]
attrs [Init]
inis (DeclSpec
dspec DeclSpec -> [Attr] -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` [Attr]
attrs SrcLoc -> [Init] -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` [Init]
inis)

ctypedefGroup :: DeclSpec -> [Attr] -> [Typedef] -> InitGroup
ctypedefGroup :: DeclSpec -> [Attr] -> [Typedef] -> InitGroup
ctypedefGroup DeclSpec
dspec [Attr]
attrs [Typedef]
typedefs =
    DeclSpec -> [Attr] -> [Typedef] -> SrcLoc -> InitGroup
TypedefGroup DeclSpec
dspec [Attr]
attrs [Typedef]
typedefs (DeclSpec
dspec DeclSpec -> [Attr] -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` [Attr]
attrs SrcLoc -> [Typedef] -> SrcLoc
forall a b. (Located a, Located b) => a -> b -> SrcLoc
`srcspan` [Typedef]
typedefs)
#endif /* !defined(ONLY_TYPEDEFS) */