Sockeye: Introduce for loops
[barrelfish] / tools / sockeye / SockeyeParser.hs
1 {-
2   SockeyeParser.hs: Parser for Sockeye
3
4   Part of Sockeye
5
6   Copyright (c) 2017, ETH Zurich.
7
8   All rights reserved.
9
10   This file is distributed under the terms in the attached LICENSE file.
11   If you do not find this file, copies can be found by writing to:
12   ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
13   Attn: Systems Group.
14 -}
15
16 module SockeyeParser
17 ( parseSockeye ) where
18
19 import Control.Monad
20
21 import Data.Maybe (fromMaybe)
22
23 import Text.ParserCombinators.Parsec as Parsec
24 import qualified Text.ParserCombinators.Parsec.Token as P
25 import Text.ParserCombinators.Parsec.Language (javaStyle)
26
27 import qualified SockeyeASTFrontend as AST
28
29 {- Setup the lexer -}
30 lexer = P.makeTokenParser (
31     javaStyle  {
32         {- list of reserved Names -}
33         P.reservedNames = [
34             "module",
35             "input", "output",
36             "for", "in",
37             "as", "with",
38             "is", "are",
39             "accept", "map",
40             "over",
41             "to", "at"
42         ],
43
44         {- valid identifiers -}
45         P.identStart = identStart,
46         P.identLetter = identLetter,
47
48         {- comment start and end -}
49         P.commentStart = "/*",
50         P.commentEnd = "*/",
51         P.commentLine = "//",
52         P.nestedComments = False
53     })
54
55 {- Parser main function -}
56 parseSockeye :: String -> String -> Either ParseError AST.SockeyeSpec
57 parseSockeye = parse sockeyeFile
58
59 {- Sockeye parsing -}
60 sockeyeFile = do
61     whiteSpace
62     spec <- sockeyeSpec
63     eof
64     return spec
65
66 sockeyeSpec = do
67     modules <- many sockeyeModule
68     net <- many netSpec
69     return AST.SockeyeSpec
70         { AST.modules = modules
71         , AST.net     = net
72         }
73
74 sockeyeModule = do
75     reserved "module"
76     name <- moduleName
77     params <- option [] $ parens (commaSep moduleParam)
78     body <- braces moduleBody
79     return AST.Module
80         { AST.name       = name
81         , AST.parameters = params
82         , AST.moduleBody = body
83         }
84
85 moduleParam = do
86     paramType <- choice [intType, addrType] <?> "parameter type"
87     paramName <- parameterName
88     return AST.ModuleParam
89         { AST.paramName = paramName
90         , AST.paramType = paramType 
91         }
92     where
93         intType = do
94             symbol "int"
95             return AST.NumberParam
96         addrType = do
97             symbol "addr" 
98             return AST.AddressParam
99
100 moduleBody = do
101     ports <- many $ try portDef
102     net <- many netSpec
103     return AST.ModuleBody
104         { AST.ports     = ports
105         , AST.moduleNet = net
106         }
107
108 portDef = choice [inputPort, outputPort, multiPorts]
109     where
110         inputPort = do
111             reserved "input"
112             idens <- commaSep1 identifier
113             return $ AST.InputPortDef idens
114         outputPort = do
115             reserved "output"
116             idens <- commaSep1 identifier
117             return $ AST.OutputPortDef idens
118         multiPorts = do
119             for <- for $ many1 portDef
120             return $ AST.MultiPortDef for
121
122 netSpec = choice [ inst <?> "module instantiation"
123                  , decl <?> "node declaration"
124                  , multiSpecs
125                  ]
126     where
127         inst = do
128             moduleInst <- moduleInst
129             return $ AST.ModuleInstSpec moduleInst
130         decl = do
131             nodeDecl <- nodeDecl
132             return $ AST.NodeDeclSpec nodeDecl
133         multiSpecs = do
134             for <- for $ many1 netSpec
135             return $ AST.MultiNetSpec for
136
137 moduleInst = do
138     (name, args) <- try $ do
139         name <- moduleName
140         args <- option [] $ parens (commaSep moduleArg)
141         symbol "as"
142         return (name, args)
143     nameSpace <- identifier
144     portMappings <- option [] $ symbol "with" *> many1 portMapping
145     return AST.ModuleInst
146         { AST.moduleName = name
147         , AST.nameSpace  = nameSpace
148         , AST.arguments  = args 
149         , AST.portMappings = portMappings
150         }
151
152 moduleArg = choice [addressArg, numberArg, paramArg]
153     where
154         addressArg = do
155             addr <- addressLiteral
156             return $ AST.AddressArg (fromIntegral addr)
157         numberArg = do
158             num <- numberLiteral
159             return $ AST.NumberArg (fromIntegral num)
160         paramArg = do
161             name <- parameterName
162             return $ AST.ParamArg name
163
164 portMapping = choice [inputMapping, outputMapping, multiMapping]
165     where
166         inputMapping = do
167             nodeId <- try $ identifier <* symbol ">"
168             port <- identifier
169             return AST.InputPortMap
170                 { AST.port   = port
171                 , AST.nodeId = nodeId
172                 }
173         outputMapping = do
174             nodeId <- try $ identifier <* symbol "<"
175             port <- identifier
176             return AST.OutputPortMap
177                 { AST.port   = port
178                 , AST.nodeId = nodeId
179                 }
180         multiMapping = do
181             for <- for $ many1 portMapping
182             return $ AST.MultiPortMap for
183
184 nodeDecl = do
185     nodeIds <- choice [try single, try multiple]
186     nodeSpec <- nodeSpec
187     return $ AST.NodeDecl
188         { AST.nodeIds = nodeIds
189         , AST.nodeSpec = nodeSpec
190         }
191     where single = do
192             nodeId <- identifier
193             reserved "is"
194             return [nodeId]
195           multiple = do
196             nodeIds <- commaSep1 identifier
197             reserved "are"
198             return nodeIds
199
200 identifier = choice [template identifierName, simple identifierName] <* whiteSpace
201     where
202         simple ident = do
203             name <- ident
204             return $ AST.SimpleIdent name
205         template ident = do
206             prefix <- try $ ident <* char '#'
207             varName <- char '{' *> variableName <* char '}'
208             suffix <- optionMaybe $ choice [ template $ many identLetter
209                                            , simple $ many1 identLetter
210                                            ]
211             return AST.TemplateIdent
212                 { AST.prefix  = prefix
213                 , AST.varName = varName
214                 , AST.suffix   = suffix
215                 }
216
217 nodeSpec = do
218     nodeType <- optionMaybe $ try nodeType
219     accept <- option [] accept 
220     translate <- option [] tranlsate 
221     overlay <- optionMaybe overlay
222     return AST.NodeSpec 
223         { AST.nodeType  = nodeType
224         , AST.accept    = accept
225         , AST.translate = translate
226         , AST.overlay   = overlay
227         }
228     where
229         accept = do
230             reserved "accept"
231             brackets $ many blockSpec
232         tranlsate = do
233             reserved "map"
234             brackets $ many mapSpec
235         overlay = do
236             reserved "over"
237             identifier
238
239 nodeType = choice [memory, device]
240     where memory = do
241             symbol "memory"
242             return AST.Memory
243           device = do
244             symbol "device"
245             return AST.Device
246
247 blockSpec = choice [range, length, singleton]
248     where
249         singleton = do
250             address <- address
251             return $ AST.Singleton address
252         range = do
253             base <- try $ address <* symbol "-"
254             limit <- address
255             return $ AST.Range base limit
256         length = do
257             base <- try $ address <* symbol "/"
258             bits <- decimal <?> "number of bits"
259             return $ AST.Length base (fromIntegral bits)
260
261 address = choice [address, param]
262     where
263         address = do
264             addr <- addressLiteral
265             return $ AST.NumberAddress (fromIntegral addr)
266         param = do
267             name <- parameterName
268             return $ AST.ParamAddress name
269
270 mapSpec = do
271     block <- blockSpec
272     reserved "to"
273     dests <- commaSep1 $ mapDest
274     return $ AST.MapSpec block dests
275
276 mapDest = choice [baseAddress, direct]
277     where
278         direct = do
279             destNode <- identifier
280             return $ AST.Direct destNode
281         baseAddress = do
282             destNode <- try $ identifier <* reserved "at"
283             destBase <- address
284             return $ AST.BaseAddress destNode destBase
285
286 for body = do
287     reserved "for"
288     var <- variableName
289     reserved "in"
290     (start, end) <- brackets forRange
291     body <- braces body
292     return AST.For
293         { AST.var   = var
294         , AST.start = start
295         , AST.end   = end
296         , AST.body  = body
297         }
298         
299 forRange = do
300     start <- index
301     symbol ".."
302     end <- index
303     return (start, end)
304     where
305         index = choice [numberIndex, paramIndex]
306         numberIndex = do
307             num <- numberLiteral
308             return $ AST.NumberLimit (fromIntegral num)
309         paramIndex = do
310             name <- parameterName
311             return $ AST.ParamLimit name
312
313 {- Helper functions -}
314 whiteSpace    = P.whiteSpace lexer
315 reserved      = P.reserved lexer
316 parens        = P.parens lexer
317 brackets      = P.brackets lexer
318 braces        = P.braces lexer
319 symbol        = P.symbol lexer
320 stringLiteral = P.stringLiteral lexer
321 commaSep      = P.commaSep lexer
322 commaSep1     = P.commaSep1 lexer
323 idenString    = P.identifier lexer
324 hexadecimal   = symbol "0" *> P.hexadecimal lexer <* whiteSpace
325 decimal       = P.decimal lexer <* whiteSpace
326
327 moduleName     = idenString <?> "module name"
328 parameterName  = idenString <?> "parameter name"
329 variableName   = idenString <?> "variable name"
330
331 identStart      = letter
332 identLetter     = alphaNum <|> char '_' <|> char '-'
333 identifierName = do
334     start <- identStart
335     rest <- many identLetter
336     return $ start:rest
337     <?> "identifier"
338
339 numberLiteral  = try decimal <?> "number literal"
340 addressLiteral = try hexadecimal <?> "address literal (hex)"