{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{- |
Module : $Header$
Description : C generation patterns.
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable
C generation patterns.
-}
module Language.CAO.Translation.C.Wrappers
( CExtDecl'(..)
, CTranslUnit'(..)
, CDecl'(..)
, declOrMacro
, cVar
, cVarDecl
, cVarIntDecl
, cVarCharDecl
, cVarDeclStmt
, cVarAddr
, cIntExpr
, cStringExpr
, cCharExpr
, cExprAddr
, cFuncCall
, cFuncCallStmt
, cAssignStmt
, cCharArrayDecl
, cIntArrayDecl
, cTypeArrayDecl
, cParamDecl
, cParamDecl'
, cPointerDecl
, cPointerCast
, cPointedExpr
, cIndirection
, cFuncDefinition
, cTypedefDecl
, cType
, cReturn
, cReturnExpr
, (<<+>)
, (<+>>)
, cPointerArrayDecl
, cExprStmt
) where
import Language.C
import Text.PrettyPrint.HughesPJ
-- HACK:
-- Extension and redefinition of the C AST in order to cope with function calls outside
-- function bodies.
-- This is needed for macro declarations of variables and macro declarations of struct fields.
data CExtDecl' = CED CExtDecl | CMacroExt CBlockItem | CStructExt String String [CDecl']
data CDecl' =
CDecl' CDecl
| CFld CBlockItem
instance Pretty CDecl' where
pretty (CDecl' c) = pretty c <> semi
pretty (CFld b) = pretty b <> semi
instance Pretty CExtDecl' where
pretty (CED c) = pretty c
pretty (CMacroExt m) = pretty m
pretty (CStructExt tn sn l) =
hsep [
text "typedef",
vcat [
text "struct" <+> text sn <+> text "{",
nest 4 $ sep ( (map pretty l)),
text "}"
]
] <+> text tn <> semi
data CTranslUnit' = CTranslUnit' [CExtDecl'] NodeInfo
instance Pretty CTranslUnit' where
pretty (CTranslUnit' edecls _) = vcat (map pretty edecls)
declOrMacro :: Either CDecl CBlockItem -> CExtDecl'
declOrMacro = either (CED . CDeclExt) CMacroExt
--------------------------------------------------------------------------------
-- Language.C auxiliary
--------------------------------------------------------------------------------
-- Declarations -- CDeclSpec
-- Short-hand for C void type
cVoidType :: CDeclSpec
cVoidType = CTypeSpec (CVoidType undefNode)
-- Short-hand for C int type
cIntType :: CDeclSpec
cIntType = CTypeSpec (CIntType undefNode)
-- Short-hand for C char type
cCharType :: CDeclSpec
cCharType = CTypeSpec (CCharType undefNode)
-- Returns a C type with a given name
cType :: String -> CDeclSpec
cType tname =
CTypeSpec $ CTypeDef (internalIdent tname) undefNode
-- Constant type qualifier
cConst :: CDeclSpec
cConst = CTypeQual (CConstQual undefNode)
--------------------------------------------------------------------------------
-- Declarations -- CDecl
-- Wrapper for declaring variables without initialization
cVarDecl :: String -> String -> CDecl
cVarDecl name typ = cParamDecl name (cType typ)
cVarIntDecl :: String -> CDecl
cVarIntDecl name = cParamDecl name cIntType
cVarCharDecl :: String -> CDecl
cVarCharDecl name = cParamDecl name cCharType
-- Wrapper for C typedef definitions
cTypedefDecl :: String -> CDeclSpec -> CDecl
cTypedefDecl tname typ =
CDecl [CStorageSpec (CTypedef undefNode),typ] [(Just (cDeclr tname []), Nothing, Nothing)] undefNode
-- Wrapper for declaring function parameters
cParamDecl :: String -> CDeclSpec -> CDecl
cParamDecl tname typ =
CDecl [typ] [(Just (cDeclr tname []), Nothing, Nothing)] undefNode
cParamDecl' :: String -> CDeclSpec -> CDecl'
cParamDecl' tname typ = CDecl' $ cParamDecl tname typ
cPointerDecl :: String -> CDeclSpec -> CDecl
cPointerDecl tname typ = CDecl [typ] [(Just (cDeclr tname [CPtrDeclr [] undefNode]), Nothing, Nothing)] undefNode
cPointer :: CDeclSpec -> CDecl
cPointer typ = CDecl [typ] [(Just (CDeclr Nothing [CPtrDeclr [] undefNode] Nothing [] undefNode), Nothing, Nothing)] undefNode
cDeclr :: String -> [CDerivedDeclr] -> CDeclr
cDeclr nm lst = CDeclr (Just (internalIdent nm)) lst Nothing [] undefNode
--------------------------------------------------------------------------------
-- Statements -- CBlockItem
cAssignStmt :: CExpr -> CExpr -> CBlockItem
cAssignStmt evar cexpr = cExprStmt $ CAssign CAssignOp evar cexpr undefNode
-- Wrapper for C function call statements
cFuncCallStmt :: String -> [CExpr] -> CBlockItem
cFuncCallStmt fname = cExprStmt . cFuncCall fname
-- Wrapper for C expression statements
cExprStmt :: CExpr -> CBlockItem
cExprStmt e = CBlockStmt (CExpr (Just e) undefNode)
-- Default return statement (value OK)
cReturn :: String -> CBlockItem
cReturn caoOk = CBlockStmt $ CReturn (Just (cVar caoOk)) undefNode
cReturnExpr :: CExpr -> CBlockItem
cReturnExpr e = CBlockStmt $ CReturn (Just e) undefNode
cVarDeclStmt :: String -> String -> CBlockItem
cVarDeclStmt name = CBlockDecl . cVarDecl name
cCharArrayDecl :: String -> [CExpr] -> CBlockItem
cCharArrayDecl name = cArrayDecl name [cConst, cCharType] True
cIntArrayDecl :: String -> [CExpr] -> CBlockItem
cIntArrayDecl name = cArrayDecl name [cConst, cIntType] False
cTypeArrayDecl :: String -> String -> [CExpr] -> CBlockItem
cTypeArrayDecl name typ = cArrayDecl name [cType typ] False
cArrayDecl :: String -> [CDeclSpec] -> Bool -> [CExpr] -> CBlockItem
cArrayDecl name qual pointer = cArray qual name dlst
where
dlst = cNoArraySize : if pointer then [cNoArraySize] else []
cPointerArrayDecl :: String -> [CExpr] -> CBlockItem
cPointerArrayDecl name = cArray [cVoidType] name dlst
where
dlst = [cNoArraySize, CPtrDeclr [] undefNode]
cArray :: [CDeclSpec] -> String -> [CDerivedDeclr] -> [CExpr] -> CBlockItem
cArray typ name dlst initLst = CBlockDecl $ CDecl typ
[ (Just name', Just (CInitList (concatMap initVal initLst) undefNode), Nothing) ]
undefNode
where
name' = cDeclr name dlst
initVal :: CExpr -> CInitList
initVal str = [([], CInitExpr str undefNode)]
cNoArraySize :: CDerivedDeclr
cNoArraySize = CArrDeclr [] (CNoArrSize False) undefNode
--------------------------------------------------------------------------------
-- Expressions -- CExpr
-- Returns a C variable with a given name
{-# INLINE cVar #-}
cVar :: String -> CExpr
cVar name = CVar (internalIdent name) undefNode
-- Wrapper for C function calls
cFuncCall :: String -> [CExpr] -> CExpr
cFuncCall fname args = CCall (cVar fname) args undefNode
-- C literal expression from integer
cIntExpr :: Integer -> CExpr
cIntExpr n = CConst $ CIntConst (cInteger n) undefNode
-- C literal expression from string
cStringExpr :: String -> CExpr
cStringExpr str = CConst $ CStrConst (cString str) undefNode
-- C literal char
cCharExpr :: Char -> CExpr
cCharExpr c = CConst $ CCharConst (cChar c) undefNode
-- Indirection of an expression
cIndirection :: CExpr -> CExpr
cIndirection e = CUnary CIndOp e undefNode
-- Indirection of a pointer cast to int
cPointedExpr :: CExpr -> CExpr
cPointedExpr e = cIndirection (CCast (cPointer cIntType) e undefNode)
-- Cast of a pointer
cPointerCast :: String -> CExpr -> CExpr
cPointerCast typ e = CCast (cPointer (cType typ)) e undefNode
{-# INLINE cVarAddr #-}
cVarAddr :: String -> CExpr
cVarAddr vid = CUnary CAdrOp (cVar vid) undefNode
{-# INLINE cExprAddr #-}
cExprAddr :: CExpr -> CExpr
cExprAddr vid = CUnary CAdrOp vid undefNode
--------------------------------------------------------------------------------
-- Wrapper for defining C functions
cFuncDefinition :: String -> [CDecl] -> String -> CStat -> CFunDef
cFuncDefinition fname cParamDecls caoRes body = let
prms' = if null cParamDecls
then [CDecl [cVoidType] [] undefNode]
else cParamDecls -- Void for empty parameter list in new style declarations
funcDecl = cDeclr fname [CFunDeclr (Right (prms', False)) [] undefNode]
in CFunDef [cType caoRes] funcDecl [] body undefNode
--------------------------------------------------------------------------------
(<+>>) :: CStat -> [CBlockItem] -> CStat
(<+>>) (CCompound a1 lst a2) it = CCompound a1 (lst ++ it) a2
(<+>>) _ _ = error ".<<+>>>: Not expected case"
(<<+>) :: [CBlockItem] -> CStat -> CStat
(<<+>) it (CCompound a1 lst a2) = CCompound a1 (it ++ lst) a2
(<<+>) _ _ = error ".<<<+>>: Not expected case"