HpcParser.y 2.89 KB
Newer Older
1
{ 
2
{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
3 4 5 6 7 8 9 10 11
{-# 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.
--
12
-- The above warning suppression flag is a temporary kludge.
13 14
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
15
--     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 17
-- for details

18 19 20 21 22 23
module HpcParser where

import HpcLexer
}

%name parser
24
%expect 0
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
%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 $$ }
andy@galois.com's avatar
andy@galois.com committed
44
	cat		{ CAT $$ }
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
%%

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  	

121
happyError e = error $ show (take 10 e)
122
}