100 lines
2.9 KiB
Haskell
100 lines
2.9 KiB
Haskell
{-
|
|
|
|
Parser.hs: Parser for the Flounder interface definition language
|
|
|
|
Part of Flounder: a strawman device definition DSL for Barrelfish
|
|
|
|
Copyright (c) 2009, ETH Zurich.
|
|
|
|
All rights reserved.
|
|
|
|
This file is distributed under the terms in the attached LICENSE file.
|
|
If you do not find this file, copies can be found by writing to:
|
|
ETH Zurich D-INFK, Universitaetstrasse 6, CH-8092 Zurich. Attn: Systems Group.
|
|
-}
|
|
|
|
module Parser where
|
|
|
|
import FuguBackend
|
|
|
|
import Text.ParserCombinators.Parsec as Parsec
|
|
import Text.ParserCombinators.Parsec.Expr
|
|
import Text.ParserCombinators.Parsec.Pos
|
|
import qualified Text.ParserCombinators.Parsec.Token as P
|
|
import Text.ParserCombinators.Parsec.Language( javaStyle )
|
|
import Data.Char
|
|
import Numeric
|
|
import Data.List
|
|
import Text.Printf
|
|
|
|
parse filename = parseFromFile errorFile filename
|
|
|
|
lexer = P.makeTokenParser (javaStyle
|
|
{ P.reservedNames = [ "errors",
|
|
"success",
|
|
"failure"
|
|
]
|
|
, P.reservedOpNames = ["*","/","+","-"]
|
|
, P.commentStart = "/*"
|
|
, P.commentEnd = "*/"
|
|
, P.commentLine = "//"
|
|
})
|
|
|
|
whiteSpace = P.whiteSpace lexer
|
|
reserved = P.reserved lexer
|
|
identifier = P.identifier lexer
|
|
stringLit = P.stringLiteral lexer
|
|
comma = P.comma lexer
|
|
commaSep = P.commaSep lexer
|
|
commaSep1 = P.commaSep1 lexer
|
|
parens = P.parens lexer
|
|
braces = P.braces lexer
|
|
squares = P.squares lexer
|
|
semiSep = P.semiSep lexer
|
|
symbol = P.symbol lexer
|
|
|
|
|
|
errorFile =
|
|
do
|
|
whiteSpace
|
|
errors <- many1 errorClass
|
|
return errors
|
|
|
|
|
|
errorClass =
|
|
do
|
|
reserved "errors"
|
|
name <- identifier
|
|
classE <- identifier
|
|
errors <- braces $ many1 (errorCase classE)
|
|
symbol ";" <?> " ';' missing from end of " ++ name ++ " error definition"
|
|
return $ ErrorClass name errors
|
|
|
|
errorCase classE =
|
|
do
|
|
successCase classE
|
|
<|> (failureCase classE)
|
|
<|> (defaultSuccessCase classE)
|
|
|
|
defaultSuccessCase classE =
|
|
do
|
|
reserved "default"
|
|
(ErrorField _ name descr) <- successCase classE
|
|
return $ ErrorField DefaultSuccess name descr
|
|
|
|
successCase classE =
|
|
do
|
|
reserved "success"
|
|
acronym <- identifier
|
|
description <- stringLit
|
|
symbol "," <?> " ',' missing from end of " ++ acronym ++ " definition"
|
|
return $ ErrorField Success (classE ++ acronym) description
|
|
|
|
failureCase classE =
|
|
do
|
|
reserved "failure"
|
|
acronym <- identifier
|
|
description <- stringLit
|
|
symbol "," <?> " ',' missing from end of " ++ acronym ++ " definition"
|
|
return $ ErrorField Failure (classE ++ acronym) description
|