3751382d53d4f138d487e234f50a881eba443559
[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 Text.Parsec
20 import qualified Text.Parsec.Token as P
21 import Text.Parsec.Language (javaStyle)
22
23 import qualified SockeyeASTParser as AST
24
25 {- Parser main function -}
26 parseSockeye :: String -> String -> Either ParseError AST.SockeyeSpec
27 parseSockeye = parse sockeyeFile
28
29 {- Sockeye parsing -}
30 sockeyeFile = do
31     whiteSpace
32     spec <- sockeyeSpec
33     eof
34     return spec
35
36 sockeyeSpec = do
37     imports <- many imports
38     modules <- many sockeyeModule
39     net <- many netSpecs
40     return AST.SockeyeSpec
41         { AST.imports = imports
42         , AST.modules = modules
43         , AST.net     = concat net
44         }
45
46 imports = do
47     reserved "import"
48     path <- try importPath <?> "import path"
49     return $ AST.Import path
50
51
52 sockeyeModule = do
53     reserved "module"
54     name <- moduleName
55     params <- option [] $ parens (commaSep moduleParam)
56     body <- braces moduleBody
57     return AST.Module
58         { AST.name       = name
59         , AST.parameters = params
60         , AST.moduleBody = body
61         }
62
63 moduleParam = do
64     paramType <- choice [intType, addrType] <?> "parameter type"
65     paramName <- parameterName
66     return AST.ModuleParam
67         { AST.paramName = paramName
68         , AST.paramType = paramType 
69         }
70     where
71         intType = do
72             symbol "nat"
73             return AST.NaturalParam
74         addrType = do
75             symbol "addr" 
76             return AST.AddressParam
77
78 moduleBody = do
79     ports <- many portDefs
80     net <- many netSpecs
81     return AST.ModuleBody
82         { AST.ports     = concat ports
83         , AST.moduleNet = concat net
84         }
85
86 portDefs = choice [inputPorts, outputPorts]
87     where
88         inputPorts = do
89             reserved "input"
90             commaSep1 inDef
91         inDef = do
92             (forFn, portId) <- identifierFor
93             symbol "/"
94             portWidth <- decimal <?> "number of bits"
95             let
96                 portDef = AST.InputPortDef portId portWidth
97             case forFn of
98                 Nothing -> return portDef
99                 Just f  -> return $ AST.MultiPortDef (f portDef)
100         outputPorts = do
101             reserved "output"
102             commaSep1 outDef
103         outDef = do
104             (forFn, portId) <- identifierFor
105             symbol "/"
106             portWidth <- decimal <?> "number of bits"
107             let
108                 portDef = AST.OutputPortDef portId portWidth
109             case forFn of
110                 Nothing -> return portDef
111                 Just f  -> return $ AST.MultiPortDef (f portDef)
112
113 netSpecs = choice [ inst <?> "module instantiation"
114                  , decl <?> "node declaration"
115                  ]
116     where
117         inst = do
118             moduleInst <- moduleInst
119             return $ [AST.ModuleInstSpec moduleInst]
120         decl = do
121             nodeDecls <- nodeDecls
122             return $ [AST.NodeDeclSpec decl | decl <- nodeDecls]
123
124 moduleInst = do
125     (name, args) <- try $ do
126         name <- moduleName
127         args <- option [] $ parens (commaSep moduleArg)
128         symbol "as"
129         return (name, args)
130     (forFn, namespace) <- identifierFor
131     portMappings <- option [] $ symbol "with" *> many1 portMapping
132     return $ let
133         moduleInst = AST.ModuleInst
134             { AST.moduleName = name
135             , AST.namespace  = namespace
136             , AST.arguments  = args 
137             , AST.portMappings = portMappings
138             }
139         in case forFn of
140             Nothing -> moduleInst
141             Just f  -> AST.MultiModuleInst $ f moduleInst
142
143 moduleArg = choice [addressArg, numberArg, paramArg]
144     where
145         addressArg = do
146             addr <- addressLiteral
147             return $ AST.AddressArg addr
148         numberArg = do
149             num <- numberLiteral
150             return $ AST.NaturalArg num
151         paramArg = do
152             name <- parameterName
153             return $ AST.ParamArg name
154
155 portMapping = choice [inputMapping, outputMapping]
156     where
157         inputMapping = do
158             (forFn, mappedId) <- try $ identifierFor <* symbol ">"
159             portId <- identifier
160             return $ let
161                 portMap = AST.InputPortMap
162                     { AST.mappedId   = mappedId
163                     , AST.mappedPort = portId
164                     }
165                 in case forFn of
166                     Nothing -> portMap
167                     Just f  -> AST.MultiPortMap $ f portMap
168         outputMapping = do
169             (forFn, mappedId) <- try $ identifierFor <* symbol "<"
170             portId <- identifier
171             return $ let
172                 portMap = AST.OutputPortMap
173                     { AST.mappedId   = mappedId
174                     , AST.mappedPort = portId
175                     }
176                 in case forFn of
177                     Nothing -> portMap
178                     Just f  -> AST.MultiPortMap $ f portMap
179
180 nodeDecls = do
181     nodeIds <- choice [try single, try multiple]
182     nodeSpec <- nodeSpec
183     return $ map (toNodeDecl nodeSpec) nodeIds
184     where
185         single = do
186             nodeId <- identifier
187             reserved "is"
188             return [(Nothing, nodeId)]
189         multiple = do
190             nodeIds <- commaSep1 identifierFor
191             reserved "are"
192             return nodeIds
193         toNodeDecl nodeSpec (forFn, ident) = let
194             nodeDecl = AST.NodeDecl
195                 { AST.nodeId = ident
196                 , AST.nodeSpec = nodeSpec
197                 }
198             in case forFn of
199                 Nothing -> nodeDecl
200                 Just f  -> AST.MultiNodeDecl $ f nodeDecl
201
202 identifier = do
203     (_, ident) <- identifierHelper False
204     return ident
205
206 nodeSpec = do
207     nodeType <- optionMaybe $ try nodeType
208     accept <- option [] accept 
209     translate <- option [] tranlsate
210     reserve <- option [] reserve
211     overlay <- optionMaybe overlay
212     return AST.NodeSpec 
213         { AST.nodeType  = nodeType
214         , AST.accept    = accept
215         , AST.translate = translate
216         , AST.reserved  = reserve
217         , AST.overlay   = overlay
218         }
219     where
220         accept = do
221             try $ reserved "accept"
222             brackets $ many blockSpec
223         tranlsate = do
224             try $ reserved "map"
225             specs <- brackets $ many mapSpecs
226             return $ concat specs
227         reserve = do
228             try $ reserved "reserved"
229             brackets $ many blockSpec
230
231 nodeType = choice [memory, device]
232     where memory = do
233             symbol "memory"
234             return AST.Memory
235           device = do
236             symbol "device"
237             return AST.Device
238
239 blockSpec = choice [range, length, singleton]
240     where
241         singleton = do
242             address <- address
243             return $ AST.SingletonBlock address
244         range = do
245             base <- try $ address <* symbol "-"
246             limit <- address
247             return $ AST.RangeBlock base limit
248         length = do
249             base <- try $ address <* symbol "/"
250             bits <- decimal <?> "number of bits"
251             return $ AST.LengthBlock base bits
252
253 address = choice [address, param]
254     where
255         address = do
256             addr <- addressLiteral
257             return $ AST.LiteralAddress addr
258         param = do
259             name <- parameterName
260             return $ AST.ParamAddress name
261
262 mapSpecs = do
263     block <- blockSpec
264     reserved "to"
265     dests <- commaSep1 $ mapDest
266     return $ map (toMapSpec block) dests
267     where
268         mapDest = do
269             destNode <- identifier
270             destBase <- optionMaybe $ reserved "at" *> address
271             return (destNode, destBase)
272         toMapSpec block (destNode, destBase) = AST.MapSpec
273             { AST.block    = block
274             , AST.destNode = destNode
275             , AST.destBase = destBase
276             }
277
278 overlay = do
279     reserved "over"
280     over <- identifier
281     symbol "/"
282     width <- decimal <?> "number of bits"
283     return AST.OverlaySpec
284         { AST.over  = over
285         , AST.width = width
286         }
287
288 identifierFor = identifierHelper True
289
290 forVarRange optVarName
291     | optVarName = do 
292         var <- option "#" (try $ variableName <* reserved "in")
293         range var
294     | otherwise = do
295         var <- variableName
296         reserved "in"
297         range var
298     where
299         range var = brackets (do
300             start <- index
301             symbol ".."
302             end <- index
303             return AST.ForVarRange
304                 { AST.var   = var
305                 , AST.start = start
306                 , AST.end   = end
307                 }
308             )
309             <?> "range ([a..b])"
310         index = choice [numberIndex, paramIndex]
311         numberIndex = do
312             num <- numberLiteral
313             return $ AST.LiteralLimit num
314         paramIndex = do
315             name <- parameterName
316             return $ AST.ParamLimit name
317
318 {- Helper functions -}
319 lexer = P.makeTokenParser (
320     javaStyle  {
321         {- list of reserved Names -}
322         P.reservedNames = keywords,
323
324         {- valid identifiers -}
325         P.identStart = letter,
326         P.identLetter = identLetter,
327
328         {- comment start and end -}
329         P.commentStart = "/*",
330         P.commentEnd = "*/",
331         P.commentLine = "//",
332         P.nestedComments = False
333     })
334
335 whiteSpace    = P.whiteSpace lexer
336 reserved      = P.reserved lexer
337 parens        = P.parens lexer
338 brackets      = P.brackets lexer
339 braces        = P.braces lexer
340 symbol        = P.symbol lexer
341 commaSep      = P.commaSep lexer
342 commaSep1     = P.commaSep1 lexer
343 identString    = P.identifier lexer
344 hexadecimal   = symbol "0" *> P.hexadecimal lexer <* whiteSpace
345 decimal       = P.decimal lexer <* whiteSpace
346
347 keywords = ["import", "module",
348             "input", "output",
349             "in",
350             "as", "with",
351             "is", "are",
352             "accept", "map",
353             "reserved", "over",
354             "to", "at"]   
355
356 identStart     = letter
357 identLetter    = alphaNum <|> char '_' <|> char '-'
358
359 importPath     = many (identLetter <|> char '/') <* whiteSpace
360 moduleName     = identString <?> "module name"
361 parameterName  = identString <?> "parameter name"
362 variableName   = identString <?> "variable name"
363 identifierName = try ident <?> "identifier"
364     where
365         ident = do
366             start <- identStart
367             rest <- many identLetter
368             let ident = start:rest
369             if ident `elem` keywords
370                 then unexpected $ "reserved word \"" ++ ident ++ "\""
371                 else return ident
372
373 numberLiteral  = try decimal <?> "number literal"
374 addressLiteral = try hexadecimal <?> "address literal (hex)"
375
376 identifierHelper inlineFor = do
377     (varRanges, Just ident) <- choice [template identifierName, simple identifierName] <* whiteSpace
378     let
379         forFn = case varRanges of
380          [] -> Nothing
381          _  -> Just $ \body -> AST.For
382                 { AST.varRanges = varRanges
383                 , AST.body      = body
384                 }
385     return (forFn, ident)
386     where
387         simple ident = do
388             name <- ident
389             return $ ([], Just $ AST.SimpleIdent name)
390         template ident = do
391             prefix <- try $ ident <* symbol "{"
392             (ranges, varName, suffix) <- if inlineFor 
393                 then choice [forTemplate, varTemplate]
394                 else varTemplate
395             let
396                 ident = Just AST.TemplateIdent
397                     { AST.prefix = prefix
398                     , AST.varName = varName
399                     , AST.suffix = suffix
400                     }
401             return (ranges, ident)
402         varTemplate = do
403             varName <- variableName
404             char '}'
405             (ranges, suffix) <- templateSuffix
406             return (ranges, varName, suffix)
407         forTemplate = do
408             optVarRange <- forVarRange True
409             char '}'
410             (subRanges, suffix) <- templateSuffix
411             return $ let
412                 varName = mapOptVarName subRanges (AST.var optVarRange)
413                 varRange = optVarRange { AST.var = varName }
414                 ranges = varRange:subRanges
415                 in (ranges, varName, suffix)
416         templateSuffix = option ([], Nothing) $ choice
417             [ template $ many identLetter
418             , simple $ many1 identLetter
419             ]
420         mapOptVarName prev "#" = "#" ++ (show $ (length prev) + 1)
421         mapOptVarName _ name = name