1%include polycode.fmt
2
3%if false
4  Flounder2: an even more simpler IDL for Barrelfish
5
6  Copyright (c) 2009 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%endif
13
14
15\section{The Abstract Syntax}
16
17In this module, we define the combinators to embed the Flounder
18language into Haskell. So, we will mix the design the Abstract-Syntax
19Tree with the definition of some handy combinators.
20
21> module Syntax where
22
23
24\subsection{Interface Header}
25
26
27First, we define the abstract syntax of our embedded language. At the
28top-level is the \emph{interface} definition. It consists of a @name@
29and, potentially, a @description@. It contains a list of
30\emph{declarations}.
31
32> data Interface = Interface String (Maybe String) [ Declaration ]
33>
34> generalInterface :: Maybe String -> String -> [ Declaration ] -> Interface
35> generalInterface description name declarations =
36>     Interface name description declarations
37
38Which can be further refined into an anonymous interface, ie. with no
39description:
40
41> aInterface :: String -> [Declaration] -> Interface
42> aInterface = generalInterface Nothing
43
44And, the more common, a documented interface:
45
46> interface :: String -> String -> [Declaration] -> Interface
47> interface name description declarations =
48>     generalInterface (Just description) name declarations
49
50Finally, various getters:
51
52> interfaceName :: Interface -> String
53> interfaceName (Interface name _ _) = name
54
55\subsection{Declarations}
56
57A declaration is either a \emph{type definition} or a \emph{message
58definition}. In the next subsections, we define these terms in turn.
59
60> data Declaration = Typedef TypeDef
61>                  | Messagedef MessageDef
62
63
64\subsubsection{Declaring types}
65
66
67We can define new types out of existing ones thanks to five
68constructs:
69\begin{description}
70        \item[Structure:] like C @struct@, it defines a name-indexed record
71        \item[Array:] defines a static array of elements of a given type
72        \item[Enumeration:] like C @enum@, defines a sum-type over some elements
73        \item[Alias:] redefine the name of an already defined type
74\end{description}
75
76> data TypeDef = TStruct String [StructField]
77>              | TArray TypeRef String Integer
78>              | TEnum String [String]
79>              | TAlias String TypeRef
80>              | TAliasT String TypeBuiltin
81
82In this definition, we notice the presence of @TypeRef@: indeed, when
83we construct a new type, it can use either built-in types, such as
84@uint8_t@, or previously defined types, identified by their name.
85
86> data TypeRef = Builtin TypeBuiltin
87>              | TypeVar String
88>              | TypeAlias String TypeBuiltin
89>     deriving (Show)
90
91The builtin types being:
92
93> data TypeBuiltin = UInt8
94>                  | UInt16
95>                  | UInt32
96>                  | UInt64
97>                  | UIntPtr
98>                  | Int8
99>                  | Int16
100>                  | Int32
101>                  | Int64
102>                  | IntPtr
103>                  | Size
104>                  | Char
105>                  | Bool
106>                  | String
107>                  | IRef
108>                  | Cap
109>                  | GiveAwayCap
110>                  | ErrVal
111>                    deriving (Enum, Eq)
112
113Which are shown with:
114
115> instance Show TypeBuiltin where
116>     show UInt8 = "uint8"
117>     show UInt16 = "uint16"
118>     show UInt32 = "uint32"
119>     show UInt64 = "uint64"
120>     show UIntPtr = "uintptr"
121>     show Int8 = "int8"
122>     show Int16 = "int16"
123>     show Int32 = "int32"
124>     show Int64 = "int64"
125>     show IntPtr = "intptr"
126>     show Size = "size"
127>     show Bool = "bool"
128>     show String = "String"
129>     show Char = "char"
130>     show IRef = "iref"
131>     show Cap = "cap"
132>     show GiveAwayCap = "give_away_cap"
133>     show ErrVal = "errval"
134
135> instance Read TypeBuiltin where
136>     readsPrec _ = \s -> case s of
137>                                "uint8" -> [(UInt8, "")]
138>                                "uint16" -> [(UInt16, "")]
139>                                "uint32" -> [(UInt32, "")]
140>                                "uint64" -> [(UInt64, "")]
141>                                "uintptr" -> [(UIntPtr, "")]
142>                                "int8" -> [(Int8, "")]
143>                                "int16" -> [(Int16, "")]
144>                                "int32" -> [(Int32, "")]
145>                                "int64" -> [(Int64, "")]
146>                                "intptr" -> [(IntPtr, "")]
147>                                "int" -> [(Int32, "")] -- XXX: why? -AB
148>                                "size" -> [(Size, "")]
149>                                "bool" -> [(Bool, "")]
150>                                "String" -> [(String, "")]
151>                                "char" -> [(Char, "")]
152>                                "iref" -> [(IRef, "")]
153>                                "cap" -> [(Cap, "")]
154>                                "give_away_cap" -> [(GiveAwayCap, "")]
155>                                "errval" -> [(ErrVal, "")]
156>                                _ -> error  $ "Undefined builtin type " ++ s
157
158Hence, we can define:
159
160> isBuiltin :: TypeRef -> Bool
161> isBuiltin (Builtin _) = True
162> isBuiltin _ = False
163
164And the usual combinators:
165
166> uint8, uint16, uint32, uint64, uintptr :: TypeRef
167> uint8 = Builtin UInt8
168> uint16 = Builtin UInt16
169> uint32 = Builtin UInt32
170> uint64 = Builtin UInt64
171> uintptr = Builtin UIntPtr
172
173> int8, int16, int32, int64, intptr :: TypeRef
174> int8 = Builtin Int8
175> int16 = Builtin Int16
176> int32 = Builtin Int32
177> int64 = Builtin Int64
178> intptr = Builtin IntPtr
179
180> size, string, iref, cap, give_away_cap :: TypeRef
181> size = Builtin Size
182> string = Builtin String
183> iref = Builtin IRef
184> cap = Builtin Cap
185> give_away_cap = Builtin GiveAwayCap
186
187> var :: String -> TypeRef
188> var typeRef = TypeVar typeRef
189
190> als :: String -> TypeBuiltin -> TypeRef
191> als typeRef origin = TypeAlias typeRef origin
192
193Then, we can build a type definition out of these special cases with:
194
195> typedef :: TypeDef -> Declaration
196> typedef typeDefinition = Typedef typeDefinition
197
198
199
200Here's a utility function to resolve a named type (which may be an alias) to
201its canonical definition:
202
203> lookup_type_name :: [TypeDef] -> String -> TypeDef
204> lookup_type_name types name = case def of
205>         -- FIXME: these types seem a bit confusing -AB
206>         -- why are there so many ways to specify an alias of a builtin?
207>         (TAlias _ (Builtin b)) -> TAliasT name b
208>         (TAlias _ (TypeVar v)) -> lookup_type_name types v
209>         (TAlias _ (TypeAlias _ b)) -> TAliasT name b
210>         d -> d
211>     where
212>         -- I'm assuming there must be exactly one definition for the type name
213>         def
214>             | null defs = error $ "lookup_type_name: " ++ name ++ " not defined"
215>             | null $ tail defs = head defs
216>             | otherwise = error $ "lookup_type_name: " ++ name ++ " multiply defined"
217>         defs = [t | t <- types, typedef_name t == name]
218>
219>         typedef_name :: TypeDef -> String
220>         typedef_name (TStruct n _) = n
221>         typedef_name (TArray _ n _) = n
222>         typedef_name (TEnum n _) = n
223>         typedef_name (TAlias n _) = n
224>         typedef_name (TAliasT n _) = n
225
226As above, but for a TypeRef:
227
228> lookup_typeref :: [TypeDef] -> TypeRef -> TypeDef
229> lookup_typeref _ (Builtin b) = TAliasT (show b) b
230> lookup_typeref _ (TypeAlias n b) = TAliasT n b
231> lookup_typeref types (TypeVar v) = lookup_type_name types v
232
233
234
235\paragraph{Structure}
236
237So, a @struct@ is identified by its @name@, which, as in C, comes
238after a list of @fields@.
239
240> struct :: [StructField] -> String -> TypeDef
241> struct fields name = TStruct name fields
242
243The fields of a structure consist of a type @typeField@ associated
244with a field @name@.
245
246> data StructField = TStructField TypeRef String
247>
248> field, (.@@.) :: TypeRef -> String -> StructField
249> field typeField name = TStructField typeField name
250> (.@@.) = field
251
252\paragraph{Array}
253
254An array is identified by a @name@ and defined by the type of its
255elements, @typeElts@, as well as its length.
256
257> array :: TypeRef -> String -> Integer -> TypeDef
258> array typeElts name length = TArray typeElts name length
259
260\paragraph{Enumeration}
261
262An enumeration is, as always, identified by a @name@. The content of
263an enumeration is a list of tags, the @elements@.
264
265> enum :: [String] -> String -> TypeDef
266> enum elements name = TEnum name elements
267
268\paragraph{Aliasing}
269
270Finally, we can do type aliasing: we can give a @newName@ to a type,
271which was previously known as @originalName@. Note that the names are
272switched between the combinator and the data-type.
273
274> alias :: TypeRef -> String -> TypeDef
275> alias originalName newName = TAlias newName originalName
276
277
278
279\subsubsection{Declaring a Message}
280
281
282A @message@ is identified by a @name@ and is either a @Call@, a
283@Response@, or it is a @Message@, in all generality. A message can
284carry some arguments, which are described by a list of
285@MessageArgument@, in @msgArgs@. Hence the following definition:
286
287> data MessageDef = Message MessageType String [ MessageArgument ] [(String, [(String, MetaArgument)])]
288>                 | RPC String [ RPCArgument ] [(String, [(String, MetaArgument)])]
289>
290> data MessageType = MMessage
291>                  | MCall
292>                  | MResponse
293>
294> message, call, response :: String -> [ MessageArgument ] -> Declaration
295> message name args = Messagedef $ Message MMessage name args []
296> call name args = Messagedef $ Message MCall name args []
297> response name args = Messagedef $ Message MResponse name args []
298
299As for the arguments passed to a message, they are simply the type @typeArg@ and
300the @identifier@ of the argument:
301
302> data MessageArgument = Arg TypeRef Variable
303>     deriving (Show)
304>
305> data Variable = Name String
306>               | StringArray String Integer
307>               | DynamicArray String String Integer
308>               | Token
309>     deriving (Show)
310>
311> arg, (.@.) :: TypeRef -> String -> MessageArgument
312> arg typeArg identifier = Arg typeArg (Name identifier)
313> (.@.) = arg
314>
315> argString, (.%.) :: TypeRef -> (String, Integer) -> MessageArgument
316> argString typeArg (identifier, maxlen) = Arg typeArg (StringArray identifier maxlen)
317> (.%.) = argString
318>
319> argDynamic, (.#.) :: TypeRef -> (String, String, Integer) -> MessageArgument
320> argDynamic typeArg (identifier, length, maxlen) = Arg typeArg (DynamicArray identifier length maxlen)
321> (.#.) = argDynamic
322
323And we are done for message definitions.
324
325Concerning RPC, the RPC arguments take into account whether a
326parameter is used \emph{in} or \emph{out}.
327
328> data RPCArgument = RPCArgIn TypeRef Variable
329>                  | RPCArgOut TypeRef Variable
330
331The meta-parameters allow passing additional information to individual
332backends. The paramaters are a mapping from names to either an identifier,
333which should match a message argument, or a value:
334
335> data MetaArgument = BackendInt Integer
336>                   | BackendMsgArg String
337