1{- 2 CAbsSyntax: Abstract syntax to generate C code for Skate 3 4 Part of Skate: a Schema specification languge 5 6 Copyright (c) 2017, ETH Zurich. 7 All rights reserved. 8 9 This file is distributed under the terms in the attached LICENSE file. 10 If you do not find this file, copies can be found by writing to: 11 ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group. 12-} 13 14 15module CAbsSyntax where 16 17import Text.Printf 18import Data.Char 19import Data.List 20 21-- 22-- Just enough syntax to generate files for Skate, etc. 23-- 24 25 26tabstop = " " -- How much to indent 27 28indent_stmts :: [ Stmt ] -> [ String ] 29indent_stmts sl = [ tabstop ++ l | l <- concat [ pp_stmt s | s <- sl ] ] 30 31-- 32-- We start with expressions 33-- 34data Expr = NumConstant Integer -- 123 35 | HexConstant Integer -- 0xFF 36 | StringConstant String -- "Hello!" 37 | StringCat [ StrElem ] -- "Value is " PRIu64 " bytes" 38 | CharConstant Char -- 'c' 39 | Variable String -- index 40 | AddressOf Expr -- &foo 41 | DerefPtr Expr -- *foo 42 | DerefField Expr String -- (foo)->string 43 | Assignment Expr Expr -- foo = bar 44 | Unary UnOp Expr -- -(foo) 45 | Binary BinOp Expr Expr -- (a) + (b) 46 | Ternary Expr Expr Expr -- p ? a : b 47 | FieldOf Expr String -- p.field 48 | SubscriptOf Expr Expr -- p[q] 49 | Call String [ Expr ] -- fn(a,b,c) 50 | CallInd Expr [ Expr ] -- (fn)(a,b,c) 51 | SizeOf Expr -- sizeof(expr) 52 | SizeOfT TypeSpec -- sizeof(int) 53 | Cast TypeSpec Expr -- (foo_t)(expr) 54 | PostInc Expr -- (foo)++ 55 | PostDec Expr -- (foo)-- 56 | PreInc Expr -- ++(foo) 57 | PreDec Expr -- --(foo) 58 | Parens Expr -- (e) 59 | DefineExpr String -- DEF 60 | StructConstant String [(String, Expr)] -- (struct foo){ .field = val, } 61 | ArrayConstant [Expr] -- { val, } 62 deriving (Show, Eq) 63 64pp_expr :: Expr -> String 65pp_expr (NumConstant i) = printf "%d" i 66pp_expr (HexConstant i) = printf "0x%x" i 67pp_expr (StringConstant s) = "\"" ++ (concat $ map (\x -> showLitChar x "") s) ++ "\"" 68pp_expr (StringCat l) = concat $ intersperse " " $ map pp_strelem l 69pp_expr (CharConstant c) = "'" ++ showLitChar c "'" 70pp_expr (Variable s) = s 71pp_expr (AddressOf e) = "&" ++ (pp_par_expr e) 72pp_expr (DerefPtr e) = "*" ++ (pp_par_expr e) 73pp_expr (DerefField e s) = (pp_par_expr e) ++ "->" ++ s 74pp_expr (Assignment e1 e2) = (pp_expr e1) ++ " = " ++ (pp_par_expr e2) 75pp_expr (Unary o e) = (pp_unop o) ++ (pp_par_expr e) 76pp_expr (Binary o e1 e2) 77 = (pp_par_expr e1) ++" " ++ (pp_binop o) ++ " "++(pp_par_expr e2) 78pp_expr (Ternary e1 e2 e3) 79 = (pp_par_expr e1) ++ " ? " ++ (pp_par_expr e2) ++ " : " ++ (pp_par_expr e3) 80pp_expr (FieldOf e s) = (pp_par_expr e) ++ "." ++ s 81pp_expr (SubscriptOf e1 e2) = (pp_par_expr e1) ++ "[" ++ (pp_expr e2) ++ "]" 82pp_expr (Call f al) 83 = f ++ "(" ++ (concat $ intersperse ", " [ pp_expr e | e <- al ]) ++ ")" 84pp_expr (CallInd f al) 85 = "(" ++ (pp_expr f) ++ ")(" ++ (concat $ intersperse ", " [ pp_expr e | e <- al ]) ++ ")" 86pp_expr (SizeOf e) = "sizeof(" ++ (pp_expr e) ++ ")" 87pp_expr (SizeOfT t) = "sizeof(" ++ (pp_typespec t "") ++ ")" 88pp_expr (Cast s e) = "(" ++ (pp_typespec s "") ++ ")(" ++ (pp_expr e) ++ ")" 89pp_expr (PostInc e) = (pp_par_expr e) ++ "++" 90pp_expr (PostDec e) = (pp_par_expr e) ++ "--" 91pp_expr (PreInc e) = "++" ++ (pp_par_expr e) 92pp_expr (PreDec e) = "--" ++ (pp_par_expr e) 93pp_expr (Parens e) = "(" ++ (pp_expr e) ++ ")" 94pp_expr (StructConstant n il) = "(struct " ++ n ++ "){ " ++ inits ++ " }" 95 where inits = concat $ intersperse ", " [ " ." ++ f ++ " = " ++ pp_expr v | (f,v) <- il ] 96pp_expr (ArrayConstant vl) = "{ " ++ (concat $ intersperse ", " (map pp_expr vl)) ++ " }" 97pp_expr (DefineExpr str) = str 98 99pp_par_expr :: Expr -> String 100pp_par_expr (Variable s) = s 101pp_par_expr e@(NumConstant _) = pp_expr e 102pp_par_expr e@(HexConstant _) = pp_expr e 103pp_par_expr c@(Call _ _) = pp_expr c 104pp_par_expr e = "(" ++ (pp_expr e) ++ ")" 105 106data StrElem = QStr String 107 | NStr String 108 deriving (Show, Eq) 109 110pp_strelem :: StrElem -> String 111pp_strelem (QStr s) = pp_expr (StringConstant s) 112pp_strelem (NStr s) = s 113 114-- 115-- Binary operators 116-- 117data BinOp = Plus 118 | Minus 119 | Times 120 | Divide 121 | Modulo 122 | Equals 123 | NotEquals 124 | GreaterThan 125 | LessThan 126 | GreaterThanEq 127 | LessThanEq 128 | BitwiseAnd 129 | BitwiseOr 130 | BitwiseXor 131 | And 132 | Or 133 | LeftShift 134 | RightShift 135 deriving (Show, Eq) 136 137pp_binop :: BinOp -> String 138pp_binop Plus = "+" 139pp_binop Minus = "-" 140pp_binop Times = "*" 141pp_binop Divide = "/" 142pp_binop Modulo = "%" 143pp_binop Equals= "==" 144pp_binop NotEquals= "!=" 145pp_binop GreaterThan= ">" 146pp_binop LessThan = "<" 147pp_binop GreaterThanEq= ">=" 148pp_binop LessThanEq= "<=" 149pp_binop BitwiseAnd= "&" 150pp_binop BitwiseOr= "|" 151pp_binop BitwiseXor= "^" 152pp_binop And= "&&" 153pp_binop Or = "||" 154pp_binop LeftShift= "<<" 155pp_binop RightShift= ">>" 156 157-- 158-- Unary operators 159-- 160data UnOp = Not | Negate | BitwiseNot 161 deriving (Show, Eq) 162 163pp_unop :: UnOp -> String 164pp_unop Not = "!" 165pp_unop Negate = "-" 166pp_unop BitwiseNot = "~" 167 168-- 169-- Parameters to function definitions 170-- 171data Param = Param TypeSpec String 172 | ParamComment String 173 | ParamDoxyComment String 174 | ParamBlank 175 deriving (Show, Eq) 176 177pp_param :: Param -> String 178pp_param (Param t s) = (pp_typespec t s) 179pp_param (ParamComment s) = "/* " ++ s ++ " */" 180pp_param (ParamDoxyComment s) = "///< " ++ s 181pp_param ParamBlank = "" 182 183-- 184-- Members of an enumeration definition 185-- 186data EnumItem = EnumItem String String (Maybe Expr) 187 deriving (Show, Eq) 188 189pp_enumitem :: EnumItem -> String 190pp_enumitem (EnumItem s d (Just e)) = s ++ " = " ++( pp_expr e) ++ " ///< " ++ d 191pp_enumitem (EnumItem s d Nothing) = s ++ " ///< " ++ d 192 193 194-- 195-- Include directives 196-- 197data IncludePath = Standard | Local 198 deriving (Show, Eq) 199pp_include :: IncludePath -> String -> String 200pp_include Standard f = printf "#include <%s>" f 201pp_include Local f = printf "#include \"%s\"" f 202 203-- 204-- Scope of a function or variable 205-- 206data ScopeSpec = Extern | Static | NoScope 207 deriving (Show, Eq) 208 209pp_scopespec :: ScopeSpec -> String 210pp_scopespec Extern = "extern " 211pp_scopespec Static = "static " 212pp_scopespec NoScope = "" 213 214-- 215-- Constancy 216-- 217data ConstSpec = Const | NonConst 218 deriving (Show, Eq) 219pp_constspec :: ConstSpec -> String 220pp_constspec Const = "const " 221pp_constspec NonConst = "" 222 223-- 224-- A Unit is a chunk of source file, i.e. top-level syntactic constructs. 225-- 226-- Note that we treat static inlines as their own construct. It's easier. 227-- 228data Unit = Comment String 229 | DoxyComment String 230 | MultiComment [ String ] 231 | MultiDoxy [ String ] 232 | TypeDef TypeSpec String 233 | FunctionDef ScopeSpec TypeSpec String [ Param ] [ Stmt ] 234 | StaticInline TypeSpec String [ Param ] [ Stmt ] 235 | StructDecl String [ Param ] 236 | StructForwardDecl String 237 | StructDef ScopeSpec String String [ (String, String) ] 238 | UnionDecl String [ Param ] 239 | UnionForwardDecl String 240 | EnumDecl String [ EnumItem ] 241 | FunctionDecl ScopeSpec TypeSpec String [ Param ] 242 | GVarDecl ScopeSpec ConstSpec TypeSpec String (Maybe Expr) 243 | Define String [ String ] String 244 | Undef String 245 | IfDef String [ Unit ] [ Unit ] 246 | IfNDef String [ Unit ] [ Unit ] 247 | HashIf String [ Unit ] [ Unit ] 248 | UnitList [ Unit ] 249 | NoOp 250 | Blank 251 | Include IncludePath String 252 deriving (Show, Eq) 253 254pp_unit :: Unit -> [ String ] 255pp_unit (Comment s) = [ "// " ++ s ] 256pp_unit (DoxyComment s) = [ "///< " ++ s ] 257pp_unit (MultiComment sl) = ["/*"] ++ [ " * " ++ s | s <- sl ] ++ [ " */"] 258pp_unit (MultiDoxy sl) = ["/**"] ++ [ " * " ++ s | s <- sl ] ++ [ " */"] 259pp_unit (TypeDef ts s) = [ "typedef " ++ (pp_typespec ts s) ++ ";" ] 260pp_unit (FunctionDef sc ts n pl body) = 261 [ (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) ] ++ (pp_fnbody body) 262pp_unit (StaticInline ts n pl body) = 263 [ head ++ " __attribute__ ((always_inline));", 264 head ] ++ (pp_fnbody body) 265 where 266 head = "static inline " ++ (pp_fnhead ts n pl) 267pp_unit (StructDecl s pl) = 268 [ printf "struct %s {" s ] ++ pp_structunion_body pl ++ ["};"] 269pp_unit (StructForwardDecl s) = 270 [ printf "struct %s;" s ] 271pp_unit (StructDef sc s n fl) = 272 [ (pp_scopespec sc) ++ " " ++ (printf "struct %s %s = {" s n)] 273 ++ [ tabstop ++ (pp_fieldinit f) | f <- fl ] ++ ["};"] 274 where 275 pp_fieldinit (n,v) = printf ".%s = %s," n v 276pp_unit (UnionDecl s pl) = 277 [ printf "union %s {" s ] ++ [ tabstop ++ (pp_param p) ++ ";" 278 | p <- pl ] ++ ["};"] 279pp_unit (UnionForwardDecl s) = 280 [ printf "union %s;" s ] 281pp_unit (EnumDecl s el) = 282 [ printf "typedef enum %s {" s ] 283 ++ 284 (comma_sep_lines [ tabstop ++ (pp_enumitem e) | e <- el ]) 285 ++ 286 [ printf "} %s;" s] 287pp_unit (FunctionDecl sc ts n pl) = 288 [ (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) ++ ";" ] 289pp_unit (GVarDecl sc cs ts s Nothing) = 290 [ printf "%s%s%s;" (pp_scopespec sc) (pp_constspec cs) (pp_typespec ts s)] 291pp_unit (GVarDecl sc cs ts s (Just e)) = 292 [ printf "%s%s%s = %s;" 293 (pp_scopespec sc) 294 (pp_constspec cs) 295 (pp_typespec ts s) 296 (pp_expr e) ] 297pp_unit (Define n [] v) = [ printf "#define %s %s" n v ] 298pp_unit (Define n al v) 299 = [ printf "#define %s(%s) %s" n (concat $ intersperse "," al) v ] 300pp_unit (Undef s) = [ "#undef " ++ s ] 301pp_unit (IfDef s l r) = pp_cppcond "ifdef" s l r 302pp_unit (IfNDef s l r) = pp_cppcond "ifndef" s l r 303pp_unit (HashIf s l r) = pp_cppcond "if" s l r 304pp_unit (UnitList l) = concat $ map pp_unit l 305pp_unit NoOp = [] 306pp_unit Blank = [""] 307pp_unit (Include s p) = [ pp_include s p ] 308 309pp_structunion_body :: [Param] -> [String] 310pp_structunion_body pl = [ tabstop ++ (pp_param p) ++ opt_trailer p | p <- pl ] 311 where 312 opt_trailer (Param _ _) = ";" 313 opt_trailer _ = "" 314 315comma_sep_lines :: [String] -> [String] 316comma_sep_lines [] = [] 317comma_sep_lines [s] = [s] 318comma_sep_lines (s:sl) = (s ++ ","):(comma_sep_lines sl) 319 320pp_cppcond :: String -> String -> [ Unit ] -> [ Unit ] -> [ String ] 321pp_cppcond t e l r = 322 [ "#" ++ t ++ " " ++ e ] 323 ++ 324 (concat [ pp_unit u | u <- l ]) 325 ++ 326 (if r == [] then [] else "#else":concat [ pp_unit u | u <- r ]) 327 ++ 328 [ "#endif // " ++ e ] 329 330pp_cppcond_stmt :: String -> String -> [ Stmt ] -> [ Stmt ] -> [ String ] 331pp_cppcond_stmt t e l r = 332 [ "#" ++ t ++ " " ++ e ] 333 ++ 334 (concat [ pp_stmt u | u <- l ]) 335 ++ 336 (if r == [] then [] else "#else":concat [ pp_stmt u | u <- r ]) 337 ++ 338 [ "#endif // " ++ e ] 339 340 341pp_fnbody :: [ Stmt ] -> [ String ] 342pp_fnbody body = [ "{" ] ++ (indent_stmts body) ++ [ "}", ""] 343 344pp_fnhead :: TypeSpec -> String -> [ Param ] -> String 345pp_fnhead ts n [] = 346 (pp_typespec ts n) ++ "(void)" 347pp_fnhead ts n pl = 348 (pp_typespec ts n) ++ "(" ++ parlist ++ ")" 349 where 350 parlist = concat $ intersperse ", " [ pp_param p | p <- pl ] 351 352-- 353-- Branches of a case statement: note that they fall through 354-- 355data Case = Case Expr [ Stmt ] 356 deriving (Show, Eq) 357 358pp_case :: Case -> [ String ] 359pp_case (Case e s) 360 = [ "case " ++ (pp_expr e) ++ ":" ] ++ (indent_stmts s) 361 362-- 363-- Statements. 364-- 365data Stmt = Return Expr 366 | ReturnVoid 367 | Block [ Stmt ] 368 | StmtList [ Stmt ] 369 | Ex Expr 370 | If Expr [ Stmt ] [ Stmt ] 371 | DoWhile Expr [ Stmt ] 372 | While Expr [ Stmt ] 373 | For Expr Expr Expr [ Stmt ] 374 | Switch Expr [ Case ] [ Stmt ] -- last list is default clause 375 | Break 376 | Continue 377 | Label String 378 | Goto String 379 | VarDecl ScopeSpec ConstSpec TypeSpec String (Maybe Expr) 380 | SComment String 381 | SBlank 382 | SIfDef String [ Stmt ] [ Stmt ] -- XXX: for #ifdef in the middle of a function 383 deriving (Show, Eq) 384 385pp_stmt :: Stmt -> [ String ] 386pp_stmt (Return e) = [ "return(" ++ (pp_expr e) ++ ");" ] 387pp_stmt ReturnVoid = [ "return;" ] 388pp_stmt (Block sl) = [ "{" ] ++ (indent_stmts sl) ++ ["}"] 389pp_stmt (StmtList sl) = concat $ map pp_stmt sl 390pp_stmt (Ex e) = [ (pp_expr e) ++ ";" ] 391pp_stmt (If e sl []) = 392 [ "if (" ++ (pp_expr e) ++ ") {" ] ++ (indent_stmts sl) ++ ["}"] 393pp_stmt (If e sl1 sl2) 394 = [ "if (" ++ (pp_expr e) ++ ") {" ] 395 ++ (indent_stmts sl1) 396 ++ ["} else {"] 397 ++ (indent_stmts sl2) ++ [ "}"] 398pp_stmt (DoWhile e sl) 399 = [ "do {" ] ++ (indent_stmts sl) ++ [ "} while (" ++ (pp_expr e) ++ ");" ] 400pp_stmt (While e sl) 401 = [ "while (" ++ (pp_expr e) ++ ") {" ] 402 ++ (indent_stmts sl) ++ ["}"] 403pp_stmt (For e1 e2 e3 sl) 404 = ( [ "for( " ++ (pp_expr e1) ++ "; " 405 ++ (pp_expr e2) ++ "; " 406 ++ (pp_expr e3) ++ ") {" 407 ] 408 ++ (indent_stmts sl) 409 ++ ["}"] 410 ) 411pp_stmt (Switch e cl sl) 412 = ( [ "switch (" ++ (pp_expr e) ++ ") {" ] 413 ++ concat [ pp_case c | c <- cl ] 414 ++ [ "default:" ] 415 ++ (indent_stmts sl) 416 ++ [ "}" ] 417 ) 418pp_stmt Break = [ "break;" ] 419pp_stmt Continue = [ "continue;" ] 420pp_stmt (Label s) = [ s ++ ":" ] 421pp_stmt (Goto s) = [ "goto " ++ s ++ ";" ] 422pp_stmt (VarDecl sc cs ts s Nothing) = 423 [ printf "%s%s%s;" (pp_scopespec sc) (pp_constspec cs) (pp_typespec ts s)] 424pp_stmt (VarDecl sc cs ts s (Just e)) = 425 [ printf "%s%s%s = %s;" 426 (pp_scopespec sc) 427 (pp_constspec cs) 428 (pp_typespec ts s) 429 (pp_expr e) ] 430pp_stmt (SComment s) = [ "// " ++ s ] 431pp_stmt SBlank = [ "" ] 432pp_stmt (SIfDef s l r) = pp_cppcond_stmt "ifdef" s l r 433 434-- 435-- Type specifiers 436-- 437data TypeSpec = Void 438 | Struct String 439 | Union String 440 | Enum String 441 | Ptr TypeSpec 442 | Array Integer TypeSpec 443 | TypeName String 444 | Function ScopeSpec TypeSpec [ Param ] 445 -- XXX: hacky way to get qualifiers on a type spec 446 | ConstT TypeSpec 447 | Volatile TypeSpec 448 deriving (Show, Eq) 449 450pp_typespec :: TypeSpec -> String -> String 451pp_typespec Void n = "void " ++ n 452pp_typespec (Struct s) n = printf "struct %s %s" s n 453pp_typespec (Union s) n = printf "union %s %s" s n 454pp_typespec (Enum s) n = printf "enum %s %s" s n 455pp_typespec (Ptr t) n = pp_typespec t ("*" ++n) 456pp_typespec (Array 0 t) n = pp_typespec t (n++"[]") 457pp_typespec (Array i t) n = pp_typespec t $ printf "%s[%d]" n i 458pp_typespec (TypeName s) n = printf "%s %s" s n 459pp_typespec (Function sc ts pl) n 460 = (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) 461pp_typespec (ConstT t) n = "const " ++ pp_typespec t n 462pp_typespec (Volatile t) n = "volatile " ++ pp_typespec t n 463