9f55c649c71d08aea5fc48245e0994ace3f30075
[barrelfish] / tools / sockeye2 / 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 Text.ParserCombinators.Parsec as Parsec
22 import qualified Text.ParserCombinators.Parsec.Token as P
23 import Text.ParserCombinators.Parsec.Language (javaStyle)
24
25 import qualified SockeyeAST as AST
26
27 {- Setup the lexer -}
28 lexer = P.makeTokenParser (
29     javaStyle  {
30         {- list of reserved Names -}
31         P.reservedNames = [
32             "is", "are",
33             "accept", "map",
34             "over",
35             "to", "at"
36         ],
37
38         {- valid identifiers -}
39         P.identStart = letter,
40         P.identLetter = alphaNum,
41
42         {- comment start and end -}
43         P.commentStart = "/*",
44         P.commentEnd = "*/",
45         P.commentLine = "//",
46         P.nestedComments = False
47     })
48
49 {- Helper functions -}
50 whiteSpace    = P.whiteSpace lexer
51 identifier    = P.identifier lexer <?> "node identifier"
52 reserved      = P.reserved lexer
53 address       = liftM fromIntegral (P.natural lexer) <?> "address"
54 brackets      = P.brackets lexer
55 symbol        = P.symbol lexer
56 stringLiteral = P.stringLiteral lexer
57 commaSep      = P.commaSep lexer
58 commaSep1     = P.commaSep1 lexer
59
60 {- Sockeye parsing -}
61 sockeyeFile = do
62     whiteSpace
63     nodes <- many netSpec
64     eof
65     return $ AST.NetSpec $ concat nodes
66
67 netSpec = do
68     nodeIds <- try single <|> multiple
69     node <- nodeSpec
70     return $ map (\nodeId -> (nodeId, node)) nodeIds
71     where single = do
72             nodeId <- identifier
73             reserved "is"
74             return [nodeId]
75           multiple = do
76             nodeIds <- commaSep1 identifier
77             reserved "are"
78             return nodeIds
79
80 nodeSpec = do
81     a <- optionMaybe parseAccept 
82     t <- optionMaybe parseTranlsate 
83     overlay <- optionMaybe parseOverlay
84     let accept = case a of Nothing -> []
85                            Just blocks -> blocks
86         translate = case t of Nothing -> []
87                               Just maps -> maps
88     return $ AST.NodeSpec accept translate overlay
89     where parseAccept = do
90             reserved "accept"
91             brackets $ commaSep blockSpec
92           parseTranlsate = do
93             reserved "map"
94             brackets $ commaSep mapSpec
95           parseOverlay = do
96             reserved "over"
97             identifier
98
99 mapSpec = do
100     srcBlock <- blockSpec
101     reserved "to"
102     destNode <- identifier
103     reserved "at"
104     destBase <- address
105     return $ AST.MapSpec srcBlock destNode destBase
106
107 blockSpec = do
108     base <- address
109     limit <- try parseLimit <|> return base
110     return $ AST.BlockSpec base limit
111     where parseLimit = do
112             symbol "-"
113             address
114
115 parseSockeye :: String -> String -> Either ParseError AST.NetSpec
116 parseSockeye = parse sockeyeFile