summaryrefslogtreecommitdiff
path: root/utils/hpc/HpcParser.y
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)
}