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