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