Separate node IDs by whitespace for 'are' instead of commas
[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 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 <|> char '_' <|> char '-',
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 reserved      = P.reserved lexer
52 brackets      = P.brackets lexer
53 symbol        = P.symbol lexer
54 stringLiteral = P.stringLiteral lexer
55 commaSep      = P.commaSep lexer
56 commaSep1     = P.commaSep1 lexer
57 identifier    = P.identifier lexer
58 natural       = P.natural lexer
59 decimal       = P.decimal lexer
60
61 {- Sockeye parsing -}
62 sockeyeFile = do
63     whiteSpace
64     nodes <- many netSpec
65     eof
66     return $ AST.NetSpec $ concat nodes
67
68 netSpec = do
69     nodeIds <- choice [try single, try multiple]
70     node <- nodeSpec
71     return $ map (\nodeId -> (nodeId, node)) nodeIds
72     where single = do
73             nodeId <- nodeId
74             reserved "is"
75             return [nodeId]
76           multiple = do
77             nodeIds <- many1 nodeId
78             reserved "are"
79             return nodeIds
80
81 nodeSpec = do
82     nt <- nodeType
83     a <- optionMaybe parseAccept 
84     t <- optionMaybe parseTranlsate 
85     overlay <- optionMaybe parseOverlay
86     let accept = case a of Nothing -> []
87                            Just blocks -> blocks
88         translate = case t of Nothing -> []
89                               Just maps -> concat maps
90     return $ AST.NodeSpec nt accept translate overlay
91     where parseAccept = do
92             reserved "accept"
93             brackets $ many blockSpec
94           parseTranlsate = do
95             reserved "map"
96             brackets $ many mapSpec
97           parseOverlay = do
98             reserved "over"
99             nodeId
100
101 nodeType = try (choice [memory, device]) <|> return AST.Other
102     where memory = do
103             symbol "memory"
104             return AST.Memory
105           device = do
106             symbol "device"
107             return AST.Device
108
109
110 mapSpec = do
111     srcBlock <- blockSpec
112     reserved "to"
113     commaSep1 $ parseDest srcBlock
114     where parseDest srcBlock = do
115             destNode <- nodeId
116             dB <- optionMaybe parseDestBase
117             let destBase = case dB of Nothing -> AST.base srcBlock
118                                       Just addr -> addr
119             return $ AST.MapSpec srcBlock destNode destBase
120           parseDestBase = do
121             reserved "at"
122             addr
123
124 blockSpec = do
125     base <- addr
126     limit <- option base $ choice [parseLimit, parseLength base]
127     return $ AST.BlockSpec base limit
128     where parseLimit = do
129             symbol "-"
130             addr
131           parseLength (AST.Addr base) = do
132             symbol "/"
133             b <- decimal
134             -- While natural consumes following white space, decimal does not
135             whiteSpace 
136             return $ AST.Addr $ base + 2^b - 1
137
138 nodeId = do
139     id <- identifier <?> "node identifier"
140     return $ AST.NodeId id
141
142 addr = do
143     addr <- natural <?> "address"
144     return $ AST.Addr $ fromIntegral addr
145
146
147
148 parseSockeye :: String -> String -> Either ParseError AST.NetSpec
149 parseSockeye = parse sockeyeFile