Sockeye: Implement import support
[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     imports <- many imports
42     modules <- many sockeyeModule
43     net <- many netSpecs
44     return AST.SockeyeSpec
45         { AST.imports = imports
46         , AST.modules = modules
47         , AST.net     = concat net
48         }
49
50 imports = do
51     reserved "import"
52     path <- try importPath <?> "import path"
53     return $ AST.Import path
54
55
56 sockeyeModule = do
57     reserved "module"
58     name <- moduleName
59     params <- option [] $ parens (commaSep moduleParam)
60     body <- braces moduleBody
61     return AST.Module
62         { AST.name       = name
63         , AST.parameters = params
64         , AST.moduleBody = body
65         }
66
67 moduleParam = do
68     paramType <- choice [intType, addrType] <?> "parameter type"
69     paramName <- parameterName
70     return AST.ModuleParam
71         { AST.paramName = paramName
72         , AST.paramType = paramType 
73         }
74     where
75         intType = do
76             symbol "nat"
77             return AST.NaturalParam
78         addrType = do
79             symbol "addr" 
80             return AST.AddressParam
81
82 moduleBody = do
83     ports <- many $ portDef
84     net <- many netSpecs
85     return AST.ModuleBody
86         { AST.ports     = concat ports
87         , AST.moduleNet = concat net
88         }
89
90 portDef = choice [inputPorts, outputPorts]
91     where
92         inputPorts = do
93             reserved "input"
94             ports <- commaSep1 identifierFor
95             return $ map toInDef ports
96         toInDef (forFn, iden) =
97             let
98                 portDef = AST.InputPortDef iden
99             in case forFn of
100                 Nothing -> portDef
101                 Just f  -> AST.MultiPortDef $ f portDef
102         outputPorts = do
103             reserved "output"
104             ports <- commaSep1 identifierFor
105             return $ map toOutDef ports
106         toOutDef (forFn, iden) =
107             let
108                 portDef = AST.OutputPortDef iden
109             in case forFn of
110             Nothing -> portDef
111             Just f  -> 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 (fromIntegral addr)
148         numberArg = do
149             num <- numberLiteral
150             return $ AST.NaturalArg (fromIntegral 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     overlay <- optionMaybe overlay
211     return AST.NodeSpec 
212         { AST.nodeType  = nodeType
213         , AST.accept    = accept
214         , AST.translate = translate
215         , AST.overlay   = overlay
216         }
217     where
218         accept = do
219             reserved "accept"
220             brackets $ many blockSpec
221         tranlsate = do
222             reserved "map"
223             specs <- brackets $ many mapSpecs
224             return $ concat specs
225         overlay = do
226             reserved "over"
227             identifier
228
229 nodeType = choice [memory, device]
230     where memory = do
231             symbol "memory"
232             return AST.Memory
233           device = do
234             symbol "device"
235             return AST.Device
236
237 blockSpec = choice [range, length, singleton]
238     where
239         singleton = do
240             address <- address
241             return $ AST.SingletonBlock address
242         range = do
243             base <- try $ address <* symbol "-"
244             limit <- address
245             return $ AST.RangeBlock base limit
246         length = do
247             base <- try $ address <* symbol "/"
248             bits <- decimal <?> "number of bits"
249             return $ AST.LengthBlock base (fromIntegral bits)
250
251 address = choice [address, param]
252     where
253         address = do
254             addr <- addressLiteral
255             return $ AST.LiteralAddress (fromIntegral addr)
256         param = do
257             name <- parameterName
258             return $ AST.ParamAddress name
259
260 mapSpecs = do
261     block <- blockSpec
262     reserved "to"
263     dests <- commaSep1 $ mapDest
264     return $ map (toMapSpec block) dests
265     where
266         mapDest = do
267             destNode <- identifier
268             destBase <- optionMaybe $ reserved "at" *> address
269             return (destNode, destBase)
270         toMapSpec block (destNode, destBase) = AST.MapSpec
271             { AST.block    = block
272             , AST.destNode = destNode
273             , AST.destBase = destBase
274             }
275
276 identifierFor = identifierHelper True
277
278 forVarRange optVarName
279     | optVarName = do 
280         var <- option "#" (try $ variableName <* reserved "in")
281         range var
282     | otherwise = do
283         var <- variableName
284         reserved "in"
285         range var
286     where
287         range var = brackets (do
288             start <- index
289             symbol ".."
290             end <- index
291             return AST.ForVarRange
292                 { AST.var   = var
293                 , AST.start = start
294                 , AST.end   = end
295                 }
296             )
297             <?> "range ([a..b])"
298         index = choice [numberIndex, paramIndex]
299         numberIndex = do
300             num <- numberLiteral
301             return $ AST.LiteralLimit (fromIntegral num)
302         paramIndex = do
303             name <- parameterName
304             return $ AST.ParamLimit name
305
306 {- Helper functions -}
307 lexer = P.makeTokenParser (
308     javaStyle  {
309         {- list of reserved Names -}
310         P.reservedNames = keywords,
311
312         {- valid identifiers -}
313         P.identStart = letter,
314         P.identLetter = identLetter,
315
316         {- comment start and end -}
317         P.commentStart = "/*",
318         P.commentEnd = "*/",
319         P.commentLine = "//",
320         P.nestedComments = False
321     })
322
323 whiteSpace    = P.whiteSpace lexer
324 reserved      = P.reserved lexer
325 parens        = P.parens lexer
326 brackets      = P.brackets lexer
327 braces        = P.braces lexer
328 symbol        = P.symbol lexer
329 stringLiteral = P.stringLiteral lexer
330 commaSep      = P.commaSep lexer
331 commaSep1     = P.commaSep1 lexer
332 identString    = P.identifier lexer
333 hexadecimal   = symbol "0" *> P.hexadecimal lexer <* whiteSpace
334 decimal       = P.decimal lexer <* whiteSpace
335
336 keywords = ["import", "module",
337             "input", "output",
338             "in",
339             "as", "with",
340             "is", "are",
341             "accept", "map",
342             "over",
343             "to", "at"]   
344
345 identStart     = letter
346 identLetter    = alphaNum <|> char '_' <|> char '-'
347
348 importPath     = many (identLetter <|> char '/') <* whiteSpace
349 moduleName     = identString <?> "module name"
350 parameterName  = identString <?> "parameter name"
351 variableName   = identString <?> "variable name"
352 identifierName = try ident <?> "identifier"
353     where
354         ident = do
355             start <- identStart
356             rest <- many identLetter
357             let ident = start:rest
358             if ident `elem` keywords
359                 then unexpected $ "reserved word \"" ++ ident ++ "\""
360                 else return ident
361
362 numberLiteral  = try decimal <?> "number literal"
363 addressLiteral = try hexadecimal <?> "address literal (hex)"
364
365 identifierHelper inlineFor = do
366     (varRanges, Just ident) <- choice [template identifierName, simple identifierName] <* whiteSpace
367     let
368         forFn = case varRanges of
369          [] -> Nothing
370          _  -> Just $ \body -> AST.For
371                 { AST.varRanges = varRanges
372                 , AST.body      = body
373                 }
374     return (forFn, ident)
375     where
376         simple ident = do
377             name <- ident
378             return $ ([], Just $ AST.SimpleIdent name)
379         template ident = do
380             prefix <- try $ ident <* symbol "{"
381             (ranges, varName, suffix) <- if inlineFor 
382                 then choice [forTemplate, varTemplate]
383                 else varTemplate
384             let
385                 ident = Just AST.TemplateIdent
386                     { AST.prefix = prefix
387                     , AST.varName = varName
388                     , AST.suffix = suffix
389                     }
390             return (ranges, ident)
391         varTemplate = do
392             varName <- variableName
393             char '}'
394             (ranges, suffix) <- templateSuffix
395             return (ranges, varName, suffix)
396         forTemplate = do
397             optVarRange <- forVarRange True
398             char '}'
399             (subRanges, suffix) <- templateSuffix
400             return $ let
401                 varName = mapOptVarName subRanges (AST.var optVarRange)
402                 varRange = optVarRange { AST.var = varName }
403                 ranges = varRange:subRanges
404                 in (ranges, varName, suffix)
405         templateSuffix = option ([], Nothing) $ choice
406             [ template $ many identLetter
407             , simple $ many1 identLetter
408             ]
409         mapOptVarName prev "#" = "#" ++ (show $ (length prev) + 1)
410         mapOptVarName _ name = name