X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=d9df620de9b15dca3eebe1baa600c6e8f9c53722;hb=0345a8378429e10e0c4feb7a6be2f9f132699b81;hp=67b2dca2694cc029789abe06e2b3d187cee64ed5;hpb=83256c875683894a93cf4468947ccf11c65577ca;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 67b2dca..d9df620 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -264,6 +264,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
@@ -314,6 +315,8 @@ incorrect.
  QCONID  	{ L _ (ITqconid   _) }
  QVARSYM 	{ L _ (ITqvarsym  _) }
  QCONSYM 	{ L _ (ITqconsym  _) }
+ PREFIXQVARSYM  { L _ (ITprefixqvarsym  _) }
+ PREFIXQCONSYM  { L _ (ITprefixqconsym  _) }
 
  IPDUPVARID   	{ L _ (ITdupipvarid   _) }		-- GHC extension
 
@@ -495,13 +498,17 @@ importdecls :: { [LImportDecl RdrName] }
 	| {- empty -}				{ [] }
 
 importdecl :: { LImportDecl RdrName }
-	: 'import' maybe_src optqualified modid maybeas maybeimpspec 
-		{ L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
+	: 'import' maybe_src optqualified maybe_pkg modid maybeas maybeimpspec 
+		{ L (comb4 $1 $5 $6 $7) (ImportDecl $5 $4 $2 $3 (unLoc $6) (unLoc $7)) }
 
 maybe_src :: { IsBootInterface }
 	: '{-# SOURCE' '#-}'			{ True }
 	| {- empty -}				{ False }
 
+maybe_pkg :: { Maybe FastString }
+        : STRING                                { Just (getSTRING $1) }
+        | {- empty -}                           { Nothing }
+
 optqualified :: { Bool }
       	: 'qualified'                           { True  }
       	| {- empty -}				{ False }
@@ -555,6 +562,7 @@ topdecl :: { OrdList (LHsDecl RdrName) }
     | '{-# DEPRECATED' deprecations '#-}' { $2 }
     | '{-# WARNING' warnings '#-}'        { $2 }
 	| '{-# RULES' rules '#-}'		{ $2 }
+	| annotation { unitOL $1 }
       	| decl					{ unLoc $1 }
 
 	-- Template Haskell Extension
@@ -920,6 +928,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
@@ -1735,6 +1750,7 @@ qtyconop :: { Located RdrName }	-- Qualified or unqualified
 
 qtycon :: { Located RdrName }	-- Qualified or unqualified
 	: QCONID			{ L1 $! mkQual tcClsName (getQCONID $1) }
+        | PREFIXQCONSYM                 { L1 $! mkQual tcClsName (getPREFIXQCONSYM $1) }
 	| tycon				{ $1 }
 
 tycon 	:: { Located RdrName }	-- Unqualified
@@ -1815,17 +1831,15 @@ qvar 	:: { Located RdrName }
 
 qvarid :: { Located RdrName }
 	: varid			{ $1 }
-	| QVARID		{ L1 $ mkQual varName (getQVARID $1) }
+	| QVARID		{ L1 $! mkQual varName (getQVARID $1) }
+        | PREFIXQVARSYM         { L1 $! mkQual varName (getPREFIXQVARSYM $1) }
 
 varid :: { Located RdrName }
-	: varid_no_unsafe 	{ $1 }
+	: VARID			{ L1 $! mkUnqual varName (getVARID $1) }
+	| special_id		{ L1 $! mkUnqual varName (unLoc $1) }
 	| 'unsafe'		{ L1 $! mkUnqual varName (fsLit "unsafe") }
 	| 'safe'		{ L1 $! mkUnqual varName (fsLit "safe") }
 	| 'threadsafe'		{ L1 $! mkUnqual varName (fsLit "threadsafe") }
-
-varid_no_unsafe :: { Located RdrName }
-	: VARID			{ L1 $! mkUnqual varName (getVARID $1) }
-	| special_id		{ L1 $! mkUnqual varName (unLoc $1) }
 	| 'forall'		{ L1 $! mkUnqual varName (fsLit "forall") }
 	| 'family'              { L1 $! mkUnqual varName (fsLit "family") }
 
@@ -1874,7 +1888,8 @@ special_sym : '!'	{ L1 (fsLit "!") }
 
 qconid :: { Located RdrName }	-- Qualified or unqualified
 	: conid			{ $1 }
-	| QCONID		{ L1 $ mkQual dataName (getQCONID $1) }
+	| QCONID		{ L1 $! mkQual dataName (getQCONID $1) }
+        | PREFIXQCONSYM         { L1 $! mkQual dataName (getPREFIXQCONSYM $1) }
 
 conid 	:: { Located RdrName }
 	: CONID			{ L1 $ mkUnqual dataName (getCONID $1) }
@@ -1983,6 +1998,8 @@ getQVARID  	(L _ (ITqvarid   x)) = x
 getQCONID  	(L _ (ITqconid   x)) = x
 getQVARSYM 	(L _ (ITqvarsym  x)) = x
 getQCONSYM 	(L _ (ITqconsym  x)) = x
+getPREFIXQVARSYM (L _ (ITprefixqvarsym  x)) = x
+getPREFIXQCONSYM (L _ (ITprefixqconsym  x)) = x
 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
 getCHAR		(L _ (ITchar     x)) = x
 getSTRING	(L _ (ITstring   x)) = x