Rename sockey2 -> sockeye
[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 '_',
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 <- try single <|> 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 <- commaSep1 nodeId
78             reserved "are"
79             return nodeIds
80
81 nodeSpec = do
82     a <- optionMaybe parseAccept 
83     t <- optionMaybe parseTranlsate 
84     overlay <- optionMaybe parseOverlay
85     let accept = case a of Nothing -> []
86                            Just blocks -> blocks
87         translate = case t of Nothing -> []
88                               Just maps -> concat maps
89     return $ AST.NodeSpec accept translate overlay
90     where parseAccept = do
91             reserved "accept"
92             brackets $ many blockSpec
93           parseTranlsate = do
94             reserved "map"
95             brackets $ many mapSpec
96           parseOverlay = do
97             reserved "over"
98             nodeId
99
100 mapSpec = do
101     srcBlock <- blockSpec
102     reserved "to"
103     commaSep1 $ parseDest srcBlock
104     where parseDest srcBlock = do
105             destNode <- nodeId
106             dB <- optionMaybe parseDestBase
107             let destBase = case dB of Nothing -> AST.base srcBlock
108                                       Just addr -> addr
109             return $ AST.MapSpec srcBlock destNode destBase
110           parseDestBase = do
111             reserved "at"
112             addr
113
114 blockSpec = do
115     base <- addr
116     limit <- option base $ choice [parseLimit, parseLength base]
117     return $ AST.BlockSpec base limit
118     where parseLimit = do
119             symbol "-"
120             addr
121           parseLength (AST.Addr base) = do
122             symbol "/"
123             b <- decimal
124             -- While natural consumes following white space, decimal does not
125             whiteSpace 
126             return $ AST.Addr $ base + 2^b - 1
127
128 nodeId = do
129     id <- identifier <?> "node identifier"
130     return $ AST.NodeId id
131
132 addr = do
133     addr <- natural <?> "address"
134     return $ AST.Addr $ fromIntegral addr
135
136
137
138 parseSockeye :: String -> String -> Either ParseError AST.NetSpec
139 parseSockeye = parse sockeyeFile