SrcSpan, combineLocs, srcLocFile,
mkSrcLoc, mkSrcSpan )
import Module
-import StaticFlags ( opt_SccProfilingOn )
+import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..), defaultInlineSpec )
'{-# RULES' { L _ ITrules_prag }
'{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
'{-# SCC' { L _ ITscc_prag }
+ '{-# GENERATED' { L _ ITgenerated_prag }
'{-# DEPRECATED' { L _ ITdeprecated_prag }
'{-# UNPACK' { L _ ITunpack_prag }
'#-}' { L _ ITclose_prag }
-- errors in ctype. The basic problem is that
-- (Eq a, Ord a)
-- looks so much like a tuple type. We can't tell until we find the =>
+--
+-- We have the t1 ~ t2 form here and in gentype, to permit an individual
+-- equational constraint without parenthesis.
context :: { LHsContext RdrName }
- : btype {% checkContext $1 }
+ : btype '~' btype {% checkContext
+ (LL $ HsPredTy (HsEqualP $1 $3)) }
+ | btype {% checkContext $1 }
type :: { LHsType RdrName }
: ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
: btype { $1 }
| btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
| btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
- | btype '->' ctype { LL $ HsFunTy $1 $3 }
+ | btype '->' ctype { LL $ HsFunTy $1 $3 }
+ | btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) }
btype :: { LHsType RdrName }
: btype atype { LL $ HsAppTy $1 $2 }
| scc_annot exp { LL $ if opt_SccProfilingOn
then HsSCC (unLoc $1) $2
else HsPar $2 }
+ | hpc_annot exp { LL $ if opt_Hpc
+ then HsTickPragma (unLoc $1) $2
+ else HsPar $2 }
| 'proc' aexp '->' exp
{% checkPattern $2 >>= \ p ->
: '_scc_' STRING { LL $ getSTRING $2 }
| '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
+hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
+ : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
+ { LL $ (getSTRING $2
+ ,( fromInteger $ getINTEGER $3
+ , fromInteger $ getINTEGER $5
+ )
+ ,( fromInteger $ getINTEGER $7
+ , fromInteger $ getINTEGER $9
+ )
+ )
+ }
+
fexp :: { LHsExpr RdrName }
: fexp aexp { LL $ HsApp $1 $2 }
| aexp { $1 }