1{-
2
3   Parser.hs: Parser for the pleco interface definition language
4
5   Part of Pleco: a trace definition DSL for Barrelfish
6
7  Copyright (c) 2013, 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 Text.ParserCombinators.Parsec as Parsec
19import Text.ParserCombinators.Parsec.Expr
20import Text.ParserCombinators.Parsec.Pos
21import qualified Text.ParserCombinators.Parsec.Token as P
22import Text.ParserCombinators.Parsec.Language( javaStyle )
23import Data.Char
24import Numeric
25import Data.List
26import Text.Printf
27
28parse filename = parseFromFile traceFile filename
29
30lexer = P.makeTokenParser (javaStyle
31                           { P.reservedNames = [ "subsystem",
32                                                 "event"
33                                               ]
34                           , P.reservedOpNames = ["*","/","+","-"]
35                           , P.commentStart = "/*"
36                           , P.commentEnd = "*/"
37                           , P.commentLine = "//"
38                           })
39
40whiteSpace = P.whiteSpace lexer
41reserved   = P.reserved lexer
42identifier = P.identifier lexer
43stringLit  = P.stringLiteral lexer
44comma      = P.comma lexer
45commaSep   = P.commaSep lexer
46commaSep1  = P.commaSep1 lexer
47parens     = P.parens lexer
48braces     = P.braces lexer
49squares    = P.squares lexer
50semiSep    = P.semiSep lexer
51symbol     = P.symbol lexer
52
53data EventField = EventField String String
54data SubsystemClass = SubsystemClass String [ EventField ]
55
56traceFile =
57    do
58      whiteSpace
59      subsystems <- many1 subsystemClass
60      return subsystems
61
62
63subsystemClass =
64    do
65      reserved "subsystem"
66      name <- identifier
67      events <- braces $ many1 eventCase
68      symbol ";" <?> " ';' missing from end of " ++ name ++ " subsystem definition"
69      return $ SubsystemClass name events
70
71
72eventCase =
73    do
74      reserved "event"
75      acronym <- identifier
76      description <- stringLit
77      symbol "," <?> " ',' missing from end of " ++ acronym ++ " definition"
78      return $ EventField acronym description
79