1{- 2 3 Parser.hs: Parser for the Flounder interface definition language 4 5 Part of Flounder: a strawman device definition DSL for Barrelfish 6 7 Copyright (c) 2009, ETH Zurich. 8 9 All rights reserved. 10 11 This file is distributed under the terms in the attached LICENSE file. 12 If you do not find this file, copies can be found by writing to: 13 ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group. 14-} 15 16module Parser where 17 18import FuguBackend 19 20import Text.ParserCombinators.Parsec as Parsec 21import Text.ParserCombinators.Parsec.Expr 22import Text.ParserCombinators.Parsec.Pos 23import qualified Text.ParserCombinators.Parsec.Token as P 24import Text.ParserCombinators.Parsec.Language( javaStyle ) 25import Data.Char 26import Numeric 27import Data.List 28import Text.Printf 29 30parse filename = parseFromFile errorFile filename 31 32lexer = P.makeTokenParser (javaStyle 33 { P.reservedNames = [ "errors", 34 "success", 35 "failure" 36 ] 37 , P.reservedOpNames = ["*","/","+","-"] 38 , P.commentStart = "/*" 39 , P.commentEnd = "*/" 40 , P.commentLine = "//" 41 }) 42 43whiteSpace = P.whiteSpace lexer 44reserved = P.reserved lexer 45identifier = P.identifier lexer 46stringLit = P.stringLiteral lexer 47comma = P.comma lexer 48commaSep = P.commaSep lexer 49commaSep1 = P.commaSep1 lexer 50parens = P.parens lexer 51braces = P.braces lexer 52squares = P.squares lexer 53semiSep = P.semiSep lexer 54symbol = P.symbol lexer 55 56 57errorFile = 58 do 59 whiteSpace 60 errors <- many1 errorClass 61 return errors 62 63 64errorClass = 65 do 66 reserved "errors" 67 name <- identifier 68 classE <- identifier 69 errors <- braces $ many1 (errorCase classE) 70 symbol ";" <?> " ';' missing from end of " ++ name ++ " error definition" 71 return $ ErrorClass name errors 72 73errorCase classE = 74 do 75 successCase classE 76 <|> (failureCase classE) 77 <|> (defaultSuccessCase classE) 78 79defaultSuccessCase classE = 80 do 81 reserved "default" 82 (ErrorField _ name descr) <- successCase classE 83 return $ ErrorField DefaultSuccess name descr 84 85successCase classE = 86 do 87 reserved "success" 88 acronym <- identifier 89 description <- stringLit 90 symbol "," <?> " ',' missing from end of " ++ acronym ++ " definition" 91 return $ ErrorField Success (classE ++ acronym) description 92 93failureCase classE = 94 do 95 reserved "failure" 96 acronym <- identifier 97 description <- stringLit 98 symbol "," <?> " ',' missing from end of " ++ acronym ++ " definition" 99 return $ ErrorField Failure (classE ++ acronym) description 100