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