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