X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=98599498aeb210bb8417f27709cd7074f3a2aa5b;hp=a45ad87f0f0b6075cef117bd33d5adef10ea1136;hb=d2f11ea842a25bebd51d6c0c730a756c1d987e25;hpb=83d563cb9ede0ba792836e529b1e2929db926355

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a45ad87..9859949 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -8,15 +8,8 @@
 -- ---------------------------------------------------------------------------
 
 {
-{-# OPTIONS -Wwarn -w -XNoMonomorphismRestriction #-}
--- The NoMonomorphismRestriction deals with a Happy infelicity
---    With OutsideIn's more conservativ monomorphism restriction
---    we aren't generalising
---        notHappyAtAll = error "urk"
---    which is terrible.  Switching off the restriction allows
---    the generalisation.  Better would be to make Happy generate
---    an appropriate signature.
-
+{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
+{-# OPTIONS -Wwarn -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
@@ -1208,15 +1201,20 @@ docdecld :: { LDocDecl }
         | docsection                            { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
 
 decl 	:: { Located (OrdList (LHsDecl RdrName)) }
-	: sigdecl			{ $1 }
-	| '!' aexp rhs			{% do { pat <- checkPattern $2;
-					        return (LL $ unitOL $ LL $ ValD ( 
-							PatBind (LL $ BangPat pat) (unLoc $3)
-								placeHolderType placeHolderNames)) } }
-        | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 $3;
-                                                let { l = comb2 $1 $> };
-                                                return $! (sL l (unitOL $! (sL l $ ValD r))) } }
-        | docdecl                       { LL $ unitOL $1 }
+	: sigdecl		{ $1 }
+
+        | '!' aexp rhs          {% do { let { e = LL (SectionR (LL (HsVar bang_RDR)) $2) };
+                                        pat <- checkPattern e;
+                                        return $ LL $ unitOL $ LL $ ValD $
+                                               PatBind pat (unLoc $3)
+                                                       placeHolderType placeHolderNames } }
+                                -- Turn it all into an expression so that
+                                -- checkPattern can check that bangs are enabled
+
+        | infixexp opt_sig rhs  {% do { r <- checkValDef $1 $2 $3;
+                                        let { l = comb2 $1 $> };
+                                        return $! (sL l (unitOL $! (sL l $ ValD r))) } }
+        | docdecl               { LL $ unitOL $1 }
 
 rhs	:: { Located (GRHSs RdrName) }
 	: '=' exp wherebinds	{ sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
@@ -1277,7 +1275,7 @@ exp10 :: { LHsExpr RdrName }
   	| 'let' binds 'in' exp			{ LL $ HsLet (unLoc $2) $4 }
 	| 'if' exp optSemi 'then' exp optSemi 'else' exp
                                         {% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
-                                           return (LL $ HsIf $2 $5 $8) }
+                                           return (LL $ mkHsIf $2 $5 $8) }
    	| 'case' exp 'of' altslist		{ LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
 	| '-' fexp				{ LL $ NegApp $2 noSyntaxExpr }
 
@@ -1358,8 +1356,8 @@ aexp2	:: { LHsExpr RdrName }
 	| 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 -))')
+        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
+        -- correct Haskell (you'd have to write '((+ 3), (4 -))')
         -- but the less cluttered version fell out of having texps.
 	| '(' texp ')'			{ LL (HsPar $2) }
 	| '(' tup_exprs ')'             { LL (ExplicitTuple $2 Boxed) }
@@ -1419,8 +1417,8 @@ texp :: { LHsExpr RdrName }
 	-- Note [Parsing sections]
 	-- ~~~~~~~~~~~~~~~~~~~~~~~
 	-- We include left and right sections here, which isn't
-	-- technically right according to Haskell 98.  For example
-	--	(3 +, True) isn't legal
+	-- technically right according to the Haskell standard.
+        -- For example (3 +, True) isn't legal.
 	-- However, we want to parse bang patterns like
 	--	(!x, !y)
 	-- and it's convenient to do so here as a section