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 18 19infixr 9 >: 20(>:) :: String -> [String] -> [String] 21s >: [] = [s] 22s >: (x:xs) = (s ++ " " ++ x) : xs 23 24infixr 9 <: 25(<:) :: [String] -> String -> [String] 26[] <: s = [s] 27(h:t) <: s = let (x:xs) = reverse (h:t) in 28 reverse ((x ++ " " ++ s):xs ) 29 30header_file :: String -> String -> String 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 57constint :: String -> Integer -> String 58constint name val = printf "static const int %s = 0x%0x;" name val 59 60struct :: String -> [ String ] -> [ String ] 61struct name fields = structunion "struct" name fields 62 63struct_field n v = printf "%s\t%s;" n v 64 65union :: String -> [ String ] -> [ String ] 66union name fields = structunion "union" name fields 67 68union_field n v = struct_field n v 69 70structunion :: String -> String -> [ String ] -> [ String ] 71structunion su name fields = 72 (su ++ " " ++ name) >: (block fields) 73 74bitfields name fields = 75 ("struct " ++ name) >: (block fields) <: "__attribute__ ((packed))" 76 77bitfield n w t = printf "%s\t%s\t:%d;" t n w 78 79 80enum :: String -> [ (String, String) ] -> String 81enum name vals = 82 let tname = name -- ++ "_t" 83 in 84 unlines ( ((printf "typedef enum %s" tname) 85 >: block [ printf "%s = %s," n v | (n, v) <- vals] ) 86 <: (printf "%s;" tname) ) 87 88enum_anon :: String -> [ (String, String) ] -> [String] 89enum_anon tag vals = ("enum " ++ tag) >: block [ printf "%s = %s," n v | (n, v) <- vals] 90 91 92function_proto :: String -> String -> String -> [(String,String)] -> String 93function_proto attr rtype name args = 94 printf "%s %s %s( %s )" attr rtype name (func_args args) 95 96function1 :: String -> String -> String -> [(String,String)] -> [String] -> [String ] 97function1 attr rtype name args body 98 = (function_proto attr rtype name args ):(block body) 99 100static :: String -> String -> [(String,String)] -> [String] -> [ String ] 101static rtype name args body = function1 "static" rtype name args body 102 103inline :: String -> String -> [(String,String)] -> [String] -> [String] 104inline rtype name args body = 105 function1 "static inline" rtype name args body 106 107 108func_args:: [(String,String)] -> String 109func_args alist = 110 concat (intersperse ", " [ (n ++ " " ++ v) | (n,v) <- alist ]) 111 112multi_comment1 str = [ "", "/*" ] ++ [" * " ++ l | l <- lines str] ++ [ " */"] 113 114comment s = "// " ++ s 115 116indent :: [String] -> [String] 117indent l = [ " " ++ line | line <- l ] 118 119switch :: String -> [ (String, String) ] -> String -> [String] 120switch disc alts dflt = 121 (printf "switch (%s)" disc) 122 >: block ( concat [ [ printf "case %s:" a, printf "%s" l ] 123 | (a,l) <- alts ] 124 ++ [ "default:", printf "%s" dflt ] ) 125 126switch1 :: String -> [ (String,[String]) ] -> [String] -> [String] 127switch1 disc alts dflt = 128 (printf "switch (%s)" disc) 129 >: (block (concat [ (printf "case %s:" a):l | (a,l) <- alts ] ++ ("default:"):dflt )) 130 131if_stmt :: String -> [String] -> [String] 132if_stmt cond thenclause = 133 (printf "if (%s) " cond):block thenclause 134 135if_else :: String -> [String] -> [String] -> [String] 136if_else cond thenclause elseclause = 137 (if_stmt cond thenclause) ++ ("else":(block elseclause)) 138 139forloop :: String -> String -> String -> [String] -> [String] 140forloop init iter term body = 141 (printf "for( %s; %s; %s )" init iter term) 142 >: block body 143 144-- 145-- Accumulating strings to print: much of the debugging code we 146-- generate consists of successive calls to snprintf. 147-- 148 149snprintf :: String -> [ String ] 150snprintf s = snlike "snprintf" s 151 152snlike fn arg = [ "_avail = (r > sz) ? 0 : sz-r;", 153 printf "_rc = %s(s+r, _avail, %s);" fn arg, 154 "if ( _rc > 0 && _rc < _avail) { r += _rc; }" 155 ] 156 157snputs :: String -> [ String ] 158snputs s = snprintf (printf "\"%%s\", %s" s) 159 160snputsq :: String -> [ String ] 161snputsq s = snprintf (printf "\"%%s\", \"%s\"" s) 162