X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=5fbbcad4549d65c296dfb1d9c489c58beb3286c2;hp=2f1166d420c7e3c24c626dd28c6ae9700857c3a4;hb=4bc25e8c30559b7a6a87b39afcc79340ae778788;hpb=abc32aba7135136c89e089296e296fbb380bda39

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 2f1166d..5fbbcad 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -47,7 +47,7 @@ import Module
 import StaticFlags	( opt_SccProfilingOn, opt_Hpc )
 import Type		( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
 import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
-			  Activation(..), defaultInlineSpec )
+			  Activation(..), RuleMatchInfo(..), defaultInlineSpec )
 import DynFlags
 import OrdList
 import HaddockParse
@@ -254,6 +254,7 @@ incorrect.
  'using'    { L _ ITusing }     -- for list transform extension
 
  '{-# INLINE'      	  { L _ (ITinline_prag _) }
+ '{-# INLINE_CONLIKE'     { L _ (ITinline_conlike_prag _) }
  '{-# SPECIALISE'  	  { L _ ITspec_prag }
  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
  '{-# SOURCE'	   { L _ ITsource_prag }
@@ -264,6 +265,7 @@ incorrect.
  '{-# DEPRECATED'  { L _ ITdeprecated_prag }
  '{-# WARNING'  { L _ ITwarning_prag }
  '{-# UNPACK'      { L _ ITunpack_prag }
+ '{-# ANN'      { L _ ITann_prag }
  '#-}'		   { L _ ITclose_prag }
 
  '..'		{ L _ ITdotdot }  			-- reserved symbols
@@ -561,6 +563,7 @@ topdecl :: { OrdList (LHsDecl RdrName) }
     | '{-# DEPRECATED' deprecations '#-}' { $2 }
     | '{-# WARNING' warnings '#-}'        { $2 }
 	| '{-# RULES' rules '#-}'		{ $2 }
+	| annotation { unitOL $1 }
       	| decl					{ unLoc $1 }
 
 	-- Template Haskell Extension
@@ -926,6 +929,13 @@ deprecation :: { OrdList (LHsDecl RdrName) }
 		{ toOL [ LL $ WarningD (Warning n (DeprecatedTxt (getSTRING $2)))
 		       | n <- unLoc $1 ] }
 
+-----------------------------------------------------------------------------
+-- Annotations
+annotation :: { LHsDecl RdrName }
+    : '{-# ANN' name_var aexp '#-}'      { LL (AnnD $ HsAnnotation (ValueAnnProvenance (unLoc $2)) $3) }
+    | '{-# ANN' 'type' tycon aexp '#-}'  { LL (AnnD $ HsAnnotation (TypeAnnProvenance (unLoc $3)) $4) }
+    | '{-# ANN' 'module' aexp '#-}'      { LL (AnnD $ HsAnnotation ModuleAnnProvenance $3) }
+
 
 -----------------------------------------------------------------------------
 -- Foreign import and export declarations
@@ -1278,12 +1288,14 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 	| infix prec ops	{ LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
 					     | n <- unLoc $3 ] }
 	| '{-# INLINE'   activation qvar '#-}'	      
-				{ LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
+				{ LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 FunLike (getINLINE $1)))) }
+        | '{-# INLINE_CONLIKE' activation qvar '#-}'
+                                { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 ConLike (getINLINE_CONLIKE $1)))) }
 	| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
 			 	{ LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec) 
 					    | t <- $4] }
 	| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
-			 	{ LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
+			 	{ LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 FunLike (getSPEC_INLINE $1)))
 					    | t <- $5] }
 	| '{-# SPECIALISE' 'instance' inst_type '#-}'
 				{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
@@ -2004,6 +2016,7 @@ getPRIMFLOAT	(L _ (ITprimfloat  x)) = x
 getPRIMDOUBLE	(L _ (ITprimdouble x)) = x
 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
 getINLINE	(L _ (ITinline_prag b)) = b
+getINLINE_CONLIKE (L _ (ITinline_conlike_prag b)) = b
 getSPEC_INLINE	(L _ (ITspec_inline_prag b)) = b
 
 getDOCNEXT (L _ (ITdocCommentNext x)) = x