1{- 2 SkateBackendCode: The C 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 14module SkateBackendCode where 15 16import Data.Char 17import Data.List 18import Data.Char 19 20import Text.ParserCombinators.Parsec.Pos 21 22import qualified CAbsSyntax as C 23import SkateParser 24import SkateSchema 25import SkateTypes 26import SkateBackendCommon 27import qualified SkateTypeTable as TT 28 29 30 31compile :: String -> String -> SchemaRecord -> String 32compile infile outfile s = unlines $ C.pp_unit $ (skate_c_body s infile) 33 34skate_c_body :: SchemaRecord -> String -> C.Unit 35skate_c_body sr infile = 36 let 37 Schema n d decls imps sp = (schema sr) 38 in 39 C.UnitList [ 40 (skate_c_preamble n d infile), 41 C.Blank, C.Blank, 42 skate_c_includes n, 43 C.Blank, C.Blank, 44 C.MultiComment [ 45 "====================================================================", 46 "Flags", 47 "====================================================================" 48 ], C.Blank, 49 C.UnitList $ (skate_c_code_defs (flags sr) (types sr)), 50 C.Blank, C.Blank, 51 C.MultiComment [ 52 "====================================================================", 53 "Constants", 54 "====================================================================" 55 ], C.Blank, 56 C.UnitList $ (skate_c_code_defs (constants sr) (types sr)), 57 C.Blank, C.Blank, 58 C.MultiComment [ 59 "====================================================================", 60 "Enumerations", 61 "====================================================================" 62 ], C.Blank, 63 C.UnitList $ (skate_c_code_defs (enumerations sr) (types sr)), 64 C.Blank, C.Blank, 65 C.MultiComment [ 66 "====================================================================", 67 "Facts", 68 "====================================================================" 69 ], C.Blank, 70 C.UnitList $ (skate_c_code_defs (facts sr) (types sr)), 71 C.Blank, C.Blank] 72 73 74skate_c_includes :: String -> C.Unit 75skate_c_includes sr = C.UnitList [ 76 C.Include C.Standard "barrelfish/barrelfish.h", 77 C.Include C.Standard "skb/skb.h", 78 C.Include C.Standard (skate_c_includepath sr) 79 ] 80 81 82{------------------------------------------------------------------------------ 83Function Add 84------------------------------------------------------------------------------} 85 86skate_c_vardecl :: C.TypeSpec -> String -> Maybe C.Expr -> C.Stmt 87skate_c_vardecl t s e = C.VarDecl C.NoScope C.NonConst t s e 88 89skate_c_vardecl_err :: C.Stmt 90skate_c_vardecl_err = skate_c_vardecl (C.TypeName "errval_t") "err" Nothing 91 92skate_c_errvar :: C.Expr 93skate_c_errvar = C.Variable "err" 94 95skate_c_code_add :: Declaration -> [TT.TTEntry] -> [C.Unit] 96skate_c_code_add def@(Fact i d attrib sp) ttbl = 97 skate_c_fn_defs_facts i attrib [ 98 skate_c_vardecl_err, 99 C.SBlank, 100 C.SComment "TODO: Add some checks.", 101 C.SBlank, 102 C.Ex $ C.Assignment skate_c_errvar (C.Call "skb_add_fact" [ 103 C.DefineExpr fmt, 104 C.Call (make_format_name_extract_all cname) [C.Variable "fact"] 105 ] 106 ), 107 C.If (C.Call "err_is_fail" [skate_c_errvar]) [ 108 C.SComment "TODO: Add some good error message", 109 C.Return skate_c_errvar] 110 [], 111 C.SBlank, 112 C.Return skate_c_errvar 113 ] 114 where 115 cname = identifier_to_cname i 116 fmt = make_format_name_fields_pr cname 117 118 119 120{----------------------------------------------------------------------------- 121- Facts 122------------------------------------------------------------------------------} 123 124skate_c_code_fact :: Declaration -> [TT.TTEntry] -> [C.Unit] 125skate_c_code_fact def@(Fact i d attrib sp) ttbl = [ 126 (skate_c_type_comment "fact" d i sp), 127 C.Blank] ++ 128 (skate_c_code_add def ttbl) 129 130 131skate_c_code_one_def :: Declaration -> [TT.TTEntry] -> [ C.Unit ] 132skate_c_code_one_def de@(Fact i d a sp) tt = skate_c_code_fact de tt 133skate_c_code_one_def de@(Flags i d w f sp) _ = [] --skate_c_header_flags i d w f sp 134skate_c_code_one_def de@(Constants i d t f sp) _ = [] --skate_c_header_const i d t f sp 135skate_c_code_one_def de@(Enumeration i d f sp) _ = [] --skate_c_header_enum i d f sp 136skate_c_code_one_def _ _ = [] 137 138 139skate_c_code_defs :: [Declaration] -> [TT.TTEntry] -> [ C.Unit ] 140skate_c_code_defs decls ttbl = [C.UnitList $ skate_c_code_one_def d ttbl | d <- decls] 141