Sockeye: Allow to instantiate modules with inlined range in name space
[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 {- 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 netSpec
43     return AST.SockeyeSpec
44         { AST.modules = modules
45         , AST.net     = 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 "int"
69             return AST.NumberParam
70         addrType = do
71             symbol "addr" 
72             return AST.AddressParam
73
74 moduleBody = do
75     ports <- many $ portDef
76     net <- many netSpec
77     return AST.ModuleBody
78         { AST.ports     = concat ports
79         , AST.moduleNet = 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 netSpec = choice [ inst <?> "module instantiation"
106                  , decl <?> "node declaration"
107                  , multiSpecs
108                  ]
109     where
110         inst = do
111             moduleInst <- moduleInst
112             return $ AST.ModuleInstSpec moduleInst
113         decl = do
114             nodeDecls <- nodeDecls
115             return $ AST.NodeDeclSpec nodeDecls
116         multiSpecs = do
117             for <- for $ many1 netSpec
118             return $ AST.MultiNetSpec for
119
120 moduleInst = do
121     (name, args) <- try $ do
122         name <- moduleName
123         args <- option [] $ parens (commaSep moduleArg)
124         symbol "as"
125         return (name, args)
126     (forFn, nameSpace) <- identifierFor
127     portMappings <- option [] $ symbol "with" *> many1 portMapping
128     return $ let
129         moduleInst = AST.ModuleInst
130             { AST.moduleName = name
131             , AST.nameSpace  = nameSpace
132             , AST.arguments  = args 
133             , AST.portMappings = portMappings
134             }
135         in case forFn of
136             Nothing -> moduleInst
137             Just f  -> AST.MultiModuleInst $ f moduleInst
138
139 moduleArg = choice [addressArg, numberArg, paramArg]
140     where
141         addressArg = do
142             addr <- addressLiteral
143             return $ AST.AddressArg (fromIntegral addr)
144         numberArg = do
145             num <- numberLiteral
146             return $ AST.NumberArg (fromIntegral num)
147         paramArg = do
148             name <- parameterName
149             return $ AST.ParamArg name
150
151 portMapping = choice [inputMapping, outputMapping]
152     where
153         inputMapping = do
154             (forFn, mappedId) <- try $ identifierFor <* symbol ">"
155             portId <- identifier
156             return $ let
157                 portMap = AST.InputPortMap
158                     { AST.mappedId = mappedId
159                     , AST.portId   = portId
160                     }
161                 in case forFn of
162                     Nothing -> portMap
163                     Just f  -> AST.MultiPortMap $ f portMap
164         outputMapping = do
165             (forFn, mappedId) <- try $ identifierFor <* symbol "<"
166             portId <- identifier
167             return $ let
168                 portMap = AST.OutputPortMap
169                     { AST.portId   = portId
170                     , AST.mappedId = mappedId
171                     }
172                 in case forFn of
173                     Nothing -> portMap
174                     Just f  -> AST.MultiPortMap $ f portMap
175
176 nodeDecls = do
177     nodeIds <- choice [try single, try multiple]
178     nodeSpec <- nodeSpec
179     return $ map (toNodeDecl nodeSpec) nodeIds
180     where
181         single = do
182             nodeId <- identifier
183             reserved "is"
184             return [(Nothing, nodeId)]
185         multiple = do
186             nodeIds <- commaSep1 identifierFor
187             reserved "are"
188             return nodeIds
189         toNodeDecl nodeSpec (forFn, ident) = let
190             nodeDecl = AST.NodeDecl
191                 { AST.nodeId = ident
192                 , AST.nodeSpec = nodeSpec
193                 }
194             in case forFn of
195                 Nothing -> nodeDecl
196                 Just f  -> AST.MultiNodeDecl $ f nodeDecl
197
198 identifier = do
199     (_, ident) <- identifierHelper False
200     return ident
201
202 nodeSpec = do
203     nodeType <- optionMaybe $ try nodeType
204     accept <- option [] accept 
205     translate <- option [] tranlsate 
206     overlay <- optionMaybe overlay
207     return AST.NodeSpec 
208         { AST.nodeType  = nodeType
209         , AST.accept    = accept
210         , AST.translate = translate
211         , AST.overlay   = overlay
212         }
213     where
214         accept = do
215             reserved "accept"
216             brackets $ many blockSpec
217         tranlsate = do
218             reserved "map"
219             brackets $ many mapSpec
220         overlay = do
221             reserved "over"
222             identifier
223
224 nodeType = choice [memory, device]
225     where memory = do
226             symbol "memory"
227             return AST.Memory
228           device = do
229             symbol "device"
230             return AST.Device
231
232 blockSpec = choice [range, length, singleton]
233     where
234         singleton = do
235             address <- address
236             return $ AST.SingletonBlock address
237         range = do
238             base <- try $ address <* symbol "-"
239             limit <- address
240             return $ AST.RangeBlock base limit
241         length = do
242             base <- try $ address <* symbol "/"
243             bits <- decimal <?> "number of bits"
244             return $ AST.LengthBlock base (fromIntegral bits)
245
246 address = choice [address, param]
247     where
248         address = do
249             addr <- addressLiteral
250             return $ AST.NumberAddress (fromIntegral addr)
251         param = do
252             name <- parameterName
253             return $ AST.ParamAddress name
254
255 mapSpec = do
256     block <- blockSpec
257     reserved "to"
258     dests <- commaSep1 $ mapDest
259     return $ AST.MapSpec block dests
260
261 mapDest = choice [baseAddress, direct]
262     where
263         direct = do
264             destNode <- identifier
265             return $ AST.DirectMap destNode
266         baseAddress = do
267             destNode <- try $ identifier <* reserved "at"
268             destBase <- address
269             return $ AST.BaseAddressMap destNode destBase
270
271 for body = do
272     reserved "for"
273     varRanges <- commaSep1 $ forVarRange False
274     body <- braces body
275     return AST.For
276         { AST.varRanges = varRanges
277         , AST.body      = body
278         }
279
280 identifierFor = identifierHelper True
281
282 forVarRange optVarName
283     | optVarName = do 
284         var <- option "#" (try $ variableName <* reserved "in")
285         range var
286     | otherwise = do
287         var <- variableName
288         reserved "in"
289         range var
290     where
291         range var = brackets (do
292             start <- index
293             symbol ".."
294             end <- index
295             return AST.ForVarRange
296                 { AST.var   = var
297                 , AST.start = start
298                 , AST.end   = end
299                 }
300             )
301             <?> "range ([a..b])"
302         index = choice [numberIndex, paramIndex]
303         numberIndex = do
304             num <- numberLiteral
305             return $ AST.NumberLimit (fromIntegral num)
306         paramIndex = do
307             name <- parameterName
308             return $ AST.ParamLimit name
309
310 {- Helper functions -}
311 lexer = P.makeTokenParser (
312     javaStyle  {
313         {- list of reserved Names -}
314         P.reservedNames = keywords,
315
316         {- valid identifiers -}
317         P.identStart = letter,
318         P.identLetter = identLetter,
319
320         {- comment start and end -}
321         P.commentStart = "/*",
322         P.commentEnd = "*/",
323         P.commentLine = "//",
324         P.nestedComments = False
325     })
326
327 whiteSpace    = P.whiteSpace lexer
328 reserved      = P.reserved lexer
329 parens        = P.parens lexer
330 brackets      = P.brackets lexer
331 braces        = P.braces lexer
332 symbol        = P.symbol lexer
333 stringLiteral = P.stringLiteral lexer
334 commaSep      = P.commaSep lexer
335 commaSep1     = P.commaSep1 lexer
336 identString    = P.identifier lexer
337 hexadecimal   = symbol "0" *> P.hexadecimal lexer <* whiteSpace
338 decimal       = P.decimal lexer <* whiteSpace
339
340 keywords = ["module",
341             "input", "output",
342             "for", "in",
343             "as", "with",
344             "is", "are",
345             "accept", "map",
346             "over",
347             "to", "at"]   
348
349 identStart     = letter
350 identLetter    = alphaNum <|> char '_' <|> char '-'
351
352 moduleName     = identString <?> "module name"
353 parameterName  = identString <?> "parameter name"
354 variableName   = identString <?> "variable name"
355 identifierName = try ident <?> "identifier"
356     where
357         ident = do
358             start <- identStart
359             rest <- many identLetter
360             let ident = start:rest
361             if ident `elem` keywords
362                 then unexpected $ "reserved word \"" ++ ident ++ "\""
363                 else return ident
364
365 numberLiteral  = try decimal <?> "number literal"
366 addressLiteral = try hexadecimal <?> "address literal (hex)"
367
368 identifierHelper inlineFor = do
369     (varRanges, Just ident) <- choice [template identifierName, simple identifierName] <* whiteSpace
370     let
371         forFn = case varRanges of
372          [] -> Nothing
373          _  -> Just $ \body -> AST.For
374                 { AST.varRanges = varRanges
375                 , AST.body      = body
376                 }
377     return (forFn, ident)
378     where
379         simple ident = do
380             name <- ident
381             return $ ([], Just $ AST.SimpleIdent name)
382         template ident = do
383             prefix <- try $ ident <* symbol "{"
384             (ranges, varName, suffix) <- if inlineFor 
385                 then choice [forTemplate, varTemplate]
386                 else varTemplate
387             let
388                 ident = Just AST.TemplateIdent
389                     { AST.prefix = prefix
390                     , AST.varName = varName
391                     , AST.suffix = suffix
392                     }
393             return (ranges, ident)
394         varTemplate = do
395             varName <- variableName
396             char '}'
397             (ranges, suffix) <- templateSuffix
398             return (ranges, varName, suffix)
399         forTemplate = do
400             optVarRange <- forVarRange True
401             char '}'
402             (subRanges, suffix) <- templateSuffix
403             return $ let
404                 varName = mapOptVarName subRanges (AST.var optVarRange)
405                 varRange = optVarRange { AST.var = varName }
406                 ranges = varRange:subRanges
407                 in (ranges, varName, suffix)
408         templateSuffix = option ([], Nothing) $ choice
409             [ template $ many identLetter
410             , simple $ many1 identLetter
411             ]
412         mapOptVarName prev "#" = "#" ++ (show $ (length prev) + 1)
413         mapOptVarName _ name = name