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 }