X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=01d768a4d7a1d4485108b15bd01ed69a569bd70b;hp=1f459e5c8702753191fdeb673a9fa27ea3ba5165;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=fed25228aec3f3bd2f91c50d67043d83efb1af18

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 1f459e5..01d768a 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -41,9 +41,7 @@ import ForeignCall	( Safety(..), CExportSpec(..), CLabelString,
 			)
 import OccName		( varName, dataName, tcClsName, tvName )
 import DataCon		( DataCon, dataConName )
-import SrcLoc		( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
-			  SrcSpan, combineLocs, srcLocFile, 
-			  mkSrcLoc, mkSrcSpan )
+import SrcLoc
 import Module
 import StaticFlags	( opt_SccProfilingOn, opt_Hpc )
 import Type		( Kind, liftedTypeKind, unliftedTypeKind )
@@ -1262,7 +1260,7 @@ quasiquote :: { Located (HsQuasiQuote RdrName) }
 	: TH_QUASIQUOTE   { let { loc = getLoc $1
                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
                                 ; quoterId = mkUnqual varName quoter }
-                            in L1 (mkHsQuasiQuote quoterId quoteSpan quote) }
+                            in L1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
 exp   :: { LHsExpr RdrName }
 	: infixexp '::' sigtype		{ LL $ ExprWithTySig $1 $3 }
@@ -1288,14 +1286,9 @@ exp10 :: { LHsExpr RdrName }
    	| 'case' exp 'of' altslist		{ LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
 	| '-' fexp				{ LL $ NegApp $2 noSyntaxExpr }
 
-  	| 'do' stmtlist			{% let loc = comb2 $1 $2 in
-					   checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-					   return (L loc (mkHsDo DoExpr stmts body)) }
-  	| 'mdo' stmtlist		{% let loc = comb2 $1 $2 in
-					   checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-                                           return (L loc (mkHsDo MDoExpr
-                                                                 [L loc (mkRecStmt stmts)]
-                                                                 body)) }
+  	| 'do' stmtlist			{ L (comb2 $1 $2) (mkHsDo DoExpr  (unLoc $2)) }
+  	| 'mdo' stmtlist		{ L (comb2 $1 $2) (mkHsDo MDoExpr (unLoc $2)) }
+
         | scc_annot exp		    		{ LL $ if opt_SccProfilingOn
 							then HsSCC (unLoc $1) $2
 							else HsPar $2 }
@@ -1470,7 +1463,10 @@ list :: { LHsExpr RdrName }
 	| texp ',' exp '..' 	{ LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
 	| texp '..' exp	 	{ LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
 	| texp ',' exp '..' exp	{ LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-	| texp '|' flattenedpquals	{ sL (comb2 $1 $>) $ mkHsDo ListComp (unLoc $3) $1 }
+	| texp '|' flattenedpquals	
+             {% checkMonadComp >>= \ ctxt ->
+		return (sL (comb2 $1 $>) $ 
+                        mkHsComp ctxt (unLoc $3) $1) }
 
 lexps :: { Located [LHsExpr RdrName] }
 	: lexps ',' texp 		{ LL (((:) $! $3) $! unLoc $1) }
@@ -1485,7 +1481,7 @@ flattenedpquals :: { Located [LStmt RdrName] }
                     -- We just had one thing in our "parallel" list so 
                     -- we simply return that thing directly
                     
-                    qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss]]
+                    qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss] noSyntaxExpr noSyntaxExpr noSyntaxExpr]
                     -- We actually found some actual parallel lists so
                     -- we wrap them into as a ParStmt
                 }
@@ -1506,8 +1502,7 @@ squals :: { Located [LStmt RdrName] }	-- In reverse order, because the last
 
 -- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |}
 -- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user
--- demand. Note that the {| |} symbols are reused from -XGenerics and hence if you want to compile
--- a program that makes use of this temporary syntax you must supply that flag to GHC
+-- demand.
 
 transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
 			-- Function is applied to a list of stmts *in order*
@@ -1542,7 +1537,7 @@ parr :: { LHsExpr RdrName }
 						       (reverse (unLoc $1)) }
 	| texp '..' exp	 		{ LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
 	| texp ',' exp '..' exp		{ LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-	| texp '|' flattenedpquals	{ LL $ mkHsDo PArrComp (unLoc $3) $1 }
+	| texp '|' flattenedpquals	{ LL $ mkHsComp PArrComp (unLoc $3) $1 }
 
 -- We are reusing `lexps' and `flattenedpquals' from the list case.