Merge branch 'master' of git://git.haskell.org/ghc
[ghc.git] / utils / hpc / HpcParser.y
1
2 {-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
3 {-# OPTIONS -Wwarn -XNoMonomorphismRestriction #-}
4 -- The NoMonomorphismRestriction deals with a Happy infelicity
5 --    With OutsideIn's more conservativ monomorphism restriction
6 --    we aren't generalising
7 --        notHappyAtAll = error "urk"
8 --    which is terrible.  Switching off the restriction allows
9 --    the generalisation.  Better would be to make Happy generate
10 --    an appropriate signature.
11 --
12 -- The above warning supression flag is a temporary kludge.
13 -- While working on this module you are encouraged to remove it and fix
14 -- any warnings in the module. See
15 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 -- for details
17
18 module HpcParser where
19
20 import HpcLexer
21 }
22
23 %name parser
24 %expect 0
25 %tokentype { Token }
26
27 %token
28         MODULE          { ID "module" }
29         TICK            { ID "tick" }
30         EXPRESSION      { ID "expression" }
31         ON              { ID "on" }
32         LINE            { ID "line" }
33         POSITION        { ID "position" }
34         FUNCTION        { ID "function" }
35         INSIDE          { ID "inside" }
36         AT              { ID "at" }
37         ':'             { SYM ':' }
38         '-'             { SYM '-' }
39         ';'             { SYM ';' }
40         '{'             { SYM '{' }
41         '}'             { SYM '}' }
42         int             { INT $$ }
43         string          { STR $$ }
44         cat             { CAT $$ }
45 %%
46
47 Spec    :: { Spec }
48 Spec    : Ticks Modules         { Spec ($1 []) ($2 []) }
49
50 Modules :: { L (ModuleName,[Tick]) }
51 Modules : Modules Module        { $1 . ((:) $2) }
52         |                       { id }
53         
54 Module :: { (ModuleName,[Tick]) }
55 Module  : MODULE string '{' TopTicks '}'
56                                 { ($2,$4 []) }
57
58 TopTicks :: { L Tick }
59 TopTicks : TopTicks TopTick     { $1 . ((:) $2) }
60          |                      { id }
61         
62 TopTick :: { Tick }
63 TopTick : Tick                  { ExprTick $1 }
64         | TICK FUNCTION string optQual optCat ';'
65                                 { TickFunction $3 $4 $5 }
66         | INSIDE string '{' TopTicks '}'
67                                 { InsideFunction $2 ($4 []) }
68                                  
69 Ticks   :: { L ExprTick }
70 Ticks   : Ticks  Tick           { $1 . ((:) $2) }
71         |                       { id } 
72         
73 Tick   :: { ExprTick }
74 Tick    : TICK optString optQual optCat ';'
75                                 { TickExpression False $2 $3 $4 }
76
77 optString :: { Maybe String }
78 optString : string              { Just $1 }
79           |                     { Nothing }
80         
81 optQual :: { Maybe Qualifier }
82 optQual : ON LINE int           { Just (OnLine $3) }
83         | AT POSITION int ':' int '-' int ':' int
84                                 { Just (AtPosition $3 $5 $7 $9) }
85         |                       { Nothing }
86 optCat  :: { Maybe String }
87 optCat  : cat                   { Just $1 }
88         |                       { Nothing }
89
90 {
91 type L a = [a] -> [a]
92         
93 type ModuleName = String
94
95 data Spec 
96   = Spec [ExprTick] [(ModuleName,[Tick])]
97    deriving (Show)
98
99 data ExprTick
100   = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String)
101    deriving (Show)
102
103 data Tick
104   = ExprTick ExprTick
105   | TickFunction   String (Maybe Qualifier) (Maybe String)
106   | InsideFunction String [Tick]
107    deriving (Show)
108
109 data Qualifier = OnLine Int
110                | AtPosition Int Int Int Int
111    deriving (Show)             
112
113
114
115 hpcParser :: String -> IO Spec
116 hpcParser filename = do
117   txt <- readFile filename
118   let tokens = initLexer txt
119   return $ parser tokens        
120
121 happyError e = error $ show (take 10 e)
122 }