modulo-1.7.3: src/Language/Modulo/C.hs
{-# LANGUAGE DisambiguateRecordFields, TypeFamilies,
StandaloneDeriving, DeriveFunctor, DeriveFoldable, GeneralizedNewtypeDeriving #-}
-------------------------------------------------------------------------------------
-- |
-- Copyright : (c) Hans Hoglund 2012
-- License : BSD-style
-- Maintainer : hans@hanshoglund.se
-- Stability : experimental
-- Portability : GHC
--
-- Renders module descriptions as C header files.
--
-------------------------------------------------------------------------------------
module Language.Modulo.C (
-- ** Styles
GuardStyle(..),
ImportStyle(..),
CStyle(..),
stdStyle,
cairoStyle,
gtkStyle,
appleStyle,
haskellStyle,
-- ** Conversion
translType,
translFun,
translConst,
translGlobal,
translStructField,
translUnionField,
translEnumField,
-- ** Rendering
printModule,
renderModule,
printModuleStyle,
renderModuleStyle,
printModuleComm,
) where
import Data.Default
import Data.Foldable (toList)
import Data.Semigroup
import Control.Arrow
import Language.Modulo
import Language.Modulo.Util
import Language.Modulo.Util.Mangle
import Language.Modulo.Util.Unmangle
import Language.C.Syntax.AST
import Language.C.Syntax.Constants
import Language.C.Parser
import Language.C.Pretty
import Language.C.Data.Node
import Language.C.Data.Ident
import Language.C.Data.Position
import Language.C.Data.InputStream
import qualified Data.List as List
import qualified Data.Char as Char
import qualified Data.List.NonEmpty as NonEmpty
-------------------------------------------------------------------------------------
-- Styles
-------------------------------------------------------------------------------------
data GuardStyle
= Pragma -- ^ Write pragma guards
| Ifndef -- ^ Write conditional guards
data ImportStyle
= SystemPath -- ^ Import external modules using system paths
| LocalPath -- ^ Import external modules using local paths
data CStyle =
CStyle {
-- Guards
guardStyle :: GuardStyle, -- ^ How to write guards
includeStyle :: ImportStyle, -- ^ How to write import declarations
includeDirective :: String, -- ^ Import directive, usually @include@.
guardMangler :: [String] -> String, -- ^ Mangler for names of header guards
innerHeader :: [String] -> String -> String, -- ^ Inner header mangler (receives module name, documentation)
innerFooter :: [String] -> String, -- ^ Inner footer mangler (receives module name)
-- Prefix
typePrefixMangler :: [String] -> String, -- ^ Prefix for types
valuePrefixMangler :: [String] -> String, -- ^ Prefix for values
-- Types
typeMangler :: [String] -> String, -- ^ Mangler for implementation struct names
-- Fields
structFieldMangler :: [String] -> String, -- ^ Mangler for struct fields
unionFieldMangler :: [String] -> String, -- ^ Mangler for union fields
enumFieldMangler :: [String] -> String, -- ^ Mangler for enum fields
-- Functions and values
constMangler :: [String] -> String, -- ^ Mangler for constant values
globalMangler :: [String] -> String, -- ^ Mangler for global variables
funcMangler :: [String] -> String -- ^ Mangler for global functions
-- Options
-- Wrap in extern C block
-- Add Doxygen stubs (which?)
-- Add <PREFIX>_API declaration
}
-- | Default instance using 'stdStyle'.
instance Default CStyle where
def = stdStyle
-- | Left-biased Semigroup instance.
instance Semigroup CStyle where
a <> b = a
-- | Left-biased Monoid instance.
instance Monoid CStyle where
mempty = def
mappend = (<>)
stdInnerHeader :: CStyle -> [String] -> String -> String
stdInnerHeader _ ns doc = begin ++ concat (post " @{\n" cs) ++ end
where
begin = "/** @addtogroup " ++ concat ns ++ "\n" ++ doc ++ "\n"
c1 = repeat " "
c2 = repeat "@defgroup "
c3 = map concat . drop 1 . List.inits $ ns
c4 = repeat " "
c5 = ns
c6 = repeat "\n"
cs = List.zipWith6 (\a b c d e f -> a ++ b ++ c ++ d ++ e ++ f) c1 c2 c3 c4 c5 c6
end = " */"
stdInnerFooter :: CStyle -> [String] -> String
stdInnerFooter _ ns = (concat $ List.zipWith (++) c1 c2) ++ end
where
c1 = ["/** "] ++ repeat " "
c2 = replicate (length ns) "@}\n"
end = " */"
-- |
-- Style used in the C standard library.
--
-- * Types: @ foo_bar_type_t @
--
-- * Functions: @ foo_bar_func @
--
-- * Constants: @ FOO_BAR_VAL @
--
-- * Fields: @ foo_bar @
stdStyle :: CStyle
stdStyle = CStyle
{
guardStyle = Ifndef,
includeStyle = SystemPath,
includeDirective = "include",
guardMangler = (withPrefix "_" . concatSep "_" . fmap toUpperString),
innerHeader = (stdInnerHeader stdStyle),
innerFooter = (stdInnerFooter stdStyle),
typePrefixMangler = (withSuffix "_" . concatSep "_" . fmap toLowerString),
valuePrefixMangler = (withSuffix "_" . concatSep "_" . fmap toLowerString),
typeMangler = (concatSep "_" . withSuffix ["t"] . fmap toLowerString),
structFieldMangler = (concatSep "_" . fmap toLowerString),
unionFieldMangler = (concatSep "_" . fmap toLowerString),
enumFieldMangler = (concatSep "_" . fmap toLowerString),
constMangler = (concatSep "_" . fmap toLowerString),
globalMangler = (concatSep "_" . fmap toLowerString),
funcMangler = (concatSep "_" . fmap toLowerString)
}
-- |
-- Style used in Cairo.
--
-- * Types: @ p_foo_bar_t @
--
-- * Opaques: @ _p_foo_bar_t @
--
-- * Functions: @ p_foo_bar @
--
-- * Constants: @ P_FOO_BAR @
--
-- * Fields: @ foo_bar @
cairoStyle :: CStyle
cairoStyle = CStyle
Ifndef SystemPath "include"
(withPrefix "_" . concatSep "_" . fmap toUpperString)
(stdInnerHeader cairoStyle)
(stdInnerFooter cairoStyle)
(concatSep "_")
(concatSep "_")
(concatSep "_" . withSuffix ["t"] . fmap toLowerString)
(concatSep "_")
(concatSep "_")
(concatSep "_")
(concatSep "_")
(concatSep "_")
(concatSep "_")
-- |
-- Style used in GTK.
--
-- * Types: @ PFooBar @
--
-- * Opaques: @ _PFooBar @
--
-- * Functions: @ p_foo_bar @
--
-- * Constants: @ P_FOO_BAR @
--
-- * Fields: @ foo_bar @
gtkStyle :: CStyle
gtkStyle = CStyle
Ifndef SystemPath "include"
(withPrefix "_" . concatSep "_" . fmap toUpperString)
(stdInnerHeader gtkStyle)
(stdInnerFooter gtkStyle)
(concatSep "_")
(concatSep "_")
capitalCase
(concatSep "_")
(concatSep "_")
(concatSep "_")
(concatSep "_")
(concatSep "_")
(concatSep "_")
-- |
-- Style used in Apple Frameworks.
--
-- * Types: @ PFooBar @
--
-- * Opaques: @ PFooBarOpaque @
--
-- * Functions: @ PFooBar @
--
-- * Constants: @ kPFooBar @
--
-- * Fields: @ mFooBar @
appleStyle :: CStyle
appleStyle = CStyle
Ifndef SystemPath "include"
(withPrefix "_" . concatSep "_" . fmap toUpperString)
(stdInnerHeader stdStyle)
(stdInnerFooter stdStyle)
(capitalCase)
(mixedCase)
capitalCase
(withPrefix "m" . capitalCase)
(withPrefix "m" . capitalCase)
(withPrefix "m" . capitalCase)
(withPrefix "k" . capitalCase)
(withPrefix "g" . capitalCase)
capitalCase
--
-- |
-- Style similar to Haskell conventions.
--
-- * Types: @ PFooBar @
--
-- * Opaques: @ PFooBarOpaque @
--
-- * Functions: @ pfooBar @
--
-- * Constants: @ pfooBar @
--
-- * Fields: @ pfooBar @
haskellStyle :: CStyle
haskellStyle = CStyle
Ifndef SystemPath "include"
(withPrefix "_" . concatSep "_" . fmap toUpperString)
(stdInnerHeader stdStyle)
(stdInnerFooter stdStyle)
(capitalCase)
(mixedCase)
capitalCase
mixedCase
mixedCase
mixedCase
mixedCase
mixedCase
mixedCase
-------------------------------------------------------------------------------------
-- Codegen
-------------------------------------------------------------------------------------
-- |
-- Print a module using the default style.
--
printModule :: Module -> String
printModule = printModuleStyle def
-- |
-- Print a module using the specified style.
--
printModuleStyle :: CStyle -> Module -> String
printModuleStyle style = (\(x,y,z) -> x ++ (show . pretty $ y) ++ z) . renderModuleStyle style
-- |
-- Render a module using the default style.
--
-- Returns a C header file, represented as a 'CTranslUnit' with enclosing header and footer strings.
--
renderModule :: Module -> (String, CTranslUnit, String)
renderModule = renderModuleStyle def
-- |
-- Render a module using the specified style.
--
-- Returns a C header file, represented as a 'CTranslUnit' with enclosing header and footer strings.
--
renderModuleStyle :: CStyle -> Module -> (String, CTranslUnit, String)
renderModuleStyle style mod = (header, decls, footer)
where
header = convertHeader style False mod'
decls = convertTopLevel style mod'
footer = convertFooter style mod'
mod' = flattenModule style mod
-- |
-- Print a module using the default style.
--
printModuleComm :: Module -> String
printModuleComm = printModuleStyleComm def
-- |
-- Print a module using the specified style.
--
printModuleStyleComm :: CStyle -> Module -> String
printModuleStyleComm style = (\(x,y,z) -> x ++ concatSep "\n\n" (map sdd y) ++ z) . renderModuleStyleComm style
where
sdd (doc, decl) = sd doc ++ "\n" ++ (show . pretty) decl ++ ";"
sd "" = ""
sd str = "/**" ++ (removeEmptyLast . deindent) str ++ "*/"
-- Hacky functions to remove strange indentation
deindent :: String -> String
deindent = unlines . fmap f . lines
where
f (' ':' ':' ':' ':' ':' ':' ':' ':xs) = " "++xs
f xs = xs
removeEmptyLast :: String -> String
removeEmptyLast = reverse . f . reverse
where
f ('\n':'\n':xs) = "\n"++xs
f ('\n':' ':' ':' ':' ':' ':'\n':xs) = "\n"++xs
f xs = xs
-- |
-- Render a module using the specified style, preserving comments.
--
-- Returns a C header file, represented as a 'CTranslUnit' with enclosing header and footer strings.
--
renderModuleStyleComm :: CStyle -> Module -> (String, [(String, CDecl)], String)
renderModuleStyleComm style mod = (header, decls, footer)
where
-- TODO module docs in header
header = convertHeader style True mod'
decls = convertTopLevelComm style mod'
footer = convertFooter style mod'
mod' = flattenModule style mod
-------------------------------------------------------------------------------------
-- Header and footer
-- Args: style withDocs module
convertHeader :: CStyle -> Bool -> Module -> String
convertHeader st withDocs mod = mempty
++ "\n"
++ guardBegin (guardStyle st) guard
++ "\n"
++ imports
++ "\n\n"
++ innerHeader st name (if withDocs then getDoc (modDoc mod) else "")
++ "\n\n"
where
name = getModuleNameList . modName $ mod
guard = guardMangler st name
mangleImport = concatSep "/" . map toLowerString . map (concatSep "_") . map unmangle
imports = concatSep "\n"
. map (withPrefix ("#" ++ includeDirective st ++ " <")
. withSuffix ".h>"
. mangleImport
. getModuleNameList)
. map fst
. modImports
$ mod
guardBegin :: GuardStyle -> String -> String
guardBegin Pragma name = mempty
++ "#pragma once\n"
guardBegin Ifndef name = mempty
++ "#ifndef " ++ name ++ "\n"
++ "#define " ++ name ++ "\n"
guardEnd :: GuardStyle -> String -> String
guardEnd Pragma name = mempty
++ "// " ++ name
guardEnd Ifndef name = mempty
++ "#endif // " ++ name
convertFooter :: CStyle -> Module -> String
convertFooter st mod = mempty
++ "\n\n"
++ innerFooter st name
++ "\n\n"
++ guardEnd (guardStyle st) guard
++ "\n\n"
where
name = getModuleNameList . modName $ mod
guard = guardMangler st name
-------------------------------------------------------------------------------------
-- Flattening
-- |
-- Rewrite a module to use C-style (flat) names.
--
-- (This used to be called rename, until the addition of the eponymous module that does name
-- resolution. This function assumes names have already been resolved.)
--
-- The module returned from this function will have no QName constructors.
--
flattenModule :: CStyle -> Module -> Module
flattenModule st (Module n opt doc is ds) = Module n opt doc is (map (fmap $ flattenDecl st) ds)
flattenDecl :: CStyle -> Decl -> Decl
flattenDecl st (TypeDecl n t) = TypeDecl (translType st n) (fmap (flattenType st) t)
flattenDecl st (FunctionDecl n t) = FunctionDecl (translFun st n) (flattenFunType st t)
flattenDecl st (TagDecl t) = TagDecl (flattenType st t)
flattenDecl st (ConstDecl n v t) = ConstDecl (translConst st n) v (flattenType st t)
flattenDecl st (GlobalDecl n v t) = GlobalDecl (translGlobal st n) v (flattenType st t)
flattenType :: CStyle -> Type -> Type
flattenType st (PrimType t) = PrimType t
flattenType st (AliasType n) = AliasType $ flattenAlias st n
flattenType st (RefType t) = RefType $ flattenRefType st t
flattenType st (FunType t) = FunType $ flattenFunType st t
flattenType st (CompType t) = CompType $ flattenCompType st t
flattenAlias :: CStyle -> Name -> Name
flattenAlias st n = translType st n
flattenRefType :: CStyle -> RefType -> RefType
flattenRefType st (Pointer t) = Pointer (flattenType st t)
flattenRefType st (Array t n) = Array (flattenType st t) n
flattenFunType :: CStyle -> FunType -> FunType
flattenFunType st (Function as r) = Function (fmap (second $ flattenType st) as) (flattenType st r)
flattenCompType :: CStyle -> CompType -> CompType
flattenCompType st (Enum ns) = Enum $ fmap (translEnumField st) ns
flattenCompType st (Struct ns) = Struct $ fmap (\(n,t) -> (translStructField st n, flattenType st t)) ns
flattenCompType st (Union ns) = Union $ fmap (\(n,t) -> (translUnionField st n, flattenType st t)) ns
flattenCompType st (BitField ns) = notSupported "Bit-fields"
translType :: CStyle -> Name -> Name
translType st = mangleName (typePrefixMangler st) (typeMangler st)
translFun :: CStyle -> Name -> Name
translConst :: CStyle -> Name -> Name
translGlobal :: CStyle -> Name -> Name
translFun st = mangleName (valuePrefixMangler st) (funcMangler st)
translConst st = mangleName (valuePrefixMangler st) (constMangler st)
translGlobal st = mangleName (valuePrefixMangler st) (globalMangler st)
translStructField :: CStyle -> Name -> Name
translUnionField :: CStyle -> Name -> Name
translEnumField :: CStyle -> Name -> Name
translStructField st = mangleName (valuePrefixMangler st) (structFieldMangler st)
translUnionField st = mangleName (valuePrefixMangler st) (unionFieldMangler st)
translEnumField st = mangleName (valuePrefixMangler st) (enumFieldMangler st)
mangleName :: ([String] -> String) -> ([String] -> String) -> Name -> Name
mangleName p q (Name n) = Name $ q (unmangle n)
mangleName p q (QName m n) = Name $ (p . concatMap unmangle . getModuleNameList $ m) ++ q (unmangle n)
-------------------------------------------------------------------------------------
-- Top-level declarations
-- TODO use doc
convertTopLevel :: CStyle -> Module -> CTranslUnit
convertTopLevel st (Module n opt doc is ds) = CTranslUnit cds defInfo
where
cds = map (CDeclExt . convertDecl st . snd) ds
convertTopLevelComm :: CStyle -> Module -> [(String, CDecl)]
convertTopLevelComm st (Module n opt doc is ds) = fmap (first getDoc . second (convertDecl st)) ds
where
first f = swap . fmap f . swap
second = fmap
swap (a,b) = (b,a)
convertDecl :: CStyle -> Decl -> CDecl
convertDecl st (TypeDecl n Nothing) = declOpaque st n
convertDecl st (TypeDecl n (Just t)) = declType st n t -- typedef T N;
convertDecl st (FunctionDecl n t) = declFun st n t -- T n (as);
convertDecl st (TagDecl t) = notSupported "Tag decls" -- T;
convertDecl st (ConstDecl n v t) = notSupported "Constants" -- T n; or T n = v;
convertDecl st (GlobalDecl n v t) = notSupported "Globals" -- T n; or T n = v;
-- TODO for now opaques are always structs
-- TODO use separate mangler for struct name
declOpaque :: CStyle -> Name -> CDecl
declOpaque st n = CDecl spec decList defInfo
where
typ = CSUType (CStruct CStructTag (Just $ ident ("_" ++ getName n)) Nothing [] defInfo) defInfo
spec = [CStorageSpec (CTypedef defInfo)] ++ [CTypeSpec typ]
declr = CDeclr (Just $ identName n) [CPtrDeclr [] defInfo] Nothing [] defInfo
decList = [topLevelDeclr declr]
declType :: CStyle -> Name -> Type -> CDecl
declType st n t = CDecl spec decList defInfo
where
(typ, decl) = convertType st t
spec = [CStorageSpec (CTypedef defInfo)] ++ map CTypeSpec typ
declr = CDeclr (Just $ identName n) decl Nothing [] defInfo
decList = [topLevelDeclr declr]
declVar :: CStyle -> Name -> Type -> CDecl
declVar st n t = CDecl spec decList defInfo
where
(typ, decl) = convertType st t
spec = [] ++ map CTypeSpec typ
declr = CDeclr (Just $ identName n) decl Nothing [] defInfo
decList = [topLevelDeclr declr]
declFun :: CStyle -> Name -> FunType -> CDecl
declFun st n t = CDecl spec decList defInfo
where
(typ, decl) = convertFunType st t
spec = [] ++ map CTypeSpec typ
declr = CDeclr (Just $ identName n) decl Nothing [] defInfo
decList = [topLevelDeclr declr]
-- These are used recursively from below
declParam :: CStyle -> Maybe Name -> Type -> CDecl
declParam st n t = CDecl spec decList defInfo
where
(typ, decl) = convertType st t
spec = map CTypeSpec typ
declr = CDeclr (fmap identName n) decl Nothing [] defInfo
decList = [memberDeclr declr]
-- struct or union member
declStructMember :: CStyle -> Name -> Type -> CDecl
declStructMember st n t = CDecl spec decList defInfo
where
(typ, decl) = convertType st t
spec = map CTypeSpec typ
declr = CDeclr (Just $ identName n) decl Nothing [] defInfo
decList = [memberDeclr declr]
declBitfieldMember :: CStyle -> Maybe Name -> Type -> Int -> CDecl
declBitfieldMember = notSupported "Bit-fields"
-- |
-- C types are represented by
--
-- 1) A sequence of (declaration-specific) type specifiers such as 'unsigned', 'long', 'int' etc
--
-- 2) A sequence of (variable-specific) qualifiers such as '*', '[]' or function arguments
--
convertType :: CStyle -> Type -> ([CTypeSpec], [CDerivedDeclr])
convertType st (AliasType n) = convertAlias st n
convertType st (PrimType t) = convertPrimType st t
convertType st (RefType t) = convertRefType st t
convertType st (FunType t) = convertFunType st t
convertType st (CompType t) = convertCompType st t
convertAlias :: CStyle -> Name -> ([CTypeSpec], [CDerivedDeclr])
convertAlias st n = (alias, [])
where
alias = [CTypeDef (identName n) defInfo]
convertPrimType :: CStyle -> PrimType -> ([CTypeSpec], [CDerivedDeclr])
convertPrimType st t = (prim t, [])
where
-- prim Bool = [CBoolType defInfo]
prim Bool = return $ CTypeDef (ident "bool") defInfo
prim Void = [CVoidType defInfo]
prim Char = [CCharType defInfo]
prim Short = [CShortType defInfo]
prim Int = [CIntType defInfo]
prim Long = [CLongType defInfo]
prim LongLong = [CLongType defInfo, CLongType defInfo]
prim SChar = [CSignedType defInfo, CCharType defInfo]
prim UChar = [CUnsigType defInfo, CCharType defInfo]
prim UShort = [CUnsigType defInfo, CShortType defInfo]
prim UInt = [CUnsigType defInfo, CIntType defInfo]
prim ULong = [CUnsigType defInfo, CLongType defInfo]
prim ULongLong = [CUnsigType defInfo, CLongType defInfo, CLongType defInfo]
prim Float = [CFloatType defInfo]
prim Double = [CDoubleType defInfo]
prim LongDouble = [CLongType defInfo, CDoubleType defInfo]
prim Size = return $ CTypeDef (ident "size_t") defInfo
prim Ptrdiff = return $ CTypeDef (ident "ptrdiff_t") defInfo
prim Intptr = return $ CTypeDef (ident "intptr_t") defInfo
prim UIntptr = return $ CTypeDef (ident "uintptr_t") defInfo
prim Int8 = return $ CTypeDef (ident "int8_t") defInfo
prim Int16 = return $ CTypeDef (ident "int16_t") defInfo
prim Int32 = return $ CTypeDef (ident "int32_t") defInfo
prim Int64 = return $ CTypeDef (ident "int64_t") defInfo
prim UInt8 = return $ CTypeDef (ident "uint8_t") defInfo
prim UInt16 = return $ CTypeDef (ident "uint16_t") defInfo
prim UInt32 = return $ CTypeDef (ident "uint32_t") defInfo
prim UInt64 = return $ CTypeDef (ident "uint64_t") defInfo
convertRefType :: CStyle -> RefType -> ([CTypeSpec], [CDerivedDeclr])
convertRefType st (Pointer t) = (typ, [CPtrDeclr [] defInfo] ++ decls)
where
(typ, decls) = convertType st t
convertRefType st (Array t n) = (typ, [CArrDeclr [] size defInfo] ++ decls)
where
size = (CArrSize isStatic (CConst (CIntConst (fromIntegral n) defInfo)))
isStatic = False
(typ, decls) = convertType st t
convertFunType :: CStyle -> FunType -> ([CTypeSpec], [CDerivedDeclr])
convertFunType st (Function as r) = (typ, [CFunDeclr (Right (args, False)) [] defInfo ] ++ decls)
where
(typ, decls) = convertType st r
args :: [CDecl]
args = map (\(n,t) -> declParam st n t) $ as
-- TODO #34 use name
convertCompType :: CStyle -> CompType -> ([CTypeSpec], [CDerivedDeclr])
convertCompType st (Enum as) = ([typ], [])
where
typ = CEnumType enum defInfo
enum = CEnum tag (Just names) [] defInfo
tag = Nothing
names = map (\n -> (identName n, Nothing)) $ NonEmpty.toList as
convertCompType st (Struct as) = ([typ], [])
where
typ = cStruct tag (Just decls)
tag = Nothing
decls = map (\(n,t) -> declStructMember st n t) $ NonEmpty.toList as
convertCompType st (Union as) = ([typ], [])
where
typ = cUnion tag (Just decls)
tag = Nothing
decls = map (\(n,t) -> declStructMember st n t) $ NonEmpty.toList as
convertCompType st (BitField as) = notSupported "Bitfields"
-------------------------------------------------------------------------------------
-- Util
-- | An identifier
ident :: String -> Ident
ident name = Ident name 0 defInfo
identName :: Name -> Ident
identName = ident . getName
-- | Top-level declaration.
topLevelDeclr :: CDeclr -> (Maybe CDeclr, Maybe CInit, Maybe CExpr)
topLevelDeclr declr = (Just declr, Nothing, Nothing)
-- | Top-level declaration with initial value.
topLevelDeclrInit :: CDeclr -> CInit -> (Maybe CDeclr, Maybe CInit, Maybe CExpr)
topLevelDeclrInit declr init = (Just declr, Just init, Nothing)
-- | Member declaration.
memberDeclr :: CDeclr -> (Maybe CDeclr, Maybe CInit, Maybe CExpr)
memberDeclr declr = (Just declr, Nothing, Nothing)
-- | Member declaration with size.
memberDeclrSize :: CDeclr -> CExpr -> (Maybe CDeclr, Maybe CInit, Maybe CExpr)
memberDeclrSize declr size = (Just declr, Nothing, Just size)
-- | Parameter declaration.
paramDeclr :: CDeclr -> (Maybe CDeclr, Maybe CInit, Maybe CExpr)
paramDeclr declr = (Just declr, Nothing, Nothing)
-- | Used for all NodeInfo values in generated code
defInfo :: NodeInfo
defInfo = error "Can not read nodeInfo"
-- defInfo = OnlyPos $ Position undefined 0 0
notSupported x = error $ "Not supported yet: " ++ x
cStruct t ds = CSUType r defInfo where r = CStruct CStructTag t ds [] defInfo
cUnion t ds = CSUType r defInfo where r = CStruct CUnionTag t ds [] defInfo
instance Num CInteger where
(CInteger a r f) + (CInteger b _ _) = CInteger (a+b) r f
(CInteger a r f) * (CInteger b _ _) = CInteger (a*b) r f
abs (CInteger a r f) = CInteger (abs a) r f
signum (CInteger a r f) = CInteger (signum a) r f
fromInteger a = CInteger a DecRepr noFlags
{-
Extra instances for debug purposes
deriving instance Show CTranslUnit
deriving instance Show CExtDecl
deriving instance Show CStrLit
deriving instance Show CFunDef
deriving instance Show CDecl
deriving instance Show CStat
deriving instance Show CDeclr
deriving instance Show CInit
deriving instance Show CDeclSpec
deriving instance Show CAsmStmt
deriving instance Show CBlockItem
deriving instance Show CAttr
deriving instance Show CDerivedDeclr
deriving instance Show CDesignator
deriving instance Show CExpr
deriving instance Show CTypeQual
deriving instance Show CTypeSpec
deriving instance Show CAsmOperand
deriving instance Show CArrSize
deriving instance Show CBuiltin
deriving instance Show CConst
deriving instance Show CEnum
deriving instance Show CStructUnion
deriving instance Show CStructTag
-}