Sockeye: Refactoring
[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     nameSpace <- identifier
127     portMappings <- option [] $ symbol "with" *> many1 portMapping
128     return AST.ModuleInst
129         { AST.moduleName = name
130         , AST.nameSpace  = nameSpace
131         , AST.arguments  = args 
132         , AST.portMappings = portMappings
133         }
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.NumberArg (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.portId   = 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.portId   = portId
166                     , AST.mappedId = mappedId
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 [nodeId]
181         multiple = do
182             nodeIds <- commaSep1 identifier
183             reserved "are"
184             return nodeIds
185         toNodeDecl nodeSpec nodeId = AST.NodeDecl
186             { AST.nodeId = nodeId
187             , AST.nodeSpec = nodeSpec
188             } 
189
190 identifier = do
191     (_, ident) <- identifierHelper False
192     return ident
193
194 nodeSpec = do
195     nodeType <- optionMaybe $ try nodeType
196     accept <- option [] accept 
197     translate <- option [] tranlsate 
198     overlay <- optionMaybe overlay
199     return AST.NodeSpec 
200         { AST.nodeType  = nodeType
201         , AST.accept    = accept
202         , AST.translate = translate
203         , AST.overlay   = overlay
204         }
205     where
206         accept = do
207             reserved "accept"
208             brackets $ many blockSpec
209         tranlsate = do
210             reserved "map"
211             brackets $ many mapSpec
212         overlay = do
213             reserved "over"
214             identifier
215
216 nodeType = choice [memory, device]
217     where memory = do
218             symbol "memory"
219             return AST.Memory
220           device = do
221             symbol "device"
222             return AST.Device
223
224 blockSpec = choice [range, length, singleton]
225     where
226         singleton = do
227             address <- address
228             return $ AST.SingletonBlock address
229         range = do
230             base <- try $ address <* symbol "-"
231             limit <- address
232             return $ AST.RangeBlock base limit
233         length = do
234             base <- try $ address <* symbol "/"
235             bits <- decimal <?> "number of bits"
236             return $ AST.LengthBlock base (fromIntegral bits)
237
238 address = choice [address, param]
239     where
240         address = do
241             addr <- addressLiteral
242             return $ AST.NumberAddress (fromIntegral addr)
243         param = do
244             name <- parameterName
245             return $ AST.ParamAddress name
246
247 mapSpec = do
248     block <- blockSpec
249     reserved "to"
250     dests <- commaSep1 $ mapDest
251     return $ AST.MapSpec block dests
252
253 mapDest = choice [baseAddress, direct]
254     where
255         direct = do
256             destNode <- identifier
257             return $ AST.DirectMap destNode
258         baseAddress = do
259             destNode <- try $ identifier <* reserved "at"
260             destBase <- address
261             return $ AST.BaseAddressMap destNode destBase
262
263 for body = do
264     reserved "for"
265     varRanges <- commaSep1 $ forVarRange False
266     body <- braces body
267     return AST.For
268         { AST.varRanges = varRanges
269         , AST.body      = body
270         }
271
272 identifierFor = identifierHelper True
273
274 forVarRange optVarName
275     | optVarName = do 
276         var <- option "#" (try $ variableName <* reserved "in")
277         range var
278     | otherwise = do
279         var <- variableName
280         reserved "in"
281         range var
282     where
283         range var = brackets (do
284             start <- index
285             symbol ".."
286             end <- index
287             return AST.ForVarRange
288                 { AST.var   = var
289                 , AST.start = start
290                 , AST.end   = end
291                 }
292             )
293             <?> "range ([a..b])"
294         index = choice [numberIndex, paramIndex]
295         numberIndex = do
296             num <- numberLiteral
297             return $ AST.NumberLimit (fromIntegral num)
298         paramIndex = do
299             name <- parameterName
300             return $ AST.ParamLimit name
301
302 {- Helper functions -}
303 lexer = P.makeTokenParser (
304     javaStyle  {
305         {- list of reserved Names -}
306         P.reservedNames = keywords,
307
308         {- valid identifiers -}
309         P.identStart = letter,
310         P.identLetter = identLetter,
311
312         {- comment start and end -}
313         P.commentStart = "/*",
314         P.commentEnd = "*/",
315         P.commentLine = "//",
316         P.nestedComments = False
317     })
318
319 whiteSpace    = P.whiteSpace lexer
320 reserved      = P.reserved lexer
321 parens        = P.parens lexer
322 brackets      = P.brackets lexer
323 braces        = P.braces lexer
324 symbol        = P.symbol lexer
325 stringLiteral = P.stringLiteral lexer
326 commaSep      = P.commaSep lexer
327 commaSep1     = P.commaSep1 lexer
328 identString    = P.identifier lexer
329 hexadecimal   = symbol "0" *> P.hexadecimal lexer <* whiteSpace
330 decimal       = P.decimal lexer <* whiteSpace
331
332 keywords = ["module",
333             "input", "output",
334             "for", "in",
335             "as", "with",
336             "is", "are",
337             "accept", "map",
338             "over",
339             "to", "at"]   
340
341 identStart     = letter
342 identLetter    = alphaNum <|> char '_' <|> char '-'
343
344 moduleName     = identString <?> "module name"
345 parameterName  = identString <?> "parameter name"
346 variableName   = identString <?> "variable name"
347 identifierName = try ident <?> "identifier"
348     where
349         ident = do
350             start <- identStart
351             rest <- many identLetter
352             let ident = start:rest
353             if ident `elem` keywords
354                 then unexpected $ "reserved word \"" ++ ident ++ "\""
355                 else return ident
356
357 numberLiteral  = try decimal <?> "number literal"
358 addressLiteral = try hexadecimal <?> "address literal (hex)"
359
360 identifierHelper inlineFor = do
361     (varRanges, Just ident) <- choice [template identifierName, simple identifierName] <* whiteSpace
362     let
363         forFn = case varRanges of
364          [] -> Nothing
365          _  -> Just $ \body -> AST.For
366                 { AST.varRanges = varRanges
367                 , AST.body      = body
368                 }
369     return (forFn, ident)
370     where
371         simple ident = do
372             name <- ident
373             return $ ([], Just $ AST.SimpleIdent name)
374         template ident = do
375             prefix <- try $ ident <* symbol "{"
376             (ranges, varName, suffix) <- if inlineFor 
377                 then choice [forTemplate, varTemplate]
378                 else varTemplate
379             let
380                 ident = Just AST.TemplateIdent
381                     { AST.prefix = prefix
382                     , AST.varName = varName
383                     , AST.suffix = suffix
384                     }
385             return (ranges, ident)
386         varTemplate = do
387             varName <- variableName
388             char '}'
389             (ranges, suffix) <- templateSuffix
390             return (ranges, varName, suffix)
391         forTemplate = do
392             optVarRange <- forVarRange True
393             char '}'
394             (subRanges, suffix) <- templateSuffix
395             return $ let
396                 varName = mapOptVarName subRanges (AST.var optVarRange)
397                 varRange = optVarRange { AST.var = varName }
398                 ranges = varRange:subRanges
399                 in (ranges, varName, suffix)
400         templateSuffix = option ([], Nothing) $ choice
401             [ template $ many identLetter
402             , simple $ many1 identLetter
403             ]
404         mapOptVarName prev "#" = "#" ++ (show $ (length prev) + 1)
405         mapOptVarName _ name = name