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