diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog +## 0.10.0 + +- Support for half-precision floating point `__fp16`, `_Float16`, and `_Float16x`. +- Support for bfloat16 `__bf16`. +- Support alignment specifier `_Alignas` in struct declatations. + ## 0.9.4 - Support `happy-2.1`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ Currently unsupported C11 constructs: - static assertion 6.7.10 (`_Static_assert`) - generic selection 6.5.1.1 (`_Generic`) - - `_Atomic`, `_Alignas`, `_Thread_local` + - `_Atomic`, `_Thread_local` - Universal character names Currently unsupported GNU C extensions: diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,5 +0,0 @@ -#!/usr/bin/env runhaskell - -import Distribution.Simple - -main = defaultMain diff --git a/language-c.cabal b/language-c.cabal --- a/language-c.cabal +++ b/language-c.cabal @@ -1,22 +1,21 @@ cabal-version: 2.2 name: language-c -version: 0.9.4 +version: 0.10.0 license: BSD-3-Clause license-file: LICENSE copyright: LICENSE maintainer: language.c@monoid.al author: AUTHORS tested-with: - ghc ==9.10.1 - ghc ==9.8.2 ghc ==9.6.6 ghc ==9.4.8 ghc ==9.2.8 ghc ==9.0.2 - ghc ==8.10.7 ghc ==8.8.4 ghc ==8.6.5 ghc ==8.4.4 ghc ==8.2.2 - ghc ==8.0.2 + ghc ==9.12.1 ghc ==9.10.1 ghc ==9.8.2 ghc ==9.6.6 ghc ==9.4.8 + ghc ==9.2.8 ghc ==9.0.2 ghc ==8.10.7 ghc ==8.8.4 ghc ==8.6.5 + ghc ==8.4.4 ghc ==8.2.2 ghc ==8.0.2 homepage: https://visq.github.io/language-c/ bug-reports: https://github.com/visq/language-c/issues/ synopsis: Analysis and generation of C code description: - Language C is a haskell library for the analysis and generation of C code. + Language C is a Haskell library for the analysis and generation of C code. It features a complete, well tested parser and pretty printer for all of C99 and a large set of C11 and clang/GNU extensions. @@ -34,11 +33,14 @@ flag usebytestrings description: Use ByteString as InputStream datatype + manual: True flag iecfpextension description: Support IEC 60559 floating point extension (defines _Float128) + manual: True + library exposed-modules: Language.C @@ -91,6 +93,7 @@ ExistentialQuantification GeneralizedNewtypeDeriving ScopedTypeVariables + ghc-options: -Wall -Wno-redundant-constraints build-depends: base >=4.9 && <5, array <0.6, @@ -101,8 +104,6 @@ mtl <2.4, pretty <1.2.0, process <1.7 - - ghc-options: -Wall -Wno-redundant-constraints if flag(usebytestrings) build-depends: bytestring >=0.9.0 && <0.13 diff --git a/src/Language/C/Analysis/DeclAnalysis.hs b/src/Language/C/Analysis/DeclAnalysis.hs --- a/src/Language/C/Analysis/DeclAnalysis.hs +++ b/src/Language/C/Analysis/DeclAnalysis.hs @@ -395,6 +395,7 @@ (BaseFloat, NoSignSpec, NoSizeMod) -> floatType TyFloat (BaseDouble, NoSignSpec, NoSizeMod) -> floatType TyDouble (BaseDouble, NoSignSpec, LongMod) -> floatType TyLDouble + (BaseBFloat16, NoSignSpec, NoSizeMod) -> floatType TyBFloat16 (BaseFloatN n x, NoSignSpec, NoSizeMod) -> floatType (TyFloatN n x) -- TODO: error analysis (_,_,_) -> error "Bad AST analysis" @@ -431,7 +432,7 @@ To canoicalize type specifiers, we define a canonical form: void | bool | (char|int|int128|float|double|floatNx)? (signed|unsigned)? (long long?)? complex? | othertype -} -data NumBaseType = NoBaseType | BaseChar | BaseInt | BaseInt128 | BaseFloat | +data NumBaseType = NoBaseType | BaseChar | BaseInt | BaseInt128 | BaseFloat | BaseBFloat16 | BaseFloatN Int Bool | BaseDouble deriving (Eq,Ord) data SignSpec = NoSignSpec | Signed | Unsigned deriving (Eq,Ord) data SizeMod = NoSizeMod | ShortMod | LongMod | LongLongMod deriving (Eq,Ord) @@ -461,6 +462,8 @@ = return$ TSNum$ nts { base = BaseInt128 } go (CFloatType _) tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa = return$ TSNum$ nts { base = BaseFloat } + go (CBFloat16Type _) tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa + = return$ TSNum$ nts { base = BaseBFloat16 } go (CFloatNType n x _) tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa = return$ TSNum$ nts { base = BaseFloatN n x } go (CDoubleType _) tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa diff --git a/src/Language/C/Analysis/DefTable.hs b/src/Language/C/Analysis/DefTable.hs --- a/src/Language/C/Analysis/DefTable.hs +++ b/src/Language/C/Analysis/DefTable.hs @@ -41,7 +41,6 @@ import Data.IntMap (IntMap, union) import qualified Data.IntMap as IntMap import Data.Data (Data) -import Data.Typeable (Typeable) {- Name spaces, scopes and contexts [Scopes] @@ -168,7 +167,7 @@ | KeepDef t -- ^ new def was discarded | Shadowed t -- ^ new def shadows one in outer scope | KindMismatch t -- ^ kind mismatch - deriving (Data,Typeable) + deriving (Data) declStatusDescr :: DeclarationStatus t -> String declStatusDescr NewDecl = "new" declStatusDescr (Redeclared _) = "redeclared" diff --git a/src/Language/C/Analysis/Export.hs b/src/Language/C/Analysis/Export.hs --- a/src/Language/C/Analysis/Export.hs +++ b/src/Language/C/Analysis/Export.hs @@ -177,6 +177,7 @@ TyFloat -> [CFloatType ni] TyDouble -> [CDoubleType ni] TyLDouble -> [CLongType ni, CDoubleType ni] + TyBFloat16 -> [CBFloat16Type ni] TyFloatN n x -> [CFloatNType n x ni] exportComplexType :: FloatType -> [CTypeSpec] diff --git a/src/Language/C/Analysis/MachineDescs.hs b/src/Language/C/Analysis/MachineDescs.hs --- a/src/Language/C/Analysis/MachineDescs.hs +++ b/src/Language/C/Analysis/MachineDescs.hs @@ -27,6 +27,7 @@ TyFloat -> 4 TyDouble -> 8 TyLDouble -> 16 + TyBFloat16 -> error "TyBFloat16" TyFloatN{} -> error "TyFloatN" builtinSize = \case TyVaList -> 24 @@ -52,6 +53,7 @@ TyFloat -> 4 TyDouble -> 8 TyLDouble -> 16 + TyBFloat16{} -> error "TyBFloat16" TyFloatN{} -> error "TyFloatN" builtinAlign = \case TyVaList -> 8 @@ -81,6 +83,7 @@ TyFloat -> 4 TyDouble -> 8 TyLDouble -> 8 + TyBFloat16 -> 2 TyFloatN{} -> error "TyFloatN" builtinSize = \case TyVaList -> 4 @@ -106,6 +109,7 @@ TyFloat -> 4 TyDouble -> 8 TyLDouble -> 8 + TyBFloat16 -> 2 TyFloatN{} -> error "TyFloatN" builtinAlign = \case TyVaList -> 4 diff --git a/src/Language/C/Analysis/SemError.hs b/src/Language/C/Analysis/SemError.hs --- a/src/Language/C/Analysis/SemError.hs +++ b/src/Language/C/Analysis/SemError.hs @@ -17,7 +17,6 @@ RedefError(..), RedefInfo(..), RedefKind(..), redefinition, ) where -import Data.Typeable -- this means we cannot use SemError in SemRep, but use rich types here import Language.C.Analysis.SemRep @@ -28,26 +27,26 @@ -- here are the errors available -- | InvalidASTError is caused by the violation of an invariant in the AST -newtype InvalidASTError = InvalidAST ErrorInfo deriving (Typeable) +newtype InvalidASTError = InvalidAST ErrorInfo instance Error InvalidASTError where errorInfo (InvalidAST ei) = ei changeErrorLevel (InvalidAST ei) lvl' = InvalidAST (changeErrorLevel ei lvl') -- | BadSpecifierError is caused by an invalid combination of specifiers -newtype BadSpecifierError = BadSpecifierError ErrorInfo deriving (Typeable) +newtype BadSpecifierError = BadSpecifierError ErrorInfo instance Error BadSpecifierError where errorInfo (BadSpecifierError ei) = ei changeErrorLevel (BadSpecifierError ei) lvl' = BadSpecifierError (changeErrorLevel ei lvl') -- | RedefError is caused by an invalid redefinition of the same identifier or type -data RedefError = RedefError ErrorLevel RedefInfo deriving Typeable +data RedefError = RedefError ErrorLevel RedefInfo data RedefInfo = RedefInfo String RedefKind NodeInfo NodeInfo data RedefKind = DuplicateDef | DiffKindRedecl | ShadowedDef | DisagreeLinkage | NoLinkageOld -data TypeMismatch = TypeMismatch String (NodeInfo,Type) (NodeInfo,Type) deriving Typeable +data TypeMismatch = TypeMismatch String (NodeInfo,Type) (NodeInfo,Type) -- Invalid AST -- ~~~~~~~~~~~ diff --git a/src/Language/C/Analysis/SemRep.hs b/src/Language/C/Analysis/SemRep.hs --- a/src/Language/C/Analysis/SemRep.hs +++ b/src/Language/C/Analysis/SemRep.hs @@ -59,7 +59,6 @@ import qualified Data.Map as Map import Data.Maybe import Data.Data (Data) -import Data.Typeable (Typeable) -- | accessor class : struct\/union\/enum names class HasSUERef a where @@ -72,7 +71,7 @@ -- | Composite type definitions (tags) data TagDef = CompDef CompType --composite definition | EnumDef EnumType --enum definition - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance HasSUERef TagDef where sueRef (CompDef ct) = sueRef ct @@ -114,7 +113,7 @@ | ObjectDef ObjDef -- ^ object definition | FunctionDef FunDef -- ^ function definition | EnumeratorDef Enumerator -- ^ definition of an enumerator - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration IdentDecl where getVarDecl (Declaration decl) = getVarDecl decl @@ -203,7 +202,7 @@ -- | Declarations, which aren't definitions data Decl = Decl VarDecl NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration Decl where getVarDecl (Decl vd _) = vd @@ -215,7 +214,7 @@ -- If the initializer is missing, it is a tentative definition, i.e. a -- definition which might be overriden later on. data ObjDef = ObjDef VarDecl (Maybe Initializer) NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration ObjDef where getVarDecl (ObjDef vd _ _) = vd @@ -228,7 +227,7 @@ -- -- A function definition is a declaration together with a statement (the function body). data FunDef = FunDef VarDecl Stmt NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration FunDef where getVarDecl (FunDef vd _ _) = vd @@ -236,7 +235,7 @@ -- | Parameter declaration data ParamDecl = ParamDecl VarDecl NodeInfo | AbstractParamDecl VarDecl NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration ParamDecl where getVarDecl (ParamDecl vd _) = vd @@ -247,7 +246,7 @@ -- ^ @MemberDecl vardecl bitfieldsize node@ | AnonBitField Type Expr NodeInfo -- ^ @AnonBitField typ size@ - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration MemberDecl where getVarDecl (MemberDecl vd _ _) = vd @@ -257,7 +256,7 @@ -- -- The identifier is a new name for the given type. data TypeDef = TypeDef Ident Type Attributes NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) -- | return the idenitifier of a @typedef@ identOfTypeDef :: TypeDef -> Ident @@ -265,7 +264,7 @@ -- | Generic variable declarations data VarDecl = VarDecl VarName DeclAttrs Type - deriving (Typeable, Data, Show) + deriving (Data, Show) instance Declaration VarDecl where getVarDecl = id @@ -279,7 +278,7 @@ -- They specify the storage and linkage of a declared object. data DeclAttrs = DeclAttrs FunctionAttrs Storage Attributes -- ^ @DeclAttrs fspecs storage attrs@ - deriving (Typeable, Data, Show) + deriving (Data, Show) -- | get the 'Storage' of a declaration declStorage :: (Declaration d) => d -> Storage @@ -291,7 +290,7 @@ -- Function attributes (inline, noreturn) data FunctionAttrs = FunctionAttrs { isInline :: Bool, isNoreturn :: Bool } - deriving (Eq, Ord, Typeable, Data, Show) + deriving (Eq, Ord, Data, Show) noFunctionAttrs :: FunctionAttrs noFunctionAttrs = FunctionAttrs { isInline = False, isNoreturn = False } @@ -314,14 +313,14 @@ | Auto Register -- ^ automatic storage (optional: register) | Static Linkage ThreadLocal -- ^ static storage, linkage spec and thread local specifier (gnu c) | FunLinkage Linkage -- ^ function, either internal or external linkage - deriving (Typeable, Data, Show, Eq, Ord) + deriving (Data, Show, Eq, Ord) type ThreadLocal = Bool type Register = Bool -- | Linkage: Either no linkage, internal to the translation unit or external data Linkage = NoLinkage | InternalLinkage | ExternalLinkage - deriving (Typeable, Data, Show, Eq, Ord) + deriving (Data, Show, Eq, Ord) -- | return @True@ if the object has linkage hasLinkage :: Storage -> Bool @@ -353,14 +352,14 @@ -- ^ function type | TypeDefType TypeDefRef TypeQuals Attributes -- ^ a defined type - deriving (Typeable, Data, Show) + deriving (Data, Show) -- | Function types are of the form @FunType return-type params isVariadic@. -- -- If the parameter types aren't yet known, the function has type @FunTypeIncomplete type attrs@. data FunType = FunType Type [ParamDecl] Bool | FunTypeIncomplete Type - deriving (Typeable, Data, Show) + deriving (Data, Show) -- | An array type may either have unknown size or a specified array size, the latter either variable or constant. -- Furthermore, when used as a function parameters, the size may be qualified as /static/. @@ -369,7 +368,7 @@ -- ^ @UnknownArraySize is-starred@ | ArraySize Bool Expr -- ^ @FixedSizeArray is-static size-expr@ - deriving (Typeable, Data, Show) + deriving (Data, Show) -- | normalized type representation data TypeName = @@ -380,17 +379,17 @@ | TyComp CompTypeRef | TyEnum EnumTypeRef | TyBuiltin BuiltinType - deriving (Typeable, Data, Show) + deriving (Data, Show) -- | Builtin type (va_list, anything) data BuiltinType = TyVaList | TyAny - deriving (Typeable, Data, Show) + deriving (Data, Show) -- | typdef references -- If the actual type is known, it is attached for convenience data TypeDefRef = TypeDefRef Ident Type NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) -- | integral types (C99 6.7.2.2) data IntType = @@ -408,7 +407,7 @@ | TyULong | TyLLong | TyULLong - deriving (Typeable, Data, Eq, Ord) + deriving (Data, Eq, Ord) instance Show IntType where show TyBool = "_Bool" @@ -431,29 +430,31 @@ TyFloat | TyDouble | TyLDouble + | TyBFloat16 | TyFloatN Int Bool - deriving (Typeable, Data, Eq, Ord) + deriving (Data, Eq, Ord) instance Show FloatType where show TyFloat = "float" show TyDouble = "double" show TyLDouble = "long double" + show TyBFloat16 = "__bf16" show (TyFloatN n x) = "_Float" ++ (show n) ++ (if x then "x" else "") -- | composite type declarations data CompTypeRef = CompTypeRef SUERef CompTyKind NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance HasSUERef CompTypeRef where sueRef (CompTypeRef ref _ _) = ref instance HasCompTyKind CompTypeRef where compTag (CompTypeRef _ tag _) = tag data EnumTypeRef = EnumTypeRef SUERef NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance HasSUERef EnumTypeRef where sueRef (EnumTypeRef ref _) = ref -- | Composite type (struct or union). data CompType = CompType SUERef CompTyKind [MemberDecl] Attributes NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance HasSUERef CompType where sueRef (CompType ref _ _ _ _) = ref instance HasCompTyKind CompType where compTag (CompType _ tag _ _ _) = tag @@ -464,7 +465,7 @@ -- | a tag to determine wheter we refer to a @struct@ or @union@, see 'CompType'. data CompTyKind = StructTag | UnionTag - deriving (Eq,Ord,Typeable,Data) + deriving (Eq,Ord,Data) instance Show CompTyKind where show StructTag = "struct" @@ -473,7 +474,7 @@ -- | Representation of C enumeration types data EnumType = EnumType SUERef [Enumerator] Attributes NodeInfo -- ^ @EnumType name enumeration-constants attrs node@ - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance HasSUERef EnumType where sueRef (EnumType ref _ _ _) = ref @@ -483,7 +484,7 @@ -- | An Enumerator consists of an identifier, a constant expressions and the link to its type data Enumerator = Enumerator Ident Expr EnumType NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) instance Declaration Enumerator where getVarDecl (Enumerator ide _ enumty _) = VarDecl @@ -496,7 +497,7 @@ restrict :: Bool, atomic :: Bool, nullable :: Bool, nonnull :: Bool, clrdonly :: Bool, clwronly :: Bool } - deriving (Typeable, Data, Show) + deriving (Data, Show) instance Eq TypeQuals where (==) (TypeQuals c1 v1 r1 a1 n1 nn1 rd1 wr1) (TypeQuals c2 v2 r2 a2 n2 nn2 rd2 wr2) = @@ -539,7 +540,7 @@ -- | @VarName name assembler-name@ is a name of an declared object data VarName = VarName Ident (Maybe AsmName) | NoName - deriving (Typeable, Data, Show) + deriving (Data, Show) identOfVarName :: VarName -> Ident identOfVarName NoName = error "identOfVarName: NoName" identOfVarName (VarName ident _) = ident @@ -573,7 +574,7 @@ -- -- /TODO/: ultimatively, we want to parse attributes and represent them in a typed way data Attr = Attr Ident [Expr] NodeInfo - deriving (Typeable, Data {-! ,CNode !-}, Show) + deriving (Data {-! ,CNode !-}, Show) type Attributes = [Attr] diff --git a/src/Language/C/Data/Error.hs b/src/Language/C/Data/Error.hs --- a/src/Language/C/Data/Error.hs +++ b/src/Language/C/Data/Error.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} ----------------------------------------------------------------------------- -- | -- Module : Language.C.Data.Error @@ -28,7 +28,8 @@ internalErr, ) where -import Data.Typeable + +import Data.Typeable (Typeable, cast) import Language.C.Data.Node import Language.C.Data.Position @@ -49,7 +50,7 @@ isHardError = ( > LevelWarn) . errorLevel -- | information attached to every error in Language.C -data ErrorInfo = ErrorInfo ErrorLevel Position [String] deriving Typeable +data ErrorInfo = ErrorInfo ErrorLevel Position [String] -- to facilitate newtype deriving instance Show ErrorInfo where show = showErrorInfo "error" @@ -63,8 +64,8 @@ -- | `supertype' of all errors data CError = forall err. (Error err) => CError err - deriving Typeable + -- | errors in Language.C are instance of 'Error' class (Typeable e, Show e) => Error e where -- | obtain source location etc. of an error @@ -72,7 +73,7 @@ -- | wrap error in 'CError' toError :: e -> CError -- | try to cast a generic 'CError' to the specific error type - fromError :: CError -> (Maybe e) + fromError :: CError -> Maybe e -- | modify the error level changeErrorLevel :: e -> ErrorLevel -> e @@ -105,7 +106,7 @@ errorMsgs = ( \(ErrorInfo _ _ msgs) -> msgs ) . errorInfo -- | error raised if a operation requires an unsupported or not yet implemented feature. -data UnsupportedFeature = UnsupportedFeature String Position deriving Typeable +data UnsupportedFeature = UnsupportedFeature String Position instance Error UnsupportedFeature where errorInfo (UnsupportedFeature msg pos) = ErrorInfo LevelError pos (lines msg) instance Show UnsupportedFeature where show = showError "Unsupported Feature" @@ -118,7 +119,7 @@ -- | unspecified error raised by the user (in case the user does not want to define -- her own error types). -newtype UserError = UserError ErrorInfo deriving Typeable +newtype UserError = UserError ErrorInfo instance Error UserError where errorInfo (UserError info) = info instance Show UserError where show = showError "User Error" @@ -147,7 +148,7 @@ header ++ showMsgLines (if null short_msg then msgs else short_msg:msgs) where header = showPos pos ++ "[" ++ show level ++ "]" - showPos p | isSourcePos p = (posFile p) ++ ":" ++ show (posRow pos) ++ ": " ++ + showPos p | isSourcePos p = posFile p ++ ":" ++ show (posRow pos) ++ ": " ++ "(column " ++ show (posColumn pos) ++ ") " | otherwise = show p ++ ":: " showMsgLines [] = internalErr "No short message or error message provided." diff --git a/src/Language/C/Data/Ident.hs b/src/Language/C/Data/Ident.hs --- a/src/Language/C/Data/Ident.hs +++ b/src/Language/C/Data/Ident.hs @@ -29,7 +29,6 @@ import Language.C.Data.Node import Language.C.Data.Name (Name) import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Control.DeepSeq (NFData) @@ -38,7 +37,7 @@ -- name (anonymous types). data SUERef = AnonymousRef Name | NamedRef Ident - deriving (Typeable, Data, Ord, Eq, Show, Generic) --, Read + deriving (Data, Ord, Eq, Show, Generic) --, Read instance NFData SUERef @@ -51,7 +50,7 @@ data Ident = Ident String -- lexeme {-# UNPACK #-} !Int -- hash to speed up equality check NodeInfo -- attributes of this ident. incl. position - deriving (Data,Typeable,Show, Generic) -- Read + deriving (Data,Show, Generic) -- Read instance NFData Ident diff --git a/src/Language/C/Data/InputStream.hs b/src/Language/C/Data/InputStream.hs --- a/src/Language/C/Data/InputStream.hs +++ b/src/Language/C/Data/InputStream.hs @@ -71,15 +71,12 @@ takeByte bs = BSW.head bs `seq` (BSW.head bs, BSW.tail bs) takeChar bs = BSC.head bs `seq` (BSC.head bs, BSC.tail bs) inputStreamEmpty = BSW.null -#ifndef __HADDOCK__ -takeChars !n bstr = BSC.unpack $ BSC.take n bstr --leaks -#endif +takeChars !n bstr = BSC.unpack $ BSC.take n bstr readInputStream = BSW.readFile inputStreamToString = BSC.unpack inputStreamFromString = BSC.pack countLines = length . BSC.lines - #else diff --git a/src/Language/C/Data/Name.hs b/src/Language/C/Data/Name.hs --- a/src/Language/C/Data/Name.hs +++ b/src/Language/C/Data/Name.hs @@ -14,13 +14,12 @@ ) where import Data.Data (Data) import Data.Ix -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Control.DeepSeq (NFData) -- | Name is a unique identifier newtype Name = Name { nameId :: Int } - deriving (Show, Read, Eq, Ord, Ix, Data, Typeable, Generic) + deriving (Show, Read, Eq, Ord, Ix, Data, Generic) instance NFData Name diff --git a/src/Language/C/Data/Node.hs b/src/Language/C/Data/Node.hs --- a/src/Language/C/Data/Node.hs +++ b/src/Language/C/Data/Node.hs @@ -22,14 +22,13 @@ import Language.C.Data.Position import Language.C.Data.Name (Name) import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Control.DeepSeq (NFData) -- | Parsed entity attribute data NodeInfo = OnlyPos Position {-# UNPACK #-} !PosLength -- only pos and last token (for internal stuff only) | NodeInfo Position {-# UNPACK #-} !PosLength !Name -- pos, last token and unique name - deriving (Data,Typeable,Eq,Ord, Generic) + deriving (Data,Eq,Ord, Generic) instance NFData NodeInfo diff --git a/src/Language/C/Data/Position.hs b/src/Language/C/Data/Position.hs --- a/src/Language/C/Data/Position.hs +++ b/src/Language/C/Data/Position.hs @@ -28,7 +28,6 @@ Pos(..), ) where import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Control.DeepSeq (NFData) @@ -36,7 +35,7 @@ data FilePosition = FilePosition { posSrcFile :: String, -- ^ source file posParentFile :: (Maybe Position) -- ^ including file, if any } - deriving (Eq, Ord, Typeable, Data, Generic) + deriving (Eq, Ord, Data, Generic) instance NFData FilePosition @@ -50,7 +49,7 @@ | NoPosition | BuiltinPosition | InternalPosition - deriving (Eq, Ord, Typeable, Data, Generic) + deriving (Eq, Ord, Data, Generic) instance NFData Position diff --git a/src/Language/C/Parser/Lexer.x b/src/Language/C/Parser/Lexer.x --- a/src/Language/C/Parser/Lexer.x +++ b/src/Language/C/Parser/Lexer.x @@ -311,6 +311,10 @@ volatile @__, while, label __label__ +BFloat16 __bf16 +(CTokFloatN 16 False) __fp16 +(CTokFloatN 16 False) _Float16 +(CTokFloatN 16 True) _Float16x (CTokFloatN 32 False) _Float32 (CTokFloatN 32 True) _Float32x (CTokFloatN 64 False) _Float64 @@ -328,13 +332,17 @@ (flip CTokClangC ClangBuiltinConvertVector) __builtin_convertvector -} --- Tokens: _Alignas _Alignof __alignof alignof __alignof__ __asm asm __asm__ _Atomic auto break _Bool case char __const const __const__ continue _Complex __complex__ default do double else enum extern float for _Generic goto if __inline inline __inline__ int __int128_t long _Noreturn _Nullable __nullable _Nonnull __nonnull register __restrict restrict __restrict__ return short __signed signed __signed__ sizeof static _Static_assert struct switch typedef __typeof typeof __typeof__ __thread _Thread_local __uint128 __uint128_t union unsigned void __volatile volatile __volatile__ while __label__ _Float32 _Float32x _Float64 _Float64x _Float128 __float128 _Float128x __attribute __attribute__ __extension__ __real __real__ __imag __imag__ __builtin_va_arg __builtin_offsetof __builtin_types_compatible_p __builtin_bit_cast __builtin_convertvector +-- Tokens: _Alignas _Alignof __alignof alignof __alignof__ __asm asm __asm__ _Atomic auto break _Bool case char __const const __const__ continue _Complex __complex__ default do double else enum extern float for _Generic goto if __inline inline __inline__ int __int128_t long _Noreturn _Nullable __nullable _Nonnull __nonnull register __restrict restrict __restrict__ return short __signed signed __signed__ sizeof static _Static_assert struct switch typedef __typeof typeof __typeof__ __thread _Thread_local __uint128 __uint128_t union unsigned void __volatile volatile __volatile__ while __label__ __bf16 __fp16 _Float16 _Float16x _Float32 _Float32x _Float64 _Float64x _Float128 __float128 _Float128x __attribute __attribute__ __extension__ __real __real__ __imag __imag__ __builtin_va_arg __builtin_offsetof __builtin_types_compatible_p __builtin_bit_cast __builtin_convertvector idkwtok ('_' : 'A' : 'l' : 'i' : 'g' : 'n' : 'a' : 's' : []) = tok 8 CTokAlignas idkwtok ('_' : 'A' : 'l' : 'i' : 'g' : 'n' : 'o' : 'f' : []) = tok 8 CTokAlignof idkwtok ('_' : 'A' : 't' : 'o' : 'm' : 'i' : 'c' : []) = tok 7 CTokAtomic idkwtok ('_' : 'B' : 'o' : 'o' : 'l' : []) = tok 5 CTokBool idkwtok ('_' : 'C' : 'o' : 'm' : 'p' : 'l' : 'e' : 'x' : []) = tok 8 CTokComplex +idkwtok ('_' : '_' : 'b' : 'f' : '1' : '6' : []) = tok 6 CTokBFloat16 +idkwtok ('_' : '_' : 'f' : 'p' : '1' : '6' : []) = tok 6 (CTokFloatN 16 False) #ifdef IEC_60559_TYPES_EXT +idkwtok ('_' : 'F' : 'l' : 'o' : 'a' : 't' : '1' : '6' : []) = tok 8 (CTokFloatN 16 False) +idkwtok ('_' : 'F' : 'l' : 'o' : 'a' : 't' : '1' : '6' : 'x' : []) = tok 9 (CTokFloatN 16 True) idkwtok ('_' : 'F' : 'l' : 'o' : 'a' : 't' : '1' : '2' : '8' : []) = tok 9 (CTokFloatN 128 False) idkwtok ('_' : 'F' : 'l' : 'o' : 'a' : 't' : '1' : '2' : '8' : 'x' : []) = tok 10 (CTokFloatN 128 True) idkwtok ('_' : 'F' : 'l' : 'o' : 'a' : 't' : '3' : '2' : []) = tok 8 (CTokFloatN 32 False) diff --git a/src/Language/C/Parser/Parser.y b/src/Language/C/Parser/Parser.y --- a/src/Language/C/Parser/Parser.y +++ b/src/Language/C/Parser/Parser.y @@ -29,6 +29,8 @@ -- ------------------------------------------------------------------ { +{-# LANGUAGE LambdaCase #-} + module Language.C.Parser.Parser ( -- * Parse a C translation unit parseC, @@ -106,6 +108,7 @@ import Prelude import qualified Data.List as List import Control.Monad (mplus) +import Data.Maybe (listToMaybe, mapMaybe) import Language.C.Parser.Builtin (builtinTypeNames) import Language.C.Parser.Lexer (lexC, parseError) import Language.C.Parser.Tokens (CToken(..), GnuCTok(..), ClangCTok (..), posLenOfTok) @@ -202,6 +205,10 @@ enum { CTokEnum _ } extern { CTokExtern _ } float { CTokFloat _ } +"__bf16" { CTokBFloat16 _ } +"__fp16" { CTokFloatN 16 False _ } +"_Float16" { CTokFloatN 16 False _ } +"_Float16x" { CTokFloatN 16 True _ } "_Float32" { CTokFloatN 32 False _ } "_Float32x" { CTokFloatN 32 True _ } "_Float64" { CTokFloatN 64 False _ } @@ -897,7 +904,13 @@ | "_Bool" {% withNodeInfo $1 $ CBoolType } | "_Complex" {% withNodeInfo $1 $ CComplexType } | "__int128" {% withNodeInfo $1 $ CInt128Type } + | "__int128_t" {% withNodeInfo $1 $ CInt128Type } | "__uint128" {% withNodeInfo $1 $ CUInt128Type } + | "__uint128_t" {% withNodeInfo $1 $ CUInt128Type } + | "__bf16" {% withNodeInfo $1 $ CBFloat16Type } + | "__fp16" {% withNodeInfo $1 $ (CFloatNType 16 False) } + | "_Float16" {% withNodeInfo $1 $ (CFloatNType 16 False) } + | "_Float16x" {% withNodeInfo $1 $ (CFloatNType 16 True) } | "_Float32" {% withNodeInfo $1 $ (CFloatNType 32 False) } | "_Float32x" {% withNodeInfo $1 $ (CFloatNType 32 True) } | "_Float64" {% withNodeInfo $1 $ (CFloatNType 64 False) } @@ -1119,10 +1132,8 @@ struct_or_union_specifier : struct_or_union attrs_opt identifier '{' struct_declaration_list '}' {% withNodeInfo $1 $ CStruct (unL $1) (Just $3) (Just$ RList.reverse $5) $2 } - | struct_or_union attrs_opt '{' struct_declaration_list '}' {% withNodeInfo $1 $ CStruct (unL $1) Nothing (Just$ RList.reverse $4) $2 } - | struct_or_union attrs_opt identifier {% withNodeInfo $1 $ CStruct (unL $1) (Just $3) Nothing $2 } @@ -1137,7 +1148,8 @@ struct_declaration_list : {- empty -} { RList.empty } | struct_declaration_list ';' { $1 } - | struct_declaration_list struct_declaration { $1 `RList.snoc` $2 } + | struct_declaration_list struct_declaration { $1 `RList.snoc` maybe $2 (addAlign $2) (containsAlign $1) } + | struct_declaration_list alignment_specifier struct_declaration { $1 `RList.snoc` ( addAlign $3 $2 )} -- parse C structure declaration (C99 6.7.2.1) @@ -2170,6 +2182,22 @@ | attribute_params ',' unary_expression assignment_operator clang_version_literal { $1 } { + +containsAlign :: Reversed [CDecl] -> Maybe CAlignSpec +containsAlign (Reversed input) = listToMaybe $ mapMaybe checkDecl input + where + checkDecl :: CDecl -> Maybe CAlignSpec + checkDecl = \case + CDecl list _ _ -> listToMaybe $ mapMaybe isAlignSpec list + _ -> Nothing + + isAlignSpec :: CDeclSpec -> Maybe CAlignSpec + isAlignSpec = \case + CAlignSpec x -> Just x + _ -> Nothing + +addAlign :: CDecl -> CAlignmentSpecifier NodeInfo -> CDecl +addAlign (CDecl list list2 a) align = CDecl (CAlignSpec align : list) list2 a -- sometimes it is neccessary to reverse an unreversed list reverseList :: [a] -> Reversed [a] diff --git a/src/Language/C/Parser/Tokens.hs b/src/Language/C/Parser/Tokens.hs --- a/src/Language/C/Parser/Tokens.hs +++ b/src/Language/C/Parser/Tokens.hs @@ -92,7 +92,10 @@ | CTokEnum !PosLength -- `enum' | CTokExtern !PosLength -- `extern' | CTokFloat !PosLength -- `float' - | CTokFloatN !Int !Bool !PosLength -- `__float128' or `_Float{32,64,128}{,x}` + | CTokBFloat16 !PosLength -- `__bf16' + | CTokFloatN !Int !Bool !PosLength -- (or `__float128', + -- `__fp16', + -- `_Float{16,32,64,128}{,x}`) | CTokFor !PosLength -- `for' | CTokGeneric !PosLength -- `_Generic' | CTokGoto !PosLength -- `goto' @@ -235,6 +238,7 @@ posLenOfTok (CTokEnum pos ) = pos posLenOfTok (CTokExtern pos ) = pos posLenOfTok (CTokFloat pos ) = pos +posLenOfTok (CTokBFloat16 pos ) = pos posLenOfTok (CTokFloatN _ _ pos) = pos posLenOfTok (CTokFor pos ) = pos posLenOfTok (CTokGeneric pos ) = pos @@ -348,6 +352,7 @@ showsPrec _ (CTokEnum _ ) = showString "enum" showsPrec _ (CTokExtern _ ) = showString "extern" showsPrec _ (CTokFloat _ ) = showString "float" + showsPrec _ (CTokBFloat16 _ ) = showString "__bf16" showsPrec _ (CTokFloatN n x _) = showString "_Float" . shows n . showString (if x then "x" else "") showsPrec _ (CTokFor _ ) = showString "for" diff --git a/src/Language/C/Pretty.hs b/src/Language/C/Pretty.hs --- a/src/Language/C/Pretty.hs +++ b/src/Language/C/Pretty.hs @@ -248,6 +248,7 @@ pretty (CIntType _) = text "int" pretty (CLongType _) = text "long" pretty (CFloatType _) = text "float" + pretty (CBFloat16Type _) = text "__bf16" pretty (CFloatNType n x _) = text "_Float" <> text (show n) <> (if x then text "x" else empty) pretty (CDoubleType _) = text "double" diff --git a/src/Language/C/Syntax/AST.hs b/src/Language/C/Syntax/AST.hs --- a/src/Language/C/Syntax/AST.hs +++ b/src/Language/C/Syntax/AST.hs @@ -63,7 +63,6 @@ import Language.C.Data.Node import Language.C.Data.Position import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics (Generic, Generic1) import Control.DeepSeq (NFData) @@ -74,7 +73,7 @@ type CTranslUnit = CTranslationUnit NodeInfo data CTranslationUnit a = CTranslUnit [CExternalDeclaration a] a - deriving (Show, Data, Typeable, Generic, Generic1 {-! ,CNode ,Functor, Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor, Annotated !-}) instance NFData a => NFData (CTranslationUnit a) @@ -86,7 +85,7 @@ = CDeclExt (CDeclaration a) | CFDefExt (CFunctionDef a) | CAsmExt (CStringLiteral a) a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor, Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor, Annotated !-}) instance NFData a => NFData (CExternalDeclaration a) @@ -111,7 +110,7 @@ [CDeclaration a] -- optional declaration list (CStatement a) -- compound statement a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CFunctionDef a) @@ -169,7 +168,7 @@ (CExpression a) -- assert expression (CStringLiteral a) -- assert text a -- annotation - deriving (Show, Data,Typeable, Generic {-! ,CNode ,Annotated !-}) + deriving (Show, Data, Generic {-! ,CNode ,Annotated !-}) instance NFData a => NFData (CDeclaration a) @@ -228,7 +227,7 @@ type CDeclr = CDeclarator NodeInfo data CDeclarator a = CDeclr (Maybe Ident) [CDerivedDeclarator a] (Maybe (CStringLiteral a)) [CAttribute a] a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CDeclarator a) @@ -251,7 +250,7 @@ -- ^ Array declarator @CArrDeclr declr tyquals size-expr?@ | CFunDeclr (Either [Ident] ([CDeclaration a],Bool)) [CAttribute a] a -- ^ Function declarator @CFunDeclr declr (old-style-params | new-style-params) c-attrs@ - deriving (Show, Data,Typeable, Generic {-! ,CNode , Annotated !-}) + deriving (Show, Data, Generic {-! ,CNode , Annotated !-}) instance NFData a => NFData (CDerivedDeclarator a) @@ -270,7 +269,7 @@ data CArraySize a = CNoArrSize Bool -- ^ @CUnknownSize isCompleteType@ | CArrSize Bool (CExpression a) -- ^ @CArrSize isStatic expr@ - deriving (Show, Data,Typeable, Generic, Generic1 {-! , Functor !-}) + deriving (Show, Data, Generic, Generic1 {-! , Functor !-}) instance NFData a => NFData (CArraySize a) @@ -318,7 +317,7 @@ | CReturn (Maybe (CExpression a)) a -- | assembly statement | CAsm (CAssemblyStatement a) a - deriving (Show, Data,Typeable, Generic {-! , CNode , Annotated !-}) + deriving (Show, Data, Generic {-! , CNode , Annotated !-}) instance NFData a => NFData (CStatement a) @@ -369,7 +368,7 @@ [CAssemblyOperand a] -- input operands [CStringLiteral a] -- Clobbers a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CAssemblyStatement a) @@ -384,7 +383,7 @@ (CStringLiteral a) -- constraint expr (CExpression a) -- argument a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CAssemblyOperand a) @@ -397,7 +396,7 @@ = CBlockStmt (CStatement a) -- ^ A statement | CBlockDecl (CDeclaration a) -- ^ A local declaration | CNestedFunDef (CFunctionDef a) -- ^ A nested function (GNU C) - deriving (Show, Data,Typeable, Generic, Generic1 {-! , CNode , Functor, Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! , CNode , Functor, Annotated !-}) instance NFData a => NFData (CCompoundBlockItem a) @@ -412,7 +411,7 @@ | CTypeQual (CTypeQualifier a) -- ^ type qualifier | CFunSpec (CFunctionSpecifier a) -- ^ function specifier | CAlignSpec (CAlignmentSpecifier a) -- ^ alignment specifier - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor, Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor, Annotated !-}) instance NFData a => NFData (CDeclarationSpecifier a) @@ -444,7 +443,7 @@ | CClKernel a -- ^ OpenCL kernel function | CClGlobal a -- ^ OpenCL __global variable | CClLocal a -- ^ OpenCL __local variable - deriving (Show, Eq,Ord,Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Eq,Ord,Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CStorageSpecifier a) @@ -469,6 +468,7 @@ | CComplexType a | CInt128Type a | CUInt128Type a + | CBFloat16Type a | CFloatNType Int Bool a -- ^ IEC 60227: width (32,64,128), extended flag | CSUType (CStructureUnion a) a -- ^ Struct or Union specifier | CEnumType (CEnumeration a) a -- ^ Enumeration specifier @@ -476,7 +476,7 @@ | CTypeOfExpr (CExpression a) a -- ^ @typeof(expr)@ | CTypeOfType (CDeclaration a) a -- ^ @typeof(type)@ | CAtomicType (CDeclaration a) a -- ^ @_Atomic(type)@ - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CTypeSpecifier a) @@ -502,7 +502,7 @@ | CNonnullQual a | CClRdOnlyQual a | CClWrOnlyQual a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CTypeQualifier a) @@ -513,7 +513,7 @@ data CFunctionSpecifier a = CInlineQual a | CNoreturnQual a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CFunctionSpecifier a) @@ -523,7 +523,7 @@ data CAlignmentSpecifier a = CAlignAsType (CDeclaration a) a -- ^ @_Alignas(type)@ | CAlignAsExpr (CExpression a) a -- ^ @_Alignas(expr)@ - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CAlignmentSpecifier a) @@ -545,14 +545,14 @@ (Maybe [CDeclaration a]) -- member declarations [CAttribute a] -- __attribute__s a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CStructureUnion a) -- | A tag to determine wheter we refer to a @struct@ or @union@, see 'CStructUnion'. data CStructTag = CStructTag | CUnionTag - deriving (Show, Eq,Data,Typeable, Generic) + deriving (Show, Eq,Data, Generic) instance NFData CStructTag @@ -576,7 +576,7 @@ Maybe (CExpression a))]) -- explicit variant value [CAttribute a] -- __attribute__s a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CEnumeration a) @@ -591,7 +591,7 @@ = CInitExpr (CExpression a) a -- | initialization list (see 'CInitList') | CInitList (CInitializerList a) a - deriving (Show, Data,Typeable, Generic {-! ,CNode , Annotated !-}) + deriving (Show, Data, Generic {-! ,CNode , Annotated !-}) instance NFData a => NFData (CInitializer a) @@ -643,7 +643,7 @@ | CMemberDesig Ident a -- | array range designator @CRangeDesig from to _@ (GNU C) | CRangeDesig (CExpression a) (CExpression a) a - deriving (Show, Data,Typeable, Generic {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CPartDesignator a) @@ -653,7 +653,7 @@ -- and serve as generic properties of some syntax tree elements. type CAttr = CAttribute NodeInfo data CAttribute a = CAttr Ident [CExpression a] a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CAttribute a) @@ -718,7 +718,7 @@ | CStatExpr (CStatement a) a -- ^ GNU C compound statement as expr | CLabAddrExpr Ident a -- ^ GNU C address of label | CBuiltinExpr (CBuiltinThing a) -- ^ builtin expressions, see 'CBuiltin' - deriving (Data,Typeable,Show, Generic {-! ,CNode , Annotated !-}) + deriving (Data,Show, Generic {-! ,CNode , Annotated !-}) instance NFData a => NFData (CExpression a) @@ -764,7 +764,7 @@ | CBuiltinTypesCompatible (CDeclaration a) (CDeclaration a) a -- ^ @(type,type)@ | CBuiltinConvertVector (CExpression a) (CDeclaration a) a -- ^ @(expr, type)@ | CBuiltinBitCast (CDeclaration a) (CExpression a) a -- ^ @(type, expr)@ - deriving (Show, Data,Typeable, Generic {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CBuiltinThing a) @@ -775,14 +775,14 @@ | CCharConst CChar a | CFloatConst CFloat a | CStrConst CString a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CConstant a) -- | Attributed string literals type CStrLit = CStringLiteral NodeInfo data CStringLiteral a = CStrLit CString a - deriving (Show, Data,Typeable, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) + deriving (Show, Data, Generic, Generic1 {-! ,CNode ,Functor ,Annotated !-}) instance NFData a => NFData (CStringLiteral a) @@ -1090,6 +1090,7 @@ nodeInfo (CShortType d) = nodeInfo d nodeInfo (CIntType d) = nodeInfo d nodeInfo (CLongType d) = nodeInfo d + nodeInfo (CBFloat16Type d) = nodeInfo d nodeInfo (CFloatType d) = nodeInfo d nodeInfo (CFloatNType _ _ d) = nodeInfo d nodeInfo (CDoubleType d) = nodeInfo d @@ -1115,6 +1116,7 @@ fmap _f (CIntType a1) = CIntType (_f a1) fmap _f (CLongType a1) = CLongType (_f a1) fmap _f (CFloatType a1) = CFloatType (_f a1) + fmap _f (CBFloat16Type a1) = CBFloat16Type (_f a1) fmap _f (CFloatNType n x a1) = CFloatNType n x (_f a1) fmap _f (CDoubleType a1) = CDoubleType (_f a1) fmap _f (CSignedType a1) = CSignedType (_f a1) @@ -1137,6 +1139,7 @@ annotation (CIntType n) = n annotation (CLongType n) = n annotation (CFloatType n) = n + annotation (CBFloat16Type n) = n annotation (CFloatNType _ _ n) = n annotation (CDoubleType n) = n annotation (CSignedType n) = n @@ -1157,6 +1160,7 @@ amap f (CIntType a_1) = CIntType (f a_1) amap f (CLongType a_1) = CLongType (f a_1) amap f (CFloatType a_1) = CFloatType (f a_1) + amap f (CBFloat16Type a_1) = CBFloat16Type (f a_1) amap f (CFloatNType n x a_1) = CFloatNType n x (f a_1) amap f (CDoubleType a_1) = CDoubleType (f a_1) amap f (CSignedType a_1) = CSignedType (f a_1) diff --git a/src/Language/C/Syntax/Constants.hs b/src/Language/C/Syntax/Constants.hs --- a/src/Language/C/Syntax/Constants.hs +++ b/src/Language/C/Syntax/Constants.hs @@ -31,7 +31,6 @@ import Data.Char import Numeric (showOct, showHex, readHex, readOct, readDec) import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics (Generic, Generic1) import Control.DeepSeq (NFData) @@ -42,7 +41,7 @@ | CChars [Char] -- multi-character character constant !Bool -- wide flag - deriving (Eq,Ord,Data,Typeable,Generic) + deriving (Eq,Ord,Data,Generic) instance Show CChar where showsPrec _ (CChar c wideflag) = _showWideFlag wideflag . showCharConst c @@ -89,13 +88,13 @@ -- | datatype for memorizing the representation of an integer data CIntRepr = DecRepr | HexRepr | OctalRepr - deriving (Eq,Ord,Enum,Bounded,Data,Typeable,Generic) + deriving (Eq,Ord,Enum,Bounded,Data,Generic) instance NFData CIntRepr -- | datatype representing type flags for integers data CIntFlag = FlagUnsigned | FlagLong | FlagLongLong | FlagImag - deriving (Eq,Ord,Enum,Bounded,Data,Typeable,Generic) + deriving (Eq,Ord,Enum,Bounded,Data,Generic) instance Show CIntFlag where show FlagUnsigned = "u" show FlagLong = "L" @@ -111,7 +110,7 @@ !Integer !CIntRepr !(Flags CIntFlag) -- integer flags - deriving (Eq,Ord,Data,Typeable,Generic) + deriving (Eq,Ord,Data,Generic) instance Show CInteger where showsPrec _ (CInteger ig repr flags) = showInt ig . showString (concatMap showIFlag [FlagUnsigned .. ]) where showIFlag f = if testFlag f flags then show f else [] @@ -153,7 +152,7 @@ -- | Floats (represented as strings) data CFloat = CFloat !String - deriving (Eq,Ord,Data,Typeable,Generic) + deriving (Eq,Ord,Data,Generic) instance Show CFloat where showsPrec _ (CFloat internal) = showString internal instance NFData CFloat @@ -169,7 +168,7 @@ -- data ClangCVersion = ClangCVersion !String - deriving (Eq,Ord,Data,Typeable) + deriving (Eq,Ord,Data) instance Show ClangCVersion where showsPrec _ (ClangCVersion internal) = showString internal @@ -180,7 +179,7 @@ data CString = CString String -- characters Bool -- wide flag - deriving (Eq,Ord,Data,Typeable, Generic) + deriving (Eq,Ord,Data, Generic) instance Show CString where showsPrec _ (CString str wideflag) = _showWideFlag wideflag . showStringLit str instance NFData CString @@ -297,7 +296,7 @@ head' _ (x:_) = x -- TODO: Move to separate file ? -newtype Flags f = Flags Integer deriving (Eq,Ord,Data,Typeable,Generic,Generic1) +newtype Flags f = Flags Integer deriving (Eq,Ord,Data,Generic,Generic1) instance NFData (Flags f) noFlags :: Flags f noFlags = Flags 0 diff --git a/src/Language/C/Syntax/Ops.hs b/src/Language/C/Syntax/Ops.hs --- a/src/Language/C/Syntax/Ops.hs +++ b/src/Language/C/Syntax/Ops.hs @@ -26,7 +26,6 @@ ) where import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Control.DeepSeq (NFData) -- | C assignment operators (K&R A7.17) @@ -41,7 +40,7 @@ | CAndAssOp | CXorAssOp | COrAssOp - deriving (Eq,Ord,Show,Data,Typeable,Generic) + deriving (Eq,Ord,Show,Data,Generic) instance NFData CAssignOp @@ -78,7 +77,7 @@ | COrOp -- ^ inclusive bitwise or | CLndOp -- ^ logical and | CLorOp -- ^ logical or - deriving (Eq,Ord,Show,Data,Typeable,Generic) + deriving (Eq,Ord,Show,Data,Generic) instance NFData CBinaryOp @@ -106,7 +105,7 @@ | CMinOp -- ^ prefix minus | CCompOp -- ^ one's complement | CNegOp -- ^ logical negation - deriving (Eq,Ord,Show,Data,Typeable,Generic) + deriving (Eq,Ord,Show,Data,Generic) instance NFData CUnaryOp