X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=109fd8be479fc091856b777a2f8dbcd636e8f4f3;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hp=4567e072b3919e64d13a739e6500de97df49e926;hpb=914e7d90e2afe1f72b72fb41d293fb56bd35edb5;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 4567e07..109fd8b 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 )
@@ -344,6 +352,7 @@ identifier :: { Located RdrName }
 	| qcon				{ $1 }
 	| qvarop			{ $1 }
 	| qconop			{ $1 }
+    | '(' '->' ')'      { LL $ getRdrName funTyCon }
 
 -----------------------------------------------------------------------------
 -- Module Header
@@ -962,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 }
 	
@@ -1295,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)) }
@@ -1317,7 +1327,7 @@ fexp 	:: { LHsExpr RdrName }
 aexp	:: { LHsExpr RdrName }
 	: qvar '@' aexp			{ LL $ EAsPat $1 $3 }
 	| '~' aexp			{ LL $ ELazyPat $2 }
-	| aexp1				{ $1 }
+	| aexp1			{ $1 }
 
 aexp1	:: { LHsExpr RdrName }
         : aexp1 '{' fbinds '}' 	{% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3
@@ -1338,16 +1348,18 @@ aexp2	:: { LHsExpr RdrName }
 	| literal			{ L1 (HsLit   $! unLoc $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
---	| STRING			{ L1 (HsOverLit $! mkHsIsString (getSTRING $1)) }
-	| INTEGER			{ L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
-	| RATIONAL			{ L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
-	| '(' exp ')'			{ LL (HsPar $2) }
+--	| STRING			{ sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) }
+	| INTEGER			{ sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) }
+	| RATIONAL			{ sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
+        -- N.B.: sections get parsed by these next two productions.
+        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
+        -- (you'd have to write '((+ 3), (4 -))')
+        -- but the less cluttered version fell out of having texps.
+	| '(' texp ')'			{ LL (HsPar $2) }
 	| '(' texp ',' texps ')'	{ LL $ ExplicitTuple ($2 : reverse $4) Boxed }
 	| '(#' texps '#)'		{ LL $ ExplicitTuple (reverse $2)      Unboxed }
 	| '[' list ']'                  { LL (unLoc $2) }
 	| '[:' parr ':]'                { LL (unLoc $2) }
-	| '(' infixexp qop ')'		{ LL $ SectionL $2 $3 }
-	| '(' qopm infixexp ')'		{ LL $ SectionR $2 $3 }
 	| '_'				{ L1 EWildPat }
 	
 	-- Template Haskell Extension
@@ -1385,11 +1397,17 @@ cvtopdecls0 :: { [LHsDecl RdrName] }
 	: {- empty -}		{ [] }
 	| cvtopdecls		{ $1 }
 
+-- tuple expressions: things that can appear unparenthesized as long as they're
+-- inside parens or delimitted by commas
 texp :: { LHsExpr RdrName }
 	: exp				{ $1 }
-	| qopm infixexp			{ LL $ SectionR $1 $2 }
-	-- The second production is really here only for bang patterns
-	-- but 
+	-- Technically, this should only be used for bang patterns,
+       -- but we can be a little more liberal here and avoid parens
+       -- inside tuples
+       | infixexp qop 	{ LL $ SectionL $1 $2 }
+	| qopm infixexp       { LL $ SectionR $1 $2 }
+       -- view patterns get parenthesized above
+	| exp '->' exp   { LL $ EViewPat $1 $3 }
 
 texps :: { [LHsExpr RdrName] }
 	: texps ',' texp		{ $3 : $1 }
@@ -1849,7 +1867,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