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