1{- 2 CAbsSyntax: combinators for generating C99 syntax 3 4 Part of Mackerel: a strawman device definition DSL for Barrelfish 5 6 Copyright (c) 2009, 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, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group. 12-} 13 14module CAbsSyntax where 15 16import Text.Printf 17import Data.Char 18import Data.List 19 20-- 21-- Just enough syntax to generate files for Mackerel, etc. 22-- 23 24 25tabstop :: String 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 | Parens Expr -- (e) 57 deriving (Show, Eq) 58 59pp_expr :: Expr -> String 60pp_expr (NumConstant i) = printf "%d" i 61pp_expr (HexConstant i) = printf "0x%x" i 62pp_expr (StringConstant s) = "\"" ++ (concat $ map (\x -> showLitChar x "") s) ++ "\"" 63pp_expr (StringCat l) = concat $ intersperse " " $ map pp_strelem l 64pp_expr (CharConstant c) = "'" ++ showLitChar c "'" 65pp_expr (Variable s) = s 66pp_expr (AddressOf e) = "&" ++ (pp_par_expr e) 67pp_expr (DerefPtr e) = "*" ++ (pp_par_expr e) 68pp_expr (DerefField e s) = (pp_par_expr e) ++ "->" ++ s 69pp_expr (Assignment e1 e2) = (pp_expr e1) ++ " = " ++ (pp_par_expr e2) 70pp_expr (Unary o e) = (pp_unop o) ++ (pp_par_expr e) 71pp_expr (Binary o e1 e2) 72 = (pp_par_expr e1) ++" " ++ (pp_binop o) ++ " "++(pp_par_expr e2) 73pp_expr (Ternary e1 e2 e3) 74 = (pp_par_expr e1) ++ " ? " ++ (pp_par_expr e2) ++ " : " ++ (pp_par_expr e3) 75pp_expr (FieldOf e s) = (pp_par_expr e) ++ "." ++ s 76pp_expr (SubscriptOf e1 e2) = (pp_par_expr e1) ++ "[" ++ (pp_expr e2) ++ "]" 77pp_expr (Call f al) 78 = f ++ "(" ++ (concat $ intersperse ", " [ pp_expr e | e <- al ]) ++ ")" 79pp_expr (CallInd f al) 80 = "(" ++ (pp_expr f) ++ ")(" ++ (concat $ intersperse ", " [ pp_expr e | e <- al ]) ++ ")" 81pp_expr (SizeOf e) = "sizeof(" ++ (pp_expr e) ++ ")" 82pp_expr (SizeOfT t) = "sizeof(" ++ (pp_typespec t "") ++ ")" 83pp_expr (Cast s e) = "(" ++ (pp_typespec s "") ++ ")(" ++ (pp_expr e) ++ ")" 84pp_expr (PostInc e) = (pp_par_expr e) ++ "++" 85pp_expr (PostDec e) = (pp_par_expr e) ++ "--" 86pp_expr (Parens e) = "(" ++ (pp_expr e) ++ ")" 87 88pp_par_expr :: Expr -> String 89pp_par_expr (Variable s) = s 90pp_par_expr e@(NumConstant _) = pp_expr e 91pp_par_expr e@(HexConstant _) = pp_expr e 92pp_par_expr c@(Call _ _) = pp_expr c 93pp_par_expr e = "(" ++ (pp_expr e) ++ ")" 94 95data StrElem = QStr String 96 | NStr String 97 deriving (Show, Eq) 98 99pp_strelem :: StrElem -> String 100pp_strelem (QStr s) = pp_expr (StringConstant s) 101pp_strelem (NStr s) = s 102 103-- 104-- Binary operators 105-- 106data BinOp = Plus 107 | Minus 108 | Times 109 | Divide 110 | Modulo 111 | Equals 112 | NotEquals 113 | GreaterThan 114 | LessThan 115 | GreaterThanEq 116 | LessThanEq 117 | BitwiseAnd 118 | BitwiseOr 119 | BitwiseXor 120 | And 121 | Or 122 | LeftShift 123 | RightShift 124 deriving (Show, Eq) 125 126pp_binop :: BinOp -> String 127pp_binop Plus = "+" 128pp_binop Minus = "-" 129pp_binop Times = "*" 130pp_binop Divide = "/" 131pp_binop Modulo = "%" 132pp_binop Equals= "==" 133pp_binop NotEquals= "!=" 134pp_binop GreaterThan= ">" 135pp_binop LessThan = "<" 136pp_binop GreaterThanEq= ">=" 137pp_binop LessThanEq= "<=" 138pp_binop BitwiseAnd= "&" 139pp_binop BitwiseOr= "|" 140pp_binop BitwiseXor= "^" 141pp_binop And= "&&" 142pp_binop Or = "||" 143pp_binop LeftShift= "<<" 144pp_binop RightShift= ">>" 145 146-- 147-- Unary operators 148-- 149data UnOp = Not | Negate | BitwiseNot 150 deriving (Show, Eq) 151 152pp_unop :: UnOp -> String 153pp_unop Not = "!" 154pp_unop Negate = "-" 155pp_unop BitwiseNot = "~" 156 157-- 158-- Parameters to function definitions 159-- 160data Param = Param TypeSpec String 161 deriving (Show, Eq) 162 163pp_param :: Param -> String 164pp_param (Param t s) = (pp_typespec t s) 165 166-- 167-- Members of an enumeration definition 168-- 169data EnumItem = EnumItem String (Maybe Expr) 170 deriving (Show, Eq) 171 172pp_enumitem :: EnumItem -> String 173pp_enumitem (EnumItem s (Just e)) = s ++ " = " ++( pp_expr e) 174pp_enumitem (EnumItem s Nothing) = s 175 176 177-- 178-- Include directives 179-- 180data IncludePath = Standard | Local 181 deriving (Show, Eq) 182pp_include :: IncludePath -> String -> String 183pp_include Standard f = printf "#include <%s>" f 184pp_include Local f = printf "#include \"%s\"" f 185 186-- 187-- Scope of a function or variable 188-- 189data ScopeSpec = Extern | Static | NoScope 190 deriving (Show, Eq) 191 192pp_scopespec :: ScopeSpec -> String 193pp_scopespec Extern = "extern " 194pp_scopespec Static = "static " 195pp_scopespec NoScope = "" 196 197-- 198-- Constancy 199-- 200data ConstSpec = Const | NonConst 201 deriving (Show, Eq) 202pp_constspec :: ConstSpec -> String 203pp_constspec Const = "const " 204pp_constspec NonConst = "" 205 206-- 207-- A Unit is a chunk of source file, i.e. top-level syntactic constructs. 208-- 209-- Note that we treat static inlines as their own construct. It's easier. 210-- 211data Unit = Comment String 212 | MultiComment [ String ] 213 | TypeDef TypeSpec String 214 | FunctionDef ScopeSpec TypeSpec String [ Param ] [ Stmt ] 215 | StaticInline TypeSpec String [ Param ] [ Stmt ] 216 | StructDecl String [ Param ] 217 | UnionDecl String [ Param ] 218 | EnumDecl String [ EnumItem ] 219 | FunctionDecl TypeSpec String [ Param ] 220 | GVarDecl ScopeSpec ConstSpec TypeSpec String (Maybe Expr) 221 | Define String [ String ] String 222 | Undef String 223 | IfDef String [ Unit ] [ Unit ] 224 | IfNDef String [ Unit ] [ Unit ] 225 | HashIf String [ Unit ] [ Unit ] 226 | NoOp 227 | Blank 228 | Include IncludePath String 229 deriving (Show, Eq) 230 231pp_unit :: Unit -> [ String ] 232pp_unit (Comment s) = [ "// " ++ s ] 233pp_unit (MultiComment sl) = ["/*"] ++ [ " * " ++ s | s <- sl ] ++ [ " */"] 234pp_unit (TypeDef ts s) = [ "typedef " ++ (pp_typespec ts s) ++ ";" ] 235pp_unit (FunctionDef sc ts n pl body) = 236 [ (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) ] ++ (pp_fnbody body) 237pp_unit (StaticInline ts n pl body) = 238 [ hd ++ " __attribute__ ((always_inline));", 239 hd ] ++ (pp_fnbody body) 240 where 241 hd = "static inline " ++ (pp_fnhead ts n pl) 242pp_unit (StructDecl s pl) = 243 [ printf "struct %s {" s ] ++ [ tabstop ++ (pp_param p) ++ ";" 244 | p <- pl ] ++ ["};"] 245pp_unit (UnionDecl s pl) = 246 [ printf "union %s {" s ] ++ [ tabstop ++ (pp_param p) | p <- pl ] ++ ["}"] 247pp_unit (EnumDecl s el) = 248 [ printf "enum %s {" s ] 249 ++ 250 (comma_sep_lines [ tabstop ++ (pp_enumitem e) | e <- el ]) 251 ++ 252 ["};"] 253pp_unit (FunctionDecl ts n pl) = 254 [ (pp_fnhead ts n pl) ++ ";" ] 255pp_unit (GVarDecl sc cs ts s Nothing) = 256 [ printf "%s%s%s;" (pp_scopespec sc) (pp_constspec cs) (pp_typespec ts s)] 257pp_unit (GVarDecl sc cs ts s (Just e)) = 258 [ printf "%s%s%s = %s;" 259 (pp_scopespec sc) 260 (pp_constspec cs) 261 (pp_typespec ts s) 262 (pp_expr e) ] 263pp_unit (Define n [] v) = [ printf "#define %s %s" n v ] 264pp_unit (Define n al v) 265 = [ printf "#define %s(%s) %s" n (concat $ intersperse "," al) v ] 266pp_unit (Undef s) = [ "#undef " ++ s ] 267pp_unit (IfDef s l r) = pp_cppcond "ifdef" s l r 268pp_unit (IfNDef s l r) = pp_cppcond "ifndef" s l r 269pp_unit (HashIf s l r) = pp_cppcond "if" s l r 270pp_unit NoOp = [] 271pp_unit Blank = [""] 272pp_unit (Include s p) = [ pp_include s p ] 273 274comma_sep_lines :: [String] -> [String] 275comma_sep_lines [] = [] 276comma_sep_lines [s] = [s] 277comma_sep_lines (s:sl) = (s ++ ","):(comma_sep_lines sl) 278 279pp_cppcond :: String -> String -> [ Unit ] -> [ Unit ] -> [ String ] 280pp_cppcond t e l r = 281 [ "#" ++ t ++ " " ++ e ] 282 ++ 283 (concat [ pp_unit u | u <- l ]) 284 ++ 285 (if r == [] then [] else "#else":concat [ pp_unit u | u <- r ]) 286 ++ 287 [ "#endif // " ++ e ] 288 289 290pp_fnbody :: [ Stmt ] -> [ String ] 291pp_fnbody body = [ "{" ] ++ (indent_stmts body) ++ [ "}", ""] 292 293pp_fnhead :: TypeSpec -> String -> [ Param ] -> String 294pp_fnhead ts n pl = 295 (pp_typespec ts n) ++ "(" ++ parlist ++ ")" 296 where 297 parlist = case pl of 298 [] -> "void" 299 xs -> concat $ intersperse ", " [ pp_param p | p <- xs ] 300 301-- 302-- Branches of a case statement: note that they fall through 303-- 304data Case = Case Expr [ Stmt ] 305 deriving (Show, Eq) 306 307pp_case :: Case -> [ String ] 308pp_case (Case e s) 309 = [ "case " ++ (pp_expr e) ++ ":" ] ++ (indent_stmts s) 310 311-- 312-- Statements. 313-- 314data Stmt = Return Expr 315 | ReturnVoid 316 | Block [ Stmt ] 317 | StmtList [ Stmt ] 318 | Ex Expr 319 | If Expr [ Stmt ] [ Stmt ] 320 | DoWhile Expr [ Stmt ] 321 | While Expr [ Stmt ] 322 | For Expr Expr Expr [ Stmt ] 323 | Switch Expr [ Case ] [ Stmt ] -- last list is default clause 324 | Break 325 | Continue 326 | Label String 327 | Goto String 328 | VarDecl ScopeSpec ConstSpec TypeSpec String (Maybe Expr) 329 | SComment String 330 deriving (Show, Eq) 331 332pp_stmt :: Stmt -> [ String ] 333pp_stmt (Return e) = [ "return(" ++ (pp_expr e) ++ ");" ] 334pp_stmt ReturnVoid = [ "return;" ] 335pp_stmt (Block sl) = [ "{" ] ++ (indent_stmts sl) ++ ["}"] 336pp_stmt (StmtList sl) = concat $ map pp_stmt sl 337pp_stmt (Ex e) = [ (pp_expr e) ++ ";" ] 338pp_stmt (If e sl []) = 339 [ "if (" ++ (pp_expr e) ++ ") {" ] ++ (indent_stmts sl) ++ ["}"] 340pp_stmt (If e sl1 sl2) 341 = [ "if (" ++ (pp_expr e) ++ ") {" ] 342 ++ (indent_stmts sl1) 343 ++ ["} else {"] 344 ++ (indent_stmts sl2) ++ [ "}"] 345pp_stmt (DoWhile e sl) 346 = [ "do {" ] ++ (indent_stmts sl) ++ [ "} while (" ++ (pp_expr e) ++ ");" ] 347pp_stmt (While e sl) 348 = [ "while (" ++ (pp_expr e) ++ ") {" ] 349 ++ (indent_stmts sl) ++ ["}"] 350pp_stmt (For e1 e2 e3 sl) 351 = ( [ "for( " ++ (pp_expr e1) ++ "; " 352 ++ (pp_expr e2) ++ "; " 353 ++ (pp_expr e3) ++ ") {" 354 ] 355 ++ (indent_stmts sl) 356 ++ ["}"] 357 ) 358pp_stmt (Switch e cl sl) 359 = ( [ "switch (" ++ (pp_expr e) ++ ") {" ] 360 ++ concat [ pp_case c | c <- cl ] 361 ++ [ "default:" ] 362 ++ (indent_stmts sl) 363 ++ [ "}" ] 364 ) 365pp_stmt Break = [ "break;" ] 366pp_stmt Continue = [ "continue;" ] 367pp_stmt (Label s) = [ s ++ ":" ] 368pp_stmt (Goto s) = [ "goto " ++ s ++ ";" ] 369pp_stmt (VarDecl sc cs ts s Nothing) = 370 [ printf "%s%s%s;" (pp_scopespec sc) (pp_constspec cs) (pp_typespec ts s)] 371pp_stmt (VarDecl sc cs ts s (Just e)) = 372 [ printf "%s%s%s = %s;" 373 (pp_scopespec sc) 374 (pp_constspec cs) 375 (pp_typespec ts s) 376 (pp_expr e) ] 377pp_stmt (SComment s) = [ "// " ++ s ] 378 379-- 380-- Type specifiers 381-- 382data TypeSpec = Void 383 | Struct String 384 | Union String 385 | Enum String 386 | Ptr TypeSpec 387 | Array Integer TypeSpec 388 | TypeName String 389 | Function ScopeSpec TypeSpec [ Param ] 390 deriving (Show, Eq) 391 392pp_typespec :: TypeSpec -> String -> String 393pp_typespec Void n = "void " ++ n 394pp_typespec (Struct s) n = printf "struct %s %s" s n 395pp_typespec (Union s) n = printf "union %s %s" s n 396pp_typespec (Enum s) n = printf "enum %s %s" s n 397pp_typespec (Ptr t) n = pp_typespec t ("*" ++n) 398pp_typespec (Array 0 t) n = pp_typespec t (n++"[]") 399pp_typespec (Array i t) n = pp_typespec t $ printf "%s[%d]" n i 400pp_typespec (TypeName s) n = printf "%s %s" s n 401pp_typespec (Function sc ts pl) n 402 = (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) 403