utils/hpc/HpcParser.y

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