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