Fix Trac #2311: creates subdirs for package coverage information
[ghc.git] / utils / hpc / HpcParser.y
1
2 {-# OPTIONS -w #-}
3 -- The above warning supression flag is a temporary kludge.
4 -- While working on this module you are encouraged to remove it and fix
5 -- any warnings in the module. See
6 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
7 -- for details
8
9 module HpcParser where
10
11 import HpcLexer
12 }
13
14 %name parser
15 %tokentype { Token }
16
17 %token
18         MODULE          { ID "module" }
19         TICK            { ID "tick" }
20         EXPRESSION      { ID "expression" }
21         ON              { ID "on" }
22         LINE            { ID "line" }
23         POSITION        { ID "position" }
24         FUNCTION        { ID "function" }
25         INSIDE          { ID "inside" }
26         AT              { ID "at" }
27         ':'             { SYM ':' }
28         '-'             { SYM '-' }
29         ';'             { SYM ';' }
30         '{'             { SYM '{' }
31         '}'             { SYM '}' }
32         int             { INT $$ }
33         string          { STR $$ }
34         cat             { CAT $$ }
35 %%
36
37 Spec    :: { Spec }
38 Spec    : Ticks Modules         { Spec ($1 []) ($2 []) }
39
40 Modules :: { L (ModuleName,[Tick]) }
41 Modules : Modules Module        { $1 . ((:) $2) }
42         |                       { id }
43         
44 Module :: { (ModuleName,[Tick]) }
45 Module  : MODULE string '{' TopTicks '}'
46                                 { ($2,$4 []) }
47
48 TopTicks :: { L Tick }
49 TopTicks : TopTicks TopTick     { $1 . ((:) $2) }
50          |                      { id }
51         
52 TopTick :: { Tick }
53 TopTick : Tick                  { ExprTick $1 }
54         | TICK FUNCTION string optQual optCat ';'
55                                 { TickFunction $3 $4 $5 }
56         | INSIDE string '{' TopTicks '}'
57                                 { InsideFunction $2 ($4 []) }
58                                  
59 Ticks   :: { L ExprTick }
60 Ticks   : Ticks  Tick           { $1 . ((:) $2) }
61         |                       { id } 
62         
63 Tick   :: { ExprTick }
64 Tick    : TICK optString optQual optCat ';'
65                                 { TickExpression False $2 $3 $4 }
66
67 optString :: { Maybe String }
68 optString : string              { Just $1 }
69           |                     { Nothing }
70         
71 optQual :: { Maybe Qualifier }
72 optQual : ON LINE int           { Just (OnLine $3) }
73         | AT POSITION int ':' int '-' int ':' int
74                                 { Just (AtPosition $3 $5 $7 $9) }
75         |                       { Nothing }
76 optCat  :: { Maybe String }
77 optCat  : cat                   { Just $1 }
78         |                       { Nothing }
79
80 {
81 type L a = [a] -> [a]
82         
83 type ModuleName = String
84
85 data Spec 
86   = Spec [ExprTick] [(ModuleName,[Tick])]
87    deriving (Show)
88
89 data ExprTick
90   = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String)
91    deriving (Show)
92
93 data Tick
94   = ExprTick ExprTick
95   | TickFunction   String (Maybe Qualifier) (Maybe String)
96   | InsideFunction String [Tick]
97    deriving (Show)
98
99 data Qualifier = OnLine Int
100                | AtPosition Int Int Int Int
101    deriving (Show)             
102
103
104
105 hpcParser :: String -> IO Spec
106 hpcParser filename = do
107   txt <- readFile filename
108   let tokens = initLexer txt
109   return $ parser tokens        
110
111 happyError e = error $ show (take 10 e)
112 }