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