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