1{- 2 SockeyeParser.hs: Parser for Sockeye 3 4 Part of Sockeye 5 6 Copyright (c) 2018, 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, Universitaetstrasse 6, CH-8092 Zurich, 13 Attn: Systems Group. 14-} 15 16module SockeyeParser 17( parseSockeye ) where 18 19import System.FilePath 20 21import Text.Parsec 22import Text.Parsec.Expr 23import qualified Text.Parsec.Token as P 24import Text.Parsec.Language (emptyDef) 25 26import SockeyeASTMeta 27import qualified SockeyeParserAST as AST 28 29{- Parser main function -} 30parseSockeye :: String -> String -> Either ParseError AST.SockeyeFile 31parseSockeye = parse sockeyeFile 32 33data TopLevel 34 = ModuleDecl AST.Module 35 | TypeDecl AST.NamedType 36 37data ModuleBody 38 = ConstDecl AST.NamedConstant 39 | InstDecl AST.InstanceDeclaration 40 | NodeDecl AST.NodeDeclaration 41 | Def AST.Definition 42 43{- Sockeye parsing -} 44sockeyeFile = do 45 whiteSpace 46 pos <- getPositionMeta 47 imports <- many sockeyeImport 48 (modules, types) <- do 49 stmts <- many $ choice [moduleDecl, typeDecl] 50 return $ foldr splitDecl ([], []) stmts 51 eof 52 return AST.SockeyeFile 53 { AST.sockeyeFileMeta = pos 54 , AST.imports = imports 55 , AST.modules = modules 56 , AST.types = types 57 } 58 where 59 moduleDecl = fmap ModuleDecl sockeyeModule 60 typeDecl = fmap TypeDecl namedType 61 splitDecl (ModuleDecl m) (ms, ts) = (m:ms, ts) 62 splitDecl (TypeDecl t) (ms, ts) = (ms, t:ts) 63 64sockeyeImport = do 65 pos <- getPositionMeta 66 reserved "import" 67 path <- many1 (alphaNum <|> char '_' <|> char '-' <|> char '/') <* whiteSpace 68 explImports <- optionMaybe (parens $ commaSep1 importAlias) 69 return AST.Import 70 { AST.importMeta = pos 71 , AST.importFile = path <.> "soc" 72 , AST.explImports = explImports 73 } 74 <?> "import" 75 76importAlias = do 77 pos <- getPositionMeta 78 origName <- identString <?> "module or type to import" 79 alias <- option origName importAlias 80 return AST.ImportAlias 81 { AST.importAliasMeta = pos 82 , AST.originalName = origName 83 , AST.importAlias = alias 84 } 85 where 86 importAlias = do 87 reserved "as" 88 identString <?> "import alias" 89 90sockeyeModule = do 91 pos <- getPositionMeta 92 extern <- option False moduleExtern 93 reserved "module" 94 name <- moduleName 95 params <- option [] (parens $ commaSep moduleParam) 96 (consts, insts, nodes, defs) <- braces moduleBody 97 return AST.Module 98 { AST.moduleMeta = pos 99 , AST.moduleExtern = extern 100 , AST.moduleName = name 101 , AST.parameters = params 102 , AST.constants = consts 103 , AST.instDecls = insts 104 , AST.nodeDecls = nodes 105 , AST.definitions = defs 106 } 107 <?> "module specification" 108 109moduleExtern = do 110 reserved "extern" 111 return True 112 113moduleParam = do 114 pos <- getPositionMeta 115 range <- parens naturalSet <?> "parameter range" 116 paramName <- parameterName 117 return AST.ModuleParameter 118 { AST.paramMeta = pos 119 , AST.paramName = paramName 120 , AST.paramRange = range 121 } 122 123moduleBody = do 124 body <- many $ choice [constDecl, instDecl, nodeDecl, def] 125 return $ foldr splitBody ([], [], [], []) body 126 where 127 constDecl = fmap ConstDecl namedConstant 128 instDecl = fmap InstDecl instanceDeclaration 129 nodeDecl = fmap NodeDecl nodeDeclaration 130 def = fmap Def definition 131 splitBody (ConstDecl c) (cs, is, ns, ds) = (c:cs, is, ns, ds) 132 splitBody (InstDecl i) (cs, is, ns, ds) = (cs, i:is, ns, ds) 133 splitBody (NodeDecl n) (cs, is, ns, ds) = (cs, is, n:ns, ds) 134 splitBody (Def d) (cs, is, ns, ds) = (cs, is, ns, d:ds) 135 136instanceDeclaration = do 137 pos <- getPositionMeta 138 reserved "instance" 139 name <- identifierName 140 size <- optionMaybe arraySize 141 reserved "of" 142 modName <- moduleName 143 return AST.InstanceDeclaration 144 { AST.instDeclMeta = pos 145 , AST.instName = name 146 , AST.instModName = modName 147 , AST.instArrSize = size 148 } 149 <?> "instance declaration" 150 151nodeDeclaration = do 152 pos <- getPositionMeta 153 kind <- nodeKind 154 t <- nodeType 155 name <- identifierName 156 size <- optionMaybe arraySize 157 return AST.NodeDeclaration 158 { AST.nodeDeclMeta = pos 159 , AST.nodeKind = kind 160 , AST.nodeType = t 161 , AST.nodeName = name 162 , AST.nodeArrSize = size 163 } 164 <?> "node declaration" 165 166nodeKind = option AST.InternalNode $ choice [input, output] 167 where 168 input = do 169 reserved "input" 170 return AST.InputPort 171 output = do 172 reserved "output" 173 return AST.OutputPort 174 175nodeType = do 176 pos <- getPositionMeta 177 originDomain <- domain 178 originType <- edgeType 179 (targetDomain, targetType) <- option (originDomain, Nothing) $ do 180 reserved "to" 181 d <- domain 182 t <- optionMaybe edgeType 183 return (d, t) 184 return AST.NodeType 185 { AST.nodeTypeMeta = pos 186 , AST.originDomain = originDomain 187 , AST.originType = originType 188 , AST.targetDomain = targetDomain 189 , AST.targetType = targetType 190 } 191 192 193domain = choice [memory, intr, power, clock] <?> "node domain" 194 where 195 memory = do 196 reserved "memory" 197 return AST.Memory 198 intr = do 199 reserved "intr" 200 return AST.Interrupt 201 power = do 202 reserved "power" 203 return AST.Power 204 clock = do 205 reserved "clock" 206 return AST.Clock 207 208edgeType = choice [literal, named] 209 where 210 literal = do 211 pos <- getPositionMeta 212 addrType <- addressType 213 return $ AST.TypeLiteral pos addrType 214 named = do 215 pos <- getPositionMeta 216 name <- parens typeName 217 return $ AST.TypeName pos name 218 <?> "(<type name>)" 219 220definition = choice [forall, def] 221 where 222 def = do 223 receiver <- unqualifiedRef 224 choice 225 [ accepts receiver 226 , maps receiver 227 , converts receiver 228 , overlays receiver 229 , blockoverlays receiver 230 , instantiates receiver 231 , binds receiver 232 ] 233 234accepts node = do 235 pos <- getPositionMeta 236 reserved "accepts" 237 blocks <- brackets $ semiSep addressBlock 238 return $ AST.Accepts pos node blocks 239 240maps node = do 241 pos <- getPositionMeta 242 reserved "maps" 243 maps <- brackets $ semiSep mapSpec 244 return $ AST.Maps pos node maps 245 246mapSpec = do 247 pos <- getPositionMeta 248 addr <- addressBlock 249 reserved "to" 250 targets <- commaSep1 mapTarget 251 return $ AST.MapSpec pos addr targets 252 where 253 mapTarget = do 254 pos <- getPositionMeta 255 node <- nodeReference 256 reserved "at" 257 addr <- addressBlock 258 return $ AST.MapTarget pos node addr 259 260converts node = do 261 pos <- getPositionMeta 262 reserved "converts" 263 converts <- brackets $ semiSep convertSpec 264 return $ AST.Converts pos node converts 265 266convertSpec = mapSpec 267 268blockoverlays node = do 269 pos <- getPositionMeta 270 reserved "blockoverlays" 271 overlay <- nodeReference 272 reserved "bits" 273 blocksizes <- parens $ commaSep1 natural 274 return $ AST.BlockOverlays pos node overlay blocksizes 275 276overlays node = do 277 pos <- getPositionMeta 278 reserved "overlays" 279 overlay <- nodeReference 280 return $ AST.Overlays pos node overlay 281 282instantiates inst = do 283 pos <- getPositionMeta 284 reserved "instantiates" 285 modName <- moduleName 286 args <- option [] (parens $ commaSep naturalExpr) 287 return AST.Instantiates 288 { AST.defMeta = pos 289 , AST.inst = inst 290 , AST.instModule = modName 291 , AST.arguments = args 292 } 293 294binds inst = do 295 pos <- getPositionMeta 296 reserved "binds" 297 bindings <- brackets $ semiSep portBinding 298 return $ AST.Binds pos inst bindings 299 where 300 portBinding = do 301 pos <- getPositionMeta 302 port <- unqualifiedRef 303 reserved "to" 304 node <- nodeReference 305 return $ AST.PortBinding pos port node 306 307forall = do 308 pos <- getPositionMeta 309 reserved "forall" 310 var <- variableName 311 reserved "in" 312 range <- parens naturalSet 313 body <- braces $ many definition 314 return AST.Forall 315 { AST.defMeta = pos 316 , AST.boundVarName = var 317 , AST.varRange = range 318 , AST.quantifierBody = body 319 } 320 321unqualifiedRef = do 322 pos <- getPositionMeta 323 name <- identifierName 324 index <- optionMaybe arrayIndex 325 return AST.UnqualifiedRef 326 { AST.refMeta = pos 327 , AST.refName = name 328 , AST.refIndex = index 329 } 330 331nodeReference = do 332 pos <- getPositionMeta 333 ref1 <- unqualifiedRef 334 ref2 <- optionMaybe $ (reservedOp "." >> unqualifiedRef) 335 return $ maybe (AST.InternalNodeRef pos ref1) (AST.InputPortRef pos ref1) ref2 336 337namedType = do 338 pos <- getPositionMeta 339 reserved "type" 340 name <- typeName 341 addrType <- addressType 342 return $ AST.NamedType pos name addrType 343 <?> "named type" 344 345namedConstant = do 346 pos <- getPositionMeta 347 reserved "const" 348 name <- constName 349 value <- natural 350 return $ AST.NamedConstant pos name value 351 <?> "named constant" 352 353addressType = do 354 pos <- getPositionMeta 355 addrType <- parens $ semiSep1 naturalSet 356 return $ AST.AddressType pos addrType 357 <?> "address type literal" 358 359address = do 360 pos <- getPositionMeta 361 addr <- parens $ semiSep1 wildcardSet 362 return $ AST.Address pos addr 363 <?> "address tuple" 364 365addressBlock = do 366 pos <- getPositionMeta 367 addr <- address 368 props <- option AST.True propertyExpr 369 return $ AST.AddressBlock pos addr props 370 371arraySize = do 372 pos <- getPositionMeta 373 size <- brackets $ semiSep1 naturalSet 374 return $ AST.ArraySize pos size 375 <?> "array size" 376 377arrayIndex = do 378 pos <- getPositionMeta 379 index <- brackets $ semiSep1 wildcardSet 380 return $ AST.ArrayIndex pos index 381 <?> "array index" 382 383naturalSet = do 384 pos <- getPositionMeta 385 ranges <- commaSep1 naturalRange 386 return $ AST.NaturalSet pos ranges 387 <?> "set of naturals" 388 389wildcardSet = choice [wildcard, explicit] 390 where 391 explicit = do 392 pos <- getPositionMeta 393 set <- naturalSet 394 return $ AST.ExplicitSet pos set 395 wildcard = do 396 pos <- getPositionMeta 397 reservedOp "*" 398 return $ AST.Wildcard pos 399 400naturalRange = do 401 pos <- getPositionMeta 402 base <- naturalExpr 403 choice [bits pos base, limit pos base, singleton pos base] 404 <?> "range of naturals" 405 where 406 bits pos base = do 407 reserved "bits" 408 bits <- naturalExpr 409 return $ AST.BitsRange pos base bits 410 limit pos base = do 411 reserved "to" 412 limit <- naturalExpr 413 return $ AST.LimitRange pos base limit 414 singleton pos base = return $ AST.SingletonRange pos base 415 416naturalExpr = buildExpressionParser opTable term <?> "arithmetic expression" 417 where 418 term = parens naturalExpr <|> var <|> lit 419 opTable = 420 [ [ Postfix slice ] 421 , [ Infix mult AssocLeft ] 422 , [ Infix add AssocLeft, Infix sub AssocLeft ] 423 , [ Infix concat AssocLeft ] 424 ] 425 var = do 426 pos <- getPositionMeta 427 name <- variableName 428 return $ AST.Variable pos name 429 lit = do 430 pos <- getPositionMeta 431 value <- natural 432 return $ AST.Literal pos value 433 slice = do 434 pos <- getPositionMeta 435 range <- brackets naturalRange 436 return $ flip (AST.Slice pos) range 437 mult = do 438 pos <- getPositionMeta 439 reservedOp "*" 440 return $ AST.Multiplication pos 441 add = do 442 pos <- getPositionMeta 443 reservedOp "+" 444 return $ AST.Addition pos 445 sub = do 446 pos <- getPositionMeta 447 reservedOp "-" 448 return $ AST.Subtraction pos 449 concat = do 450 pos <- getPositionMeta 451 reservedOp "++" 452 return $ AST.Concat pos 453 454propertyExpr = buildExpressionParser opTable term <?> "property expression" 455 where 456 term = parens propertyExpr <|> prop 457 opTable = 458 [ [ Prefix not ] 459 , [ Infix and AssocLeft, Infix or AssocLeft ] 460 ] 461 prop = do 462 pos <- getPositionMeta 463 name <- propertyName 464 return $ AST.Property pos name 465 not = do 466 pos <- getPositionMeta 467 reservedOp "!" 468 return $ AST.Not pos 469 and = do 470 pos <- getPositionMeta 471 reservedOp "&&" 472 return $ AST.And pos 473 or = do 474 pos <- getPositionMeta 475 reservedOp "||" 476 return $ AST.Or pos 477 478{- Helper functions -} 479lexer = P.makeTokenParser ( 480 emptyDef { 481 {- List of reserved names -} 482 P.reservedNames = 483 [ "import", "as" 484 , "extern" 485 , "module" 486 , "input", "output" 487 , "type", "const" 488 , "memory", "intr", "power", "clock", "instance" 489 , "of" 490 , "forall", "in" 491 , "accepts", "maps", "converts", "overlays", "blockoverlays" 492 , "instantiates", "binds" 493 , "to", "at" 494 , "bits" 495 ], 496 497 {- List of operators -} 498 P.reservedOpNames = 499 [ "+", "-", "*", "/", "++" 500 , "!", "&&", "||" 501 , "." 502 ], 503 504 {- Valid identifiers -} 505 P.identStart = letter, 506 P.identLetter = alphaNum <|> char '_', 507 508 {- comment start and end -} 509 P.commentStart = "/*", 510 P.commentEnd = "*/", 511 P.commentLine = "//", 512 P.nestedComments = False, 513 514 {- Sockeye is case sensitive -} 515 P.caseSensitive = True 516 }) 517 518whiteSpace = P.whiteSpace lexer 519reserved = P.reserved lexer 520reservedOp = P.reservedOp lexer 521parens = P.parens lexer 522brackets = P.brackets lexer 523braces = P.braces lexer 524commaSep = P.commaSep lexer 525commaSep1 = P.commaSep1 lexer 526semiSep = P.semiSep lexer 527semiSep1 = P.semiSep1 lexer 528identString = P.identifier lexer 529natural = P.natural lexer 530 531typeName = identString <?> "type name" 532constName = identString <?> "constant name" 533moduleName = identString <?> "module name" 534parameterName = identString <?> "parameter name" 535variableName = identString <?> "variable name" 536propertyName = identString <?> "property name" 537identifierName = identString <?> "identifier" 538 539getPositionMeta = fmap ParserMeta getPosition 540