module Language.C.Syntax where
import Data.Generics
import Data.Loc
data Extensions = Antiquotation
| Gcc
| CUDA
| OpenCL
deriving (Eq, Ord, Enum, Show)
data Id = Id String !SrcLoc
| AntiId String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Storage = Tauto !SrcLoc
| Tregister !SrcLoc
| Tstatic !SrcLoc
| Textern !SrcLoc
| TexternL String !SrcLoc
| Ttypedef !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data TypeQual = Tconst !SrcLoc
| Tvolatile !SrcLoc
| Tinline !SrcLoc
| Trestrict !SrcLoc
| TCUDAdevice !SrcLoc
| TCUDAglobal !SrcLoc
| TCUDAhost !SrcLoc
| TCUDAconstant !SrcLoc
| TCUDAshared !SrcLoc
| TCUDAnoinline !SrcLoc
| TCLprivate !SrcLoc
| TCLlocal !SrcLoc
| TCLglobal !SrcLoc
| TCLconstant !SrcLoc
| TCLreadonly !SrcLoc
| TCLwriteonly !SrcLoc
| TCLkernel !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Sign = Tsigned !SrcLoc
| Tunsigned !SrcLoc
deriving (Eq, Ord, 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 !SrcLoc
| TtypeofExp Exp !SrcLoc
| TtypeofType Type !SrcLoc
| Tva_list !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data DeclSpec = DeclSpec [Storage] [TypeQual] TypeSpec !SrcLoc
| AntiDeclSpec String !SrcLoc
| AntiTypeDeclSpec [Storage] [TypeQual] String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data ArraySize = ArraySize Bool Exp !SrcLoc
| VariableArraySize !SrcLoc
| NoArraySize !SrcLoc
deriving (Eq, Ord, 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
deriving (Eq, Ord, Data, Typeable)
data Type = Type DeclSpec Decl !SrcLoc
| AntiType String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Designator = IndexDesignator Exp !SrcLoc
| MemberDesignator Id !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Designation = Designation [Designator] !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Initializer = ExpInitializer Exp !SrcLoc
| CompoundInitializer [(Maybe Designation, Initializer)] !SrcLoc
deriving (Eq, Ord, Data, Typeable)
type AsmLabel = String
data Init = Init Id Decl (Maybe AsmLabel) (Maybe Initializer) [Attr] !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Typedef = Typedef Id Decl [Attr] !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data InitGroup = InitGroup DeclSpec [Attr] [Init] !SrcLoc
| TypedefGroup DeclSpec [Attr] [Typedef] !SrcLoc
| AntiDecl String !SrcLoc
| AntiDecls String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Field = Field (Maybe Id) (Maybe Decl) (Maybe Exp) !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data FieldGroup = FieldGroup DeclSpec [Field] !SrcLoc
| AntiSdecl String !SrcLoc
| AntiSdecls String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data CEnum = CEnum Id (Maybe Exp) !SrcLoc
| AntiEnum String !SrcLoc
| AntiEnums String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Attr = Attr Id [Exp] !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Param = Param (Maybe Id) DeclSpec Decl !SrcLoc
| AntiParam String !SrcLoc
| AntiParams String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Params = Params [Param] Bool !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data Func = Func DeclSpec Id Decl Params [BlockItem] !SrcLoc
| OldFunc DeclSpec Id Decl [Id] (Maybe [InitGroup]) [BlockItem] !SrcLoc
deriving (Eq, Ord, 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
deriving (Eq, Ord, Data, Typeable)
data Stm = Label Id Stm !SrcLoc
| Case 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
| Asm Bool [Attr] [String] [(String, Exp)] [(String, Exp)] [String] !SrcLoc
| AntiStm String !SrcLoc
| AntiStms String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data BlockItem = BlockDecl InitGroup
| BlockStm Stm
| AntiBlockItem String !SrcLoc
| AntiBlockItems String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
funcProto :: Func -> InitGroup
funcProto f@(Func decl_spec id decl params _ _) =
InitGroup decl_spec [] [Init id (Proto decl params loc) Nothing Nothing [] loc] loc
where
loc = locOf f
funcProto f@(OldFunc decl_spec id decl params _ _ _) =
InitGroup decl_spec [] [Init id (OldProto decl params loc) Nothing Nothing [] loc]
loc
where
loc = locOf f
isPtr :: Type -> Bool
isPtr (Type _ decl _) = go decl
where
go (DeclRoot _) = False
go (Ptr _ _ _) = True
go (Array _ _ _ _) = True
go (Proto _ _ _) = False
go (OldProto _ _ _) = False
go (AntiTypeDecl _ _) = error "isPtr: encountered antiquoted type declaration"
isPtr (AntiType _ _) = error "isPtr: encountered antiquoted type"
data Signed = Signed
| Unsigned
deriving (Eq, Ord, Data, Typeable)
data Const = IntConst String Signed Integer !SrcLoc
| LongIntConst String Signed Integer !SrcLoc
| LongLongIntConst String Signed Integer !SrcLoc
| FloatConst String Rational !SrcLoc
| DoubleConst String Rational !SrcLoc
| LongDoubleConst String Rational !SrcLoc
| CharConst String Char !SrcLoc
| StringConst [String] String !SrcLoc
| AntiInt String !SrcLoc
| AntiUInt String !SrcLoc
| AntiLInt String !SrcLoc
| AntiULInt String !SrcLoc
| AntiFloat String !SrcLoc
| AntiDouble String !SrcLoc
| AntiLongDouble String !SrcLoc
| AntiChar String !SrcLoc
| AntiString String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data ExeConfig = ExeConfig
{ exeGridDim :: Exp
, exeBlockDim :: Exp
, exeSharedSize :: Maybe Exp
, exeStream :: Maybe Exp
, exeLoc :: !SrcLoc
}
deriving (Eq, Ord, 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
| BuiltinVaArg Exp Type !SrcLoc
| AntiExp String !SrcLoc
| AntiArgs String !SrcLoc
deriving (Eq, Ord, Data, Typeable)
data BinOp = Add
| Sub
| Mul
| Div
| Mod
| Eq
| Ne
| Lt
| Gt
| Le
| Ge
| Land
| Lor
| And
| Or
| Xor
| Lsh
| Rsh
deriving (Eq, Ord, Data, Typeable)
data AssignOp = JustAssign
| AddAssign
| SubAssign
| MulAssign
| DivAssign
| ModAssign
| LshAssign
| RshAssign
| AndAssign
| XorAssign
| OrAssign
deriving (Eq, Ord, Data, Typeable)
data UnOp = AddrOf
| Deref
| Positive
| Negate
| Not
| Lnot
deriving (Eq, Ord, Data, Typeable)
instance Located Id where
getLoc (Id _ loc) = getLoc loc
getLoc (AntiId _ loc) = getLoc loc
instance Located Storage where
getLoc (Tauto loc) = getLoc loc
getLoc (Tregister loc) = getLoc loc
getLoc (Tstatic loc) = getLoc loc
getLoc (Textern loc) = getLoc loc
getLoc (TexternL _ loc) = getLoc loc
getLoc (Ttypedef loc) = getLoc loc
instance Located TypeQual where
getLoc (Tconst loc) = getLoc loc
getLoc (Tvolatile loc) = getLoc loc
getLoc (Tinline loc) = getLoc loc
getLoc (Trestrict loc) = getLoc loc
getLoc (TCUDAdevice loc) = getLoc loc
getLoc (TCUDAglobal loc) = getLoc loc
getLoc (TCUDAhost loc) = getLoc loc
getLoc (TCUDAconstant loc) = getLoc loc
getLoc (TCUDAshared loc) = getLoc loc
getLoc (TCUDAnoinline loc) = getLoc loc
getLoc (TCLprivate loc) = getLoc loc
getLoc (TCLlocal loc) = getLoc loc
getLoc (TCLglobal loc) = getLoc loc
getLoc (TCLconstant loc) = getLoc loc
getLoc (TCLreadonly loc) = getLoc loc
getLoc (TCLwriteonly loc) = getLoc loc
getLoc (TCLkernel loc) = getLoc loc
instance Located Sign where
getLoc (Tsigned loc) = getLoc loc
getLoc (Tunsigned loc) = getLoc loc
instance Located TypeSpec where
getLoc (Tvoid loc) = getLoc loc
getLoc (Tchar _ loc) = getLoc loc
getLoc (Tshort _ loc) = getLoc loc
getLoc (Tint _ loc) = getLoc loc
getLoc (Tlong _ loc) = getLoc loc
getLoc (Tlong_long _ loc) = getLoc loc
getLoc (Tfloat loc) = getLoc loc
getLoc (Tdouble loc) = getLoc loc
getLoc (Tlong_double loc) = getLoc loc
getLoc (Tstruct _ _ _ loc) = getLoc loc
getLoc (Tunion _ _ _ loc) = getLoc loc
getLoc (Tenum _ _ _ loc) = getLoc loc
getLoc (Tnamed _ loc) = getLoc loc
getLoc (TtypeofExp _ loc) = getLoc loc
getLoc (TtypeofType _ loc) = getLoc loc
getLoc (Tva_list loc) = getLoc loc
instance Located DeclSpec where
getLoc (DeclSpec _ _ _ loc) = getLoc loc
getLoc (AntiDeclSpec _ loc) = getLoc loc
getLoc (AntiTypeDeclSpec _ _ _ loc) = getLoc loc
instance Located ArraySize where
getLoc (ArraySize _ _ loc) = getLoc loc
getLoc (VariableArraySize loc) = getLoc loc
getLoc (NoArraySize loc) = getLoc loc
instance Located Decl where
getLoc (DeclRoot loc) = getLoc loc
getLoc (Ptr _ _ loc) = getLoc loc
getLoc (Array _ _ _ loc) = getLoc loc
getLoc (Proto _ _ loc) = getLoc loc
getLoc (OldProto _ _ loc) = getLoc loc
getLoc (AntiTypeDecl _ loc) = getLoc loc
instance Located Type where
getLoc (Type _ _ loc) = getLoc loc
getLoc (AntiType _ loc) = getLoc loc
instance Located Designator where
getLoc (IndexDesignator _ loc) = getLoc loc
getLoc (MemberDesignator _ loc) = getLoc loc
instance Located Designation where
getLoc (Designation _ loc) = getLoc loc
instance Located Initializer where
getLoc (ExpInitializer _ loc) = getLoc loc
getLoc (CompoundInitializer _ loc) = getLoc loc
instance Located Init where
getLoc (Init _ _ _ _ _ loc) = getLoc loc
instance Located Typedef where
getLoc (Typedef _ _ _ loc) = getLoc loc
instance Located InitGroup where
getLoc (InitGroup _ _ _ loc) = getLoc loc
getLoc (TypedefGroup _ _ _ loc) = getLoc loc
getLoc (AntiDecl _ loc) = getLoc loc
getLoc (AntiDecls _ loc) = getLoc loc
instance Located Field where
getLoc (Field _ _ _ loc) = getLoc loc
instance Located FieldGroup where
getLoc (FieldGroup _ _ loc) = getLoc loc
getLoc (AntiSdecl _ loc) = getLoc loc
getLoc (AntiSdecls _ loc) = getLoc loc
instance Located CEnum where
getLoc (CEnum _ _ loc) = getLoc loc
getLoc (AntiEnum _ loc) = getLoc loc
getLoc (AntiEnums _ loc) = getLoc loc
instance Located Attr where
getLoc (Attr _ _ loc) = getLoc loc
instance Located Param where
getLoc (Param _ _ _ loc) = getLoc loc
getLoc (AntiParam _ loc) = getLoc loc
getLoc (AntiParams _ loc) = getLoc loc
instance Located Params where
getLoc (Params _ _ loc) = getLoc loc
instance Located Func where
getLoc (Func _ _ _ _ _ loc) = getLoc loc
getLoc (OldFunc _ _ _ _ _ _ loc) = getLoc loc
instance Located Definition where
getLoc (FuncDef _ loc) = getLoc loc
getLoc (DecDef _ loc) = getLoc loc
getLoc (EscDef _ loc) = getLoc loc
getLoc (AntiFunc _ loc) = getLoc loc
getLoc (AntiEsc _ loc) = getLoc loc
getLoc (AntiEdecl _ loc) = getLoc loc
getLoc (AntiEdecls _ loc) = getLoc loc
instance Located Stm where
getLoc (Label _ _ loc) = getLoc loc
getLoc (Case _ _ loc) = getLoc loc
getLoc (Default _ loc) = getLoc loc
getLoc (Exp _ loc) = getLoc loc
getLoc (Block _ loc) = getLoc loc
getLoc (If _ _ _ loc) = getLoc loc
getLoc (Switch _ _ loc) = getLoc loc
getLoc (While _ _ loc) = getLoc loc
getLoc (DoWhile _ _ loc) = getLoc loc
getLoc (For _ _ _ _ loc) = getLoc loc
getLoc (Goto _ loc) = getLoc loc
getLoc (Continue loc) = getLoc loc
getLoc (Break loc) = getLoc loc
getLoc (Return _ loc) = getLoc loc
getLoc (Asm _ _ _ _ _ _ loc) = getLoc loc
getLoc (AntiStm _ loc) = getLoc loc
getLoc (AntiStms _ loc) = getLoc loc
instance Located BlockItem where
getLoc (BlockDecl decl) = getLoc decl
getLoc (BlockStm stm) = getLoc stm
getLoc (AntiBlockItem _ loc) = getLoc loc
getLoc (AntiBlockItems _ loc) = getLoc loc
instance Located Const where
getLoc (IntConst _ _ _ loc) = getLoc loc
getLoc (LongIntConst _ _ _ loc) = getLoc loc
getLoc (LongLongIntConst _ _ _ loc) = getLoc loc
getLoc (FloatConst _ _ loc) = getLoc loc
getLoc (DoubleConst _ _ loc) = getLoc loc
getLoc (LongDoubleConst _ _ loc) = getLoc loc
getLoc (CharConst _ _ loc) = getLoc loc
getLoc (StringConst _ _ loc) = getLoc loc
getLoc (AntiInt _ loc) = getLoc loc
getLoc (AntiUInt _ loc) = getLoc loc
getLoc (AntiLInt _ loc) = getLoc loc
getLoc (AntiULInt _ loc) = getLoc loc
getLoc (AntiFloat _ loc) = getLoc loc
getLoc (AntiDouble _ loc) = getLoc loc
getLoc (AntiLongDouble _ loc) = getLoc loc
getLoc (AntiChar _ loc) = getLoc loc
getLoc (AntiString _ loc) = getLoc loc
instance Located ExeConfig where
getLoc conf = getLoc (exeLoc conf)
instance Located Exp where
getLoc (Var _ loc) = getLoc loc
getLoc (Const _ loc) = getLoc loc
getLoc (BinOp _ _ _ loc) = getLoc loc
getLoc (Assign _ _ _ loc) = getLoc loc
getLoc (PreInc _ loc) = getLoc loc
getLoc (PostInc _ loc) = getLoc loc
getLoc (PreDec _ loc) = getLoc loc
getLoc (PostDec _ loc) = getLoc loc
getLoc (UnOp _ _ loc) = getLoc loc
getLoc (SizeofExp _ loc) = getLoc loc
getLoc (SizeofType _ loc) = getLoc loc
getLoc (Cast _ _ loc) = getLoc loc
getLoc (Cond _ _ _ loc) = getLoc loc
getLoc (Member _ _ loc) = getLoc loc
getLoc (PtrMember _ _ loc) = getLoc loc
getLoc (Index _ _ loc) = getLoc loc
getLoc (FnCall _ _ loc) = getLoc loc
getLoc (CudaCall _ _ _ loc) = getLoc loc
getLoc (Seq _ _ loc) = getLoc loc
getLoc (CompoundLit _ _ loc) = getLoc loc
getLoc (StmExpr _ loc) = getLoc loc
getLoc (BuiltinVaArg _ _ loc) = getLoc loc
getLoc (AntiExp _ loc) = getLoc loc
getLoc (AntiArgs _ loc) = getLoc loc
ctypedef :: Id -> Decl -> [Attr] -> Typedef
ctypedef id decl attrs =
Typedef id decl attrs ((id <--> decl :: Loc) <--> attrs)
cdeclSpec :: [Storage] -> [TypeQual] -> TypeSpec -> DeclSpec
cdeclSpec storage quals spec =
DeclSpec storage quals spec ((storage <--> quals :: Loc) <--> spec)
cinitGroup :: DeclSpec -> [Attr] -> [Init] -> InitGroup
cinitGroup dspec attrs inis =
InitGroup dspec attrs inis ((dspec <--> attrs :: Loc) <--> inis)
ctypedefGroup :: DeclSpec -> [Attr] -> [Typedef] -> InitGroup
ctypedefGroup dspec attrs typedefs =
TypedefGroup dspec attrs typedefs ((dspec <--> attrs :: Loc) <--> typedefs)