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://hackage.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 }