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{General Functions for Back-ends}
16
17
18In this module, we define some general functions. These functions are
19used in both Code and Header back-ends. They are quite simple, so we
20can afford to present them out of their context.
21
22
23> module Backend where
24
25%if false
26
27> import Data.List
28
29> import Syntax
30
31%endif
32
33
34\subsection{The Preamble}
35
36In both cases, we will have to emit a long, tedious copyright
37notice. So, here it is done once and for all.
38
39> preamble :: Interface -> String -> String
40> preamble interface filename =
41>     let name =
42>             case interface of
43>                    Interface _ (Just desc) _ -> desc
44>                    _ -> ""
45>     in
46>     {-" \mbox{and so on\ldots} "-}
47
48%if false
49
50>     "/*\n * Interface Definition: " ++ name ++ "\n\
51>     \ * Generated from: " ++ filename ++ "\n\
52>     \ * \n\
53>     \ * Copyright (c) 2009, ETH Zurich.\n\
54>     \ * All rights reserved.\n\
55>     \ * \n\
56>     \ * This file is distributed under the terms in the attached LICENSE\n\
57>     \ * file. If you do not find this file, copies can be found by\n\
58>     \ * writing to:\n\
59>     \ * ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich.\n\
60>     \ *  Attn: Systems Group.\n\
61>     \ * \n\
62>     \ * THIS FILE IS AUTOMATICALLY GENERATED: DO NOT EDIT!\n\
63>     \ */\n\n"
64
65%endif
66
67
68\subsection{Dealing with Namespace Issues}
69
70
71In order to avoid name clashes, we qualify type names with the
72interface name, excepted when it is a built-in type.
73
74> qualifyName :: String -> TypeRef -> String
75> qualifyName interfaceName (Builtin t) = show t
76> qualifyName interfaceName (TypeVar t) = interfaceName ++ "_" ++ t
77> qualifyName interfaceName (TypeAlias t _) = interfaceName ++ "_" ++ t
78
79When we are declarating real C types, we have to add a @_t@ at the
80end.
81
82> qualifyType :: String -> TypeRef -> String
83> qualifyType qualifier (Builtin String) = "char *"
84> qualifyType qualifier (TypeAlias name _) = name ++ "_t"
85> qualifyType qualifier typeDef =
86>     qualifyName qualifier typeDef ++ "_t"
87
88When we are generating stubs, we will need to qualify exported procedures:
89@qualifyProcName@ corresponds to the interface namespace, along with a
90@_fn@ specifier.
91
92> qualifyProcName :: String -> TypeRef -> String
93> qualifyProcName interfaceName typeDef =
94>     qualifyName interfaceName typeDef ++ "_fn"
95
96
97\subsection{Dealing with Declarations}
98
99
100Often (always), we treat types and messages separately. Hence,
101@partitionTypesMessages@ takes a list of declarations and partitions
102it into two lists: one containing the type declarations, the other
103containing the message declarations.
104
105> partitionTypesMessages :: [Declaration] -> ([TypeDef], [MessageDef])
106> partitionTypesMessages declarations =
107>     let (types, messages) = foldl' typeFilter ([],[]) declarations in
108>         (types, reverse messages)
109>         where typeFilter (types, messages) (Messagedef m) = (types, m : messages)
110>               typeFilter (types, messages) (Typedef t) = (t : types, messages)
111
112
113\subsection{Dealing with Messages}
114
115
116Messages can either go Forward or Backward:
117
118> data MessageClass = Forward
119>                   | Backward
120
121This defines the following relation:
122
123> isForward, isBackward :: MessageDef -> Bool
124> isForward (Message MResponse _ _ _) = False
125> isForward _ = True
126> isBackward (Message MCall _ _ _) = False
127> isBackward _ = True
128
129The distinction between \emph{service} and \emph{client} handler
130stands in the type of the closure response: one is typed for the
131\emph{service} closure, the other for the \emph{client} closure. This
132difference is materialized by the following data-type:
133
134> data Side = ServerSide
135>           | ClientSide
136
137> instance Show Side where
138>     show ServerSide = "service"
139>     show ClientSide = "client"
140
141
142To compile the list of arguments of messages, we use:
143
144> compileCommonDefinitionArgs :: String -> Side -> MessageDef -> [(String,String)]
145> compileCommonDefinitionArgs interfaceName side message@(Message _ _ messageArgs _) =
146>     [("struct " ++ interfaceName ++ "_" ++ show side ++ "_response *", "st")]
147>  ++ [(constType typeArg ++ " " ++ qualifyType interfaceName typeArg, nameOf arg)
148>      | Arg typeArg arg <- messageArgs ]
149
150> compileRPCDefinitionArgs :: String -> [RPCArgument] -> [(String,String)]
151> compileRPCDefinitionArgs interfaceName rpcArgs =
152>     ("struct " ++ interfaceName ++ "_client_response *", "st" ) :
153>     [ case messageArg of
154>       RPCArgIn typeArg arg ->
155>           (constType typeArg ++ " "
156>            ++ qualifyType interfaceName typeArg,
157>            nameOf arg)
158>       RPCArgOut typeArg arg ->
159>           (qualifyType interfaceName typeArg ++ "*",
160>            nameOf arg)
161>       | messageArg <- rpcArgs ]
162
163Where \verb!const! adds a const type modifier for pointers that should
164not be modified.
165
166> constType :: TypeRef -> String
167> constType (Builtin String) = "const"
168> constType _ = ""
169
170
171
172\subsection{Dealing with Dynamic Arrays}
173
174
175When we manipulate dynamic arrays, we might just need the name of the
176array, without its associated length bound.
177
178> nameOf :: Variable -> String
179> nameOf (Name s) = s
180> nameOf (DynamicArray s _ _) = s
181
182
183Conversely, when marshaling or unmarshaling dynamic arrays, we need to
184pass the @length@ parameter.
185
186> listOfArgs :: String -> Variable -> String
187> listOfArgs dereference (Name s) = dereference ++ s
188> listOfArgs dereference (DynamicArray name length _) = dereference ++ name ++ ", " ++ length
189
190
191> callNameOf :: MessageDef -> String
192> callNameOf (Message _ messageName _ _) = messageName
193> callNameOf (RPC name _ _) = name
194