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