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