X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=d91143f3335e91ce5644d19dc6ad986c1e830534;hb=5ccedd80f734c4e2d3789f399880b589dec8c70e;hp=b31e0250852368133f4f0655eb21c38a4625ef21;hpb=bb511e2deeb63e4b1a92b033283cd63de3e5a27c;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index b31e025..d91143f 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -8,6 +8,13 @@
 -- ---------------------------------------------------------------------------
 
 {
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
 		parseHeader ) where
 
@@ -35,6 +42,7 @@ import StaticFlags	( opt_SccProfilingOn, opt_Hpc )
 import Type		( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
 import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
 			  Activation(..), defaultInlineSpec )
+import DynFlags
 import OrdList
 import HaddockParse
 import {-# SOURCE #-} HaddockLex hiding ( Token )
@@ -200,7 +208,6 @@ incorrect.
  'data' 	{ L _ ITdata } 
  'default' 	{ L _ ITdefault }
  'deriving' 	{ L _ ITderiving }
- 'derive' 	{ L _ ITderive }
  'do' 		{ L _ ITdo }
  'else' 	{ L _ ITelse }
  'hiding' 	{ L _ IThiding }
@@ -345,6 +352,7 @@ identifier :: { Located RdrName }
 	| qcon				{ $1 }
 	| qvarop			{ $1 }
 	| qconop			{ $1 }
+    | '(' '->' ')'      { LL $ getRdrName funTyCon }
 
 -----------------------------------------------------------------------------
 -- Module Header
@@ -754,7 +762,7 @@ tycl_hdr :: { Located (LHsContext RdrName,
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-  	: 'derive' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
+  	: 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
 
 -----------------------------------------------------------------------------
 -- Nested declarations
@@ -963,7 +971,7 @@ gentypedoc :: { LHsType RdrName }
 
 ctypedoc  :: { LHsType RdrName }
         : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
-        | context '=>' gentypedoc        { LL $ mkImplicitHsForAllTy   $1 $3 }
+        | context '=>' ctypedoc          { LL $ mkImplicitHsForAllTy   $1 $3 }
 	-- A type of form (context => type) is an *implicit* HsForAllTy
 	| gentypedoc			 { $1 }
 	
@@ -1296,7 +1304,8 @@ exp10 :: { LHsExpr RdrName }
 	| fexp					{ $1 }
 
 scc_annot :: { Located FastString }
-	: '_scc_' STRING			{ LL $ getSTRING $2 }
+	: '_scc_' STRING			{% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
+                                   (return $ LL $ getSTRING $2) }
 	| '{-# SCC' STRING '#-}'		{ LL $ getSTRING $2 }
 
 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
@@ -1534,9 +1543,6 @@ maybe_stmt :: { Maybe (LStmt RdrName) }
 
 stmt  :: { LStmt RdrName }
 	: qual				{ $1 }
--- What is this next production doing?  I have no clue!  SLPJ Dec06
-	| infixexp '->' exp		{% checkPattern $3 >>= \p ->
-					   return (LL $ mkBindStmt p $1) }
   	| 'rec' stmtlist		{ LL $ mkRecStmt (unLoc $2) }
 
 qual  :: { LStmt RdrName }
@@ -1759,7 +1765,6 @@ special_id
 	: 'as'			{ L1 FSLIT("as") }
 	| 'qualified'		{ L1 FSLIT("qualified") }
 	| 'hiding'		{ L1 FSLIT("hiding") }
-	| 'derive'		{ L1 FSLIT("derive") }
 	| 'export'		{ L1 FSLIT("export") }
 	| 'label'		{ L1 FSLIT("label")  }
 	| 'dynamic'		{ L1 FSLIT("dynamic") }
@@ -1854,7 +1859,7 @@ docsection :: { Located (n, HsDoc RdrName) }
       Right doc -> return (L1 (n, doc)) } }
 
 docoptions :: { String }
-  : DOCOPTIONS { getDOCOPTIONS $1 }
+  : DOCOPTIONS '#-}' { getDOCOPTIONS $1 }
 
 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }                                    
         : DOCNEXT {% let string = getDOCNEXT $1 in