module Language.C.Analysis.SemRep(
TagDef(..),typeOfTagDef,
Declaration(..),declIdent,declName,declType,declAttrs,
IdentDecl(..),objKindDescr, splitIdentDecls,
GlobalDecls(..),emptyGlobalDecls,filterGlobalDecls,mergeGlobalDecls,
DeclEvent(..),
Decl(..),
ObjDef(..),isTentative,
FunDef(..),
ParamDecl(..),MemberDecl(..),
TypeDef(..),identOfTypeDef,
VarDecl(..),
DeclAttrs(..),isExtDecl,
Storage(..),declStorage,ThreadLocal,
Linkage(..),
Type(..),
FunType(..),isFunctionType,
derefTypeDef,referencedType,hasTypeOfExpr,
ArraySize(..),
TypeDefRef(..),
TypeName(..),BuiltinType(..),
IntType(..),FloatType(..),
HasSUERef(..),HasCompTyKind(..),
CompTypeRef(..),CompType(..),typeOfCompDef,CompTyKind(..),
EnumTypeRef(..),EnumType(..),typeOfEnumDef,
Enumerator(..),
TypeQuals(..),noTypeQuals,mergeTypeQuals,
VarName(..),identOfVarName,AsmName,
Attr(..),Attributes,
Stmt,Expr,Initializer,AsmBlock,
)
where
import Language.C.Data
import Language.C.Syntax
import Language.C.Syntax.Constants
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Generics
import Text.PrettyPrint.HughesPJ
class HasSUERef a where
sueRef :: a -> SUERef
class HasCompTyKind a where
compTag :: a -> CompTyKind
data TagDef = CompDef CompType --definition
| EnumDef EnumType
deriving (Typeable, Data )
instance HasSUERef TagDef where
sueRef (CompDef ct) = sueRef ct
sueRef (EnumDef et) = sueRef et
typeOfTagDef :: TagDef -> TypeName
typeOfTagDef (CompDef comptype) = typeOfCompDef comptype
typeOfTagDef (EnumDef enumtype) = typeOfEnumDef enumtype
class Declaration n where
getVarDecl :: n -> VarDecl
declOfDef :: (Declaration n, CNode n) => n -> Decl
declOfDef def = let vd = getVarDecl def in Decl vd (nodeInfo def)
declIdent :: (Declaration n) => n -> Ident
declIdent = identOfVarName . declName
declName :: (Declaration n) => n -> VarName
declName = (\(VarDecl n _ _) -> n) . getVarDecl
declType :: (Declaration n) => n -> Type
declType = (\(VarDecl _ _ ty) -> ty) . getVarDecl
declAttrs :: (Declaration n) => n -> DeclAttrs
declAttrs = (\(VarDecl _ specs _) -> specs) . getVarDecl
instance (Declaration a, Declaration b) => Declaration (Either a b) where
getVarDecl = either getVarDecl getVarDecl
data IdentDecl = Declaration Decl
| ObjectDef ObjDef
| FunctionDef FunDef
| EnumeratorDef Enumerator
deriving (Typeable, Data )
instance Declaration IdentDecl where
getVarDecl (Declaration decl) = getVarDecl decl
getVarDecl (ObjectDef def) = getVarDecl def
getVarDecl (FunctionDef def) = getVarDecl def
getVarDecl (EnumeratorDef def) = getVarDecl def
objKindDescr :: IdentDecl -> String
objKindDescr (Declaration _ ) = "declaration"
objKindDescr (ObjectDef _) = "object definition"
objKindDescr (FunctionDef _) = "function definition"
objKindDescr (EnumeratorDef _) = "enumerator definition"
splitIdentDecls :: Bool -> Map Ident IdentDecl -> (Map Ident Decl,
( Map Ident Enumerator,
Map Ident ObjDef,
Map Ident FunDef ) )
splitIdentDecls include_all = Map.foldWithKey (if include_all then deal else deal') (Map.empty,(Map.empty,Map.empty,Map.empty))
where
deal ident entry (decls,defs) = (Map.insert ident (declOfDef entry) decls, addDef ident entry defs)
deal' ident (Declaration d) (decls,defs) = (Map.insert ident d decls,defs)
deal' ident def (decls,defs) = (decls, addDef ident def defs)
addDef ident entry (es,os,fs) =
case entry of
Declaration _ -> (es,os,fs)
EnumeratorDef e -> (Map.insert ident e es,os,fs)
ObjectDef o -> (es,Map.insert ident o os,fs)
FunctionDef f -> (es, os,Map.insert ident f fs)
data GlobalDecls = GlobalDecls {
gObjs :: Map Ident IdentDecl,
gTags :: Map SUERef TagDef,
gTypeDefs :: Map Ident TypeDef
}
emptyGlobalDecls :: GlobalDecls
emptyGlobalDecls = GlobalDecls Map.empty Map.empty Map.empty
filterGlobalDecls :: (DeclEvent -> Bool) -> GlobalDecls -> GlobalDecls
filterGlobalDecls decl_filter gmap = GlobalDecls
{
gObjs = Map.filter (decl_filter . DeclEvent) (gObjs gmap),
gTags = Map.filter (decl_filter . TagEvent) (gTags gmap),
gTypeDefs = Map.filter (decl_filter . TypeDefEvent) (gTypeDefs gmap)
}
mergeGlobalDecls :: GlobalDecls -> GlobalDecls -> GlobalDecls
mergeGlobalDecls gmap1 gmap2 = GlobalDecls
{
gObjs = Map.union (gObjs gmap1) (gObjs gmap2),
gTags = Map.union (gTags gmap1) (gTags gmap2),
gTypeDefs = Map.union (gTypeDefs gmap1) (gTypeDefs gmap2)
}
data DeclEvent =
TagEvent TagDef
| DeclEvent IdentDecl
| TypeDefEvent TypeDef
| AsmEvent AsmBlock
deriving ()
data Decl = Decl VarDecl NodeInfo
deriving (Typeable, Data )
instance Declaration Decl where
getVarDecl (Decl vd _) = vd
data ObjDef = ObjDef VarDecl (Maybe Initializer) NodeInfo
deriving (Typeable, Data )
instance Declaration ObjDef where
getVarDecl (ObjDef vd _ _) = vd
isTentative :: ObjDef -> Bool
isTentative (ObjDef decl init_opt _) | isExtDecl decl = maybe True (const False) init_opt
| otherwise = False
data FunDef = FunDef VarDecl Stmt NodeInfo
deriving (Typeable, Data )
instance Declaration FunDef where
getVarDecl (FunDef vd _ _) = vd
data ParamDecl = ParamDecl VarDecl NodeInfo
| AbstractParamDecl VarDecl NodeInfo
deriving (Typeable, Data )
instance Declaration ParamDecl where
getVarDecl (ParamDecl vd _) = vd
getVarDecl (AbstractParamDecl vd _) = vd
data MemberDecl = MemberDecl VarDecl (Maybe Expr) NodeInfo
| AnonBitField Type Expr NodeInfo
deriving (Typeable, Data )
instance Declaration MemberDecl where
getVarDecl (MemberDecl vd _ _) = vd
getVarDecl (AnonBitField ty _ _) = VarDecl NoName (DeclAttrs False NoStorage []) ty
data TypeDef = TypeDef Ident Type Attributes NodeInfo
deriving (Typeable, Data )
identOfTypeDef :: TypeDef -> Ident
identOfTypeDef (TypeDef ide _ _ _) = ide
data VarDecl = VarDecl VarName DeclAttrs Type
deriving (Typeable, Data)
instance Declaration VarDecl where
getVarDecl = id
isExtDecl :: (Declaration n) => n -> Bool
isExtDecl = hasLinkage . declStorage
data DeclAttrs = DeclAttrs Bool Storage Attributes
deriving (Typeable, Data)
declStorage :: (Declaration d) => d -> Storage
declStorage d = case declAttrs d of (DeclAttrs _ st _) -> st
data Storage = NoStorage
| Auto Register
| Static Linkage ThreadLocal
| FunLinkage Linkage
deriving (Typeable, Data, Show, Eq, Ord)
type ThreadLocal = Bool
type Register = Bool
data Linkage = InternalLinkage | ExternalLinkage
deriving (Typeable, Data, Show, Eq, Ord)
hasLinkage :: Storage -> Bool
hasLinkage (Static _ _) = True
hasLinkage _ = False
data Type =
DirectType TypeName TypeQuals
| PtrType Type TypeQuals Attributes
| ArrayType Type ArraySize TypeQuals Attributes
| FunctionType FunType
| TypeDefType TypeDefRef
| TypeOfExpr Expr
deriving (Typeable, Data)
data FunType = FunType Type [ParamDecl] Bool Attributes
| FunTypeIncomplete Type Attributes
deriving (Typeable, Data)
derefTypeDef :: Type -> Type
derefTypeDef (TypeDefType (TypeDefRef _ (Just actual_ty) _)) = derefTypeDef actual_ty
derefTypeDef ty = ty
referencedType :: Type -> Maybe Type
referencedType (PtrType ty _ _) = Just ty
referencedType (FunctionType (FunType ty _ _ _)) = Just ty
referencedType (ArrayType ty _ _ _) = Just ty
referencedType (TypeDefType (TypeDefRef _ (Just actual_ty) _)) = Just actual_ty
referencedType (DirectType _ _) = Nothing
referencedType _ = error "referencedType: failed to resolve type"
hasTypeOfExpr :: Type -> Bool
hasTypeOfExpr (TypeOfExpr _) = True
hasTypeOfExpr ty = maybe False hasTypeOfExpr (referencedType ty)
isFunctionType :: Type -> Bool
isFunctionType ty =
case ty of TypeDefType (TypeDefRef _ (Just actual_ty) _) -> isFunctionType actual_ty
TypeDefType _ -> error "isFunctionType: unresolved typeDef"
TypeOfExpr _ -> error "isFunctionType: typeof(expr)"
FunctionType _ -> True
_ -> False
data ArraySize = UnknownArraySize Bool
| ArraySize Bool Expr
deriving (Typeable, Data)
data TypeName =
TyVoid
| TyIntegral IntType
| TyFloating FloatType
| TyComplex FloatType
| TyComp CompTypeRef
| TyEnum EnumTypeRef
| TyBuiltin BuiltinType
deriving (Typeable, Data)
data BuiltinType = TyVaList
deriving (Typeable, Data)
data TypeDefRef = TypeDefRef Ident (Maybe Type) NodeInfo
deriving (Typeable, Data )
data IntType =
TyBool
| TyChar
| TySChar
| TyUChar
| TyShort
| TyUShort
| TyInt
| TyUInt
| TyLong
| TyULong
| TyLLong
| TyULLong
deriving (Typeable, Data, Eq, Ord)
instance Show IntType where
show TyBool = "_Bool"
show TyChar = "char"
show TySChar = "signed char"
show TyUChar = "unsigned char"
show TyShort = "short"
show TyUShort = "unsigned short"
show TyInt = "int"
show TyUInt = "unsigned int"
show TyLong = "long"
show TyULong = "unsigned long"
show TyLLong = "long long"
show TyULLong = "unsigned long long"
data FloatType =
TyFloat
| TyDouble
| TyLDouble
deriving (Typeable, Data, Eq, Ord)
instance Show FloatType where
show TyFloat = "float"
show TyDouble = "double"
show TyLDouble = "long double"
data CompTypeRef = CompTypeRef SUERef CompTyKind NodeInfo
deriving (Typeable, Data )
instance HasSUERef CompTypeRef where sueRef (CompTypeRef ref _ _) = ref
instance HasCompTyKind CompTypeRef where compTag (CompTypeRef _ tag _) = tag
data EnumTypeRef = EnumTypeRef SUERef NodeInfo
deriving (Typeable, Data )
instance HasSUERef EnumTypeRef where sueRef (EnumTypeRef ref _) = ref
data CompType = CompType SUERef CompTyKind [MemberDecl] Attributes NodeInfo
deriving (Typeable, Data )
instance HasSUERef CompType where sueRef (CompType ref _ _ _ _) = ref
instance HasCompTyKind CompType where compTag (CompType _ tag _ _ _) = tag
typeOfCompDef :: CompType -> TypeName
typeOfCompDef (CompType ref tag _ _ _) = TyComp (CompTypeRef ref tag internalNode)
data CompTyKind = StructTag
| UnionTag
deriving (Eq,Ord,Typeable,Data)
instance Show CompTyKind where
show StructTag = "struct"
show UnionTag = "union"
data EnumType = EnumType SUERef [Enumerator] Attributes NodeInfo
deriving (Typeable, Data )
instance HasSUERef EnumType where sueRef (EnumType ref _ _ _) = ref
typeOfEnumDef :: EnumType -> TypeName
typeOfEnumDef (EnumType ref _ _ _) = TyEnum (EnumTypeRef ref internalNode)
data Enumerator = Enumerator Ident Expr EnumType NodeInfo
deriving (Typeable, Data )
instance Declaration Enumerator where
getVarDecl (Enumerator ide _ enumty _) =
VarDecl
(VarName ide Nothing)
(DeclAttrs False NoStorage [])
(DirectType (typeOfEnumDef enumty) noTypeQuals)
data TypeQuals = TypeQuals { constant :: Bool, volatile :: Bool, restrict :: Bool }
deriving (Typeable, Data)
noTypeQuals :: TypeQuals
noTypeQuals = TypeQuals False False False
mergeTypeQuals :: TypeQuals -> TypeQuals -> TypeQuals
mergeTypeQuals (TypeQuals c1 v1 r1) (TypeQuals c2 v2 r2) = TypeQuals (c1 && c2) (v1 && v2) (r1 && r2)
type Initializer = CInit
data VarName = VarName Ident (Maybe AsmName)
| NoName
deriving (Typeable, Data)
identOfVarName :: VarName -> Ident
identOfVarName NoName = error "identOfVarName: NoName"
identOfVarName (VarName ident _) = ident
type AsmBlock = CStrLit
type AsmName = CStrLit
data Attr = Attr Ident [Expr] NodeInfo
deriving (Typeable, Data )
type Attributes = [Attr]
type Stmt = CStat
type Expr = CExpr
instance CNode TagDef
where nodeInfo (CompDef d) = nodeInfo d
nodeInfo (EnumDef d) = nodeInfo d
instance Pos TagDef
where posOf x = posOfNode (nodeInfo x)
instance CNode IdentDecl
where nodeInfo (Declaration d) = nodeInfo d
nodeInfo (ObjectDef d) = nodeInfo d
nodeInfo (FunctionDef d) = nodeInfo d
nodeInfo (EnumeratorDef d) = nodeInfo d
instance Pos IdentDecl
where posOf x = posOfNode (nodeInfo x)
instance CNode DeclEvent
where nodeInfo (TagEvent d) = nodeInfo d
nodeInfo (DeclEvent d) = nodeInfo d
nodeInfo (TypeDefEvent d) = nodeInfo d
nodeInfo (AsmEvent d) = nodeInfo d
instance Pos DeclEvent
where posOf x = posOfNode (nodeInfo x)
instance CNode Decl
where nodeInfo (Decl _ nodeinfo) = nodeinfo
instance Pos Decl
where posOf x = posOfNode (nodeInfo x)
instance CNode ObjDef
where nodeInfo (ObjDef _ _ nodeinfo) = nodeinfo
instance Pos ObjDef
where posOf x = posOfNode (nodeInfo x)
instance CNode FunDef
where nodeInfo (FunDef _ _ nodeinfo) = nodeinfo
instance Pos FunDef
where posOf x = posOfNode (nodeInfo x)
instance CNode ParamDecl
where nodeInfo (ParamDecl _ nodeinfo) = nodeinfo
nodeInfo (AbstractParamDecl _ nodeinfo) = nodeinfo
instance Pos ParamDecl
where posOf x = posOfNode (nodeInfo x)
instance CNode MemberDecl
where nodeInfo (MemberDecl _ _ nodeinfo) = nodeinfo
nodeInfo (AnonBitField _ _ nodeinfo) = nodeinfo
instance Pos MemberDecl
where posOf x = posOfNode (nodeInfo x)
instance CNode TypeDef
where nodeInfo (TypeDef _ _ _ nodeinfo) = nodeinfo
instance Pos TypeDef
where posOf x = posOfNode (nodeInfo x)
instance CNode TypeDefRef
where nodeInfo (TypeDefRef _ _ nodeinfo) = nodeinfo
instance Pos TypeDefRef
where posOf x = posOfNode (nodeInfo x)
instance CNode CompTypeRef
where nodeInfo (CompTypeRef _ _ nodeinfo) = nodeinfo
instance Pos CompTypeRef
where posOf x = posOfNode (nodeInfo x)
instance CNode EnumTypeRef
where nodeInfo (EnumTypeRef _ nodeinfo) = nodeinfo
instance Pos EnumTypeRef
where posOf x = posOfNode (nodeInfo x)
instance CNode CompType
where nodeInfo (CompType _ _ _ _ nodeinfo) = nodeinfo
instance Pos CompType
where posOf x = posOfNode (nodeInfo x)
instance CNode EnumType
where nodeInfo (EnumType _ _ _ nodeinfo) = nodeinfo
instance Pos EnumType
where posOf x = posOfNode (nodeInfo x)
instance CNode Enumerator
where nodeInfo (Enumerator _ _ _ nodeinfo) = nodeinfo
instance Pos Enumerator
where posOf x = posOfNode (nodeInfo x)
instance CNode Attr
where nodeInfo (Attr _ _ nodeinfo) = nodeinfo
instance Pos Attr
where posOf x = posOfNode (nodeInfo x)