1{- 2 SkateBackendCommon: Common code backend 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 SkateBackendCommon where 16 17import Text.ParserCombinators.Parsec.Pos 18import SkateParser 19import SkateTypes 20import qualified CAbsSyntax as C 21 22import Data.Char (toUpper, isAlpha) 23 24 25{----------------------------------------------------------------------------- 26- Premable and Imports 27------------------------------------------------------------------------------} 28 29skate_c_includepath :: String -> String 30skate_c_includepath s = "schemas/" ++ s ++ "_schema.h" 31 32skate_c_preamble :: String -> String -> String -> C.Unit 33skate_c_preamble n d f = C.MultiComment [ 34 "SCHEMA DEFINITION: " ++ (map toUpper d) ++ " (" ++ n ++ ")", 35 "", 36 "Input File: " ++ f, 37 "", 38 "Copyright (c) 2017, ETH Zurich.", 39 "All rights reserved.", 40 "", 41 "This file is distributed under the terms in the attached LICENSE", 42 "file. If you do not find this file, copies can be found by", 43 "writing to:", 44 "ETH Zurich D-INFK, Universitaetstr. 6, CH-8092 Zurich.", 45 "Attn: Systems Group.", 46 "", 47 "THIS FILE IS AUTOMATICALLY GENERATED BY SKATE: DO NOT EDIT!"]; 48 49 50{----------------------------------------------------------------------------- 51- Name / Identifier conversions 52------------------------------------------------------------------------------} 53 54 55{- converts a qualified identifier (a.b.c) into a valid C name a_b_c -} 56identifier_to_cname :: [Char] -> [Char] 57identifier_to_cname [] = [] 58identifier_to_cname (xs:x) = 59 if xs == '.' then '_' : identifier_to_cname x 60 else xs : identifier_to_cname x 61 62{- makes a type out of a cname -} 63make_type_name :: String -> String 64make_type_name s = s ++ "_t" 65 66make_format_name_pr :: String -> String 67make_format_name_pr s = map toUpper (s ++ "_pri") 68 69make_format_name_rd :: String -> String 70make_format_name_rd s = map toUpper (s ++ "_scn") 71 72make_format_name_extract_all :: String -> String 73make_format_name_extract_all s = map toUpper (s ++ "_extract_all") 74 75make_format_name_fields_pr :: String -> String 76make_format_name_fields_pr s = map toUpper (s ++ "_fields_pri") 77 78make_format_name_fields_rd :: String -> String 79make_format_name_fields_rd s = map toUpper (s ++ "_fields_scn") 80 81 82{--} 83identifier_to_prolog :: [Char] -> [Char] 84identifier_to_prolog [] = [] 85identifier_to_prolog (xs:x) = 86 if xs == '.' then '_' : identifier_to_cname x 87 else xs : identifier_to_cname x 88 89 90typeref_to_ctype :: TypeRef -> C.TypeSpec 91typeref_to_ctype (TBuiltIn UInt8) = C.TypeName "uint8_t" 92typeref_to_ctype (TBuiltIn UInt16) = C.TypeName "uint16_t" 93typeref_to_ctype (TBuiltIn UInt32) = C.TypeName "uint32_t" 94typeref_to_ctype (TBuiltIn UInt64) = C.TypeName "uint64_t" 95typeref_to_ctype (TBuiltIn UIntPtr) = C.TypeName "uintptr_t" 96typeref_to_ctype (TBuiltIn Int8) = C.TypeName "int8_t" 97typeref_to_ctype (TBuiltIn Int16) = C.TypeName "int16_t" 98typeref_to_ctype (TBuiltIn Int32) = C.TypeName "int32_t" 99typeref_to_ctype (TBuiltIn Int64) = C.TypeName "int64_t" 100typeref_to_ctype (TBuiltIn IntPtr) = C.TypeName "intptr_t" 101typeref_to_ctype (TBuiltIn Size) = C.TypeName "size_t" 102typeref_to_ctype (TBuiltIn Bool) = C.TypeName "bool" 103typeref_to_ctype (TBuiltIn String) = C.Ptr (C.TypeName "char") 104typeref_to_ctype (TBuiltIn Char) = C.TypeName "char" 105typeref_to_ctype (TBuiltIn Capref) = C.Struct "capref" 106typeref_to_ctype (TEnum i _ ) = C.TypeName (make_type_name (identifier_to_cname i)) 107typeref_to_ctype (TConstant i _ ) = C.TypeName (make_type_name (identifier_to_cname i)) 108typeref_to_ctype (TFact i _) = C.TypeName (make_type_name (identifier_to_cname i)) 109typeref_to_ctype (TFlags i _ ) = C.TypeName (make_type_name (identifier_to_cname i)) 110 111 112{- 113============================================================================== 114= Function Signatures 115============================================================================== 116-} 117 118 119skate_c_errval_t :: C.TypeSpec 120skate_c_errval_t = C.TypeName "errval_t" 121 122skate_c_void_t :: C.TypeSpec 123skate_c_void_t = C.TypeName "void" 124 125skate_c_fn_decl :: C.TypeSpec -> String -> [String] -> [C.Param] -> C.Unit 126skate_c_fn_decl rt n c p = C.UnitList [ 127 C.Blank, C.Blank, 128 C.MultiDoxy c, 129 C.FunctionDecl C.NoScope rt fn p] 130 where 131 fn = (identifier_to_cname n) 132 133 134skate_c_fn_def :: C.TypeSpec -> String -> [String] -> [C.Param] -> [C.Stmt] -> C.Unit 135skate_c_fn_def rt n c p st = C.UnitList [ 136 C.Blank, C.Blank, 137 C.MultiDoxy c, 138 C.FunctionDef C.NoScope rt fn p st] 139 where 140 fn = (identifier_to_cname n) 141 142 143 144 145skate_c_type_comment :: String -> String -> String -> SourcePos -> C.Unit 146skate_c_type_comment t desc defined sp = C.MultiDoxy [ 147 "@brief " ++ desc, 148 "", 149 "Type: " ++ t ++ " " ++ defined, 150 "Defined: " ++ (show sp)] 151 152{----------------------------------------------------------------------------- 153- schema.namespace.decl.describe() 154------------------------------------------------------------------------------} 155 156skate_c_fn_name_describe :: String -> String 157skate_c_fn_name_describe fn = (make_qualified_identifer fn "describe") 158 159skate_c_fn_decl_describe :: String -> C.Unit 160skate_c_fn_decl_describe fn = skate_c_fn_decl skate_c_void_t fn_name doxy [] 161 where 162 fn_name = (skate_c_fn_name_describe fn) 163 doxy = ["@brief Describes the " ++ fn] 164 165 166skate_c_fn_def_describe :: String -> [ C.Stmt ] -> C.Unit 167skate_c_fn_def_describe fn stmt = skate_c_fn_def skate_c_void_t fn_name doxy [] stmt 168 where 169 fn_name = identifier_to_cname ((skate_c_fn_name_describe fn)) 170 doxy = ["@brief Describes the " ++ fn] 171 172 173{----------------------------------------------------------------------------- 174- schema.namespace.decl.describe() 175------------------------------------------------------------------------------} 176 177skate_c_fn_name_explain :: String -> String 178skate_c_fn_name_explain fn = (make_qualified_identifer fn "explain") 179 180 181{----------------------------------------------------------------------------- 182- schema.namespace.decl.print() 183------------------------------------------------------------------------------} 184 185skate_c_fn_name_print :: String -> String 186skate_c_fn_name_print fn = (make_qualified_identifer fn "print") 187 188{----------------------------------------------------------------------------- 189- schema.namespace.decl.add() 190------------------------------------------------------------------------------} 191 192skate_c_fn_name_add :: String -> String 193skate_c_fn_name_add fn = (make_qualified_identifer fn "add") 194 195skate_c_fn_decl_add :: String -> ([String], [C.Param])-> C.Unit 196skate_c_fn_decl_add fn (d, p) = skate_c_fn_decl skate_c_errval_t fn_name doxy p 197 where 198 fn_name = (skate_c_fn_name_add fn) 199 doxy = ["@brief Adds the " ++ fn, ""] ++ d 200 201 202 203skate_c_fn_def_add :: String -> ([String], [C.Param]) -> [ C.Stmt ] -> C.Unit 204skate_c_fn_def_add fn (d, p) s = skate_c_fn_def skate_c_errval_t fn_name doxy p s 205 where 206 fn_name = (skate_c_fn_name_add fn) 207 doxy = ["@brief Adds the " ++ fn, ""] ++ d 208 209{----------------------------------------------------------------------------- 210- schema.namespace.decl.delete() 211------------------------------------------------------------------------------} 212 213skate_c_fn_name_delete :: String -> String 214skate_c_fn_name_delete fn = (make_qualified_identifer fn "delete") 215 216{----------------------------------------------------------------------------- 217- schema.namespace.decl.list() 218------------------------------------------------------------------------------} 219 220skate_c_fn_name_list :: String -> String 221skate_c_fn_name_list fn = (make_qualified_identifer fn "list") 222 223 224{----------------------------------------------------------------------------- 225- Function signatures 226------------------------------------------------------------------------------} 227 228skate_c_fn_params_fact :: String -> ([String], [C.Param]) 229skate_c_fn_params_fact fact = ( 230 ["@param fact Pointer to a struct " ++ fact], 231 [C.Param (C.Ptr $ C.Struct ( make_type_name (identifier_to_cname fact))) "fact" ]) 232 233skate_c_fn_params :: C.TypeSpec -> String -> [C.Param] 234skate_c_fn_params t var = [C.Param t var] 235 236 237 238skate_c_fn_decls_facts :: String -> [FactAttrib] -> [C.Unit] 239skate_c_fn_decls_facts fn attribs = [ 240 skate_c_fn_decl_describe fn, 241 skate_c_fn_decl_add fn p] 242 where 243 p = skate_c_fn_params_fact fn 244 245skate_c_fn_defs_facts :: String -> [FactAttrib] -> [C.Stmt] -> [C.Unit] 246skate_c_fn_defs_facts fn attribs stmt = [ 247 skate_c_fn_def_add fn p stmt] 248 where 249 p = skate_c_fn_params_fact fn 250 251 252 253 254-- | FunctionDef ScopeSpec TypeSpec String [ Param ] [ Stmt ] 255-- | StaticInline TypeSpec String [ Param ] [ Stmt ] 256-- | FunctionDecl ScopeSpec TypeSpec String [ Param ] 257