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