1{- 
2   CSyntax: functions for rendering C syntactic structures.  
3   
4  Part of Mackerel: a strawman device definition DSL for Barrelfish
5   
6  Copyright (c) 2007, 2008, 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 CSyntax where
15
16import Data.List
17import Text.Printf
18import MackerelParser
19
20infixr 9 >:
21(>:) :: String -> [String] -> [String]
22s >: [] = [s]
23s >: (x:xs) = (s ++ " " ++ x) : xs
24
25infixr 9 <:
26(<:) :: [String] -> String -> [String]
27[] <: s = [s]
28(h:t) <: s = let (x:xs) = reverse (h:t) in
29             reverse ((x ++ " " ++ s):xs )
30
31header_file name body = 
32    let sym = "__" ++ name ++ "_H" 
33    in unlines [ "#ifndef " ++ sym,
34                 "#define " ++ sym,
35                 "",
36                 body,
37                 "",
38                 "#endif // " ++ sym
39                 ]
40
41undef :: String -> String
42undef n = "#undef " ++ n
43
44include :: String -> String
45include f = "#include <" ++ f ++ ".h>"
46
47include_local :: String -> String
48include_local f = "#include \"" ++ f ++ ".h\""
49
50block :: [String] -> [String]
51block lines = 
52    ["{"] ++ (indent lines) ++ ["}"]
53
54typedef :: String -> String -> String
55typedef name typestr = "typedef " ++ typestr ++ " " ++ name ++ ";" 
56
57packed_typedef :: String -> String -> String
58packed_typedef name typestr = 
59    "#if defined(__GNUC__) && (defined(__amd64) || defined(__i386)) && (__GNUC__ <= 4 && __GNUC_MINOR__ <= 3)\n#pragma pack(push,1)\n#endif\ntypedef " ++ typestr ++ " " ++ name ++ ";\n#if defined(__GNUC__) && (defined(__amd64) || defined(__i386)) && (__GNUC__ <= 4 && __GNUC_MINOR__ <= 3)\n#pragma pack(pop)\n#endif\n" 
60
61constint :: String -> Integer -> String
62constint name val = printf "static const int %s = 0x%0x;" name val
63
64struct :: String -> [ String ] -> [ String ]
65struct name fields =  structunion "struct" name fields 
66
67struct_field n v = printf "%s\t%s;" n v
68
69union :: String -> [ String ] -> [ String ]
70union name fields =  structunion "union" name fields
71
72union_field n v = struct_field n v
73
74structunion :: String -> String -> [ String ] -> [ String ]
75structunion su name fields = 
76    (su ++ " " ++ name) >: (block fields) 
77
78bitfields name fields = 
79    ("struct " ++ name) >: (block fields) <: "__attribute__ ((packed))" 
80
81bitfield n w t = printf "%s\t%s\t:%d;" t n w 
82
83assertsize t s = printf "STATIC_ASSERT_SIZEOF(%s, sizeof(%s));\n" t s
84
85
86enum name vals = 
87    let tname = name -- ++ "_t"   
88    in
89      unlines ( ((printf "typedef enum %s" tname) 
90                >: block [ printf "%s = %s," n v | (n, v) <- vals] )
91                <: (printf "%s;" tname) )
92
93
94function_proto attr rtype name args = 
95    printf "%s %s %s( %s )" attr rtype name (func_args args)
96
97function :: String -> String -> String -> [(String,String)] -> [String] -> String 
98function attr rtype name args body =
99    let proto = function_proto attr rtype name args 
100    in
101    unlines ( [ proto ++ " __attribute__ ((always_inline));",
102                proto ]
103             ++ (block body) )
104 
105inline :: String -> String -> [(String,String)] -> [String] -> String 
106inline rtype name args body =
107    function "static inline" rtype name args body
108             
109func_args:: [(String,String)] -> String
110func_args alist = 
111    concat (intersperse ", " [ (n ++ " " ++ v) | (n,v) <- alist ])
112
113
114multi_comment str = 
115    printf "\n/*\n%s */" (unlines [" * " ++ line | line <- lines str])
116
117comment s = "// " ++ s
118
119indent :: [String] -> [String]
120indent l = [ "    " ++ line | line <- l ]
121
122switch :: String -> [ (String, String) ] -> String -> [String]
123switch disc alts dflt = 
124    (printf "switch (%s)" disc) 
125    >: block ( concat [ [ printf "case %s:" a, printf "%s" l ]
126                            | (a,l) <- alts ]
127               ++ [ "default:", printf "%s" dflt ] )
128
129forloop :: String -> String -> String -> [String] -> [String]
130forloop init iter term body = 
131    (printf "for( %s; %s; %s )" init iter term)
132    >: block body
133
134--
135-- Accumulating strings to print: much of the debugging code we
136-- generate consists of successive calls to snprintf.
137--
138
139snprintf :: String -> [ String ]
140snprintf s = snlike "snprintf" s
141
142snlike fn arg = [ "_avail = (r > sz) ? 0 : sz-r;",
143                  printf "_rc = %s(s+r, _avail, %s);" fn arg,
144                  "if ( _rc > 0 && _rc < _avail) { r += _rc; }"
145                ]
146                  
147snputs :: String -> [ String ]
148snputs s = snprintf (printf "\"%%s\", %s" s)
149
150snputsq :: String -> [ String ]
151snputsq s = snprintf (printf "\"%%s\", \"%s\"" s)
152
153--
154-- Expressions
155--
156expression :: Expr -> String
157expression (ExprConstant i) 
158    = printf "(0x%0x)" i 
159expression (ExprIdentifer i) 
160    = "(" ++ i ++ ")"
161expression (ExprBinOp op v1 v2)
162    = printf "(%s %s %s)" (expression v1) op (expression v2)
163expression (ExprUnOp op v) 
164    = printf "(%s %s)" op (expression v)
165expression (ExprPoly []) = "0"
166expression (ExprPoly p) = concat (intersperse "+" (map multerm p))
167
168multerm :: (Integer, [String] ) -> String
169multerm (i, []) = printf "0x%x" i
170multerm (1, sl) = "(" ++ (concat (intersperse "*" sl)) ++ ")"
171multerm (i, sl) = printf "(%d%s)" i l
172    where l = concat [ ("*" ++ e) | e <- sl ]
173
174--
175-- Expressions relative to the device pointer
176--
177dexpr (ExprConstant i) = printf "0x%0x" i 
178dexpr (ExprIdentifer i) = "(dev->" ++ i ++ ")"
179dexpr (ExprBinOp op v1 v2) = printf "%s %s %s" (dexpr v1) op (dexpr v2)
180dexpr (ExprUnOp op v) = printf "(%s %s)" op (dexpr v)
181
182