X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=942ac2d0fee9ec73c8be9ef65f394790c8639113;hb=5e09d0886105fdfec4d7e8aaf2115b92ee18cfaa;hp=716a7a2c721940f12b0f847860f0ef4be80add87;hpb=7b9ccfe6947e4ef514057668d6f6673c3fedc10d;p=ghc-hetmet.git

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 716a7a2..942ac2d 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -166,10 +166,7 @@ rnExpr (NegApp e _)
     mkNegAppRn e' neg_name	`thenM` \ final_e ->
     returnM (final_e, fv_e `plusFV` fv_neg)
 
-rnExpr (HsPar e)
-  = rnLExpr e 		`thenM` \ (e', fvs_e) ->
-    returnM (HsPar e', fvs_e)
-
+------------------------------------------
 -- Template Haskell extensions
 -- Don't ifdef-GHCI them because we want to fail gracefully
 -- (not with an rnExpr crash) in a stage-1 compiler.
@@ -192,18 +189,27 @@ rnExpr (HsQuasiQuoteE qq)
     returnM (expr'', fvs_qq `plusFV` fvs_expr)
 #endif 	/* GHCI */
 
-rnExpr section@(SectionL expr op)
-  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
-    rnLExpr op	 		`thenM` \ (op', fvs_op) ->
-    checkSectionPrec InfixL section op' expr' `thenM_`
-    returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
+---------------------------------------------
+--	Sections
+-- See Note [Parsing sections] in Parser.y.pp
+rnExpr (HsPar (L loc (section@(SectionL {}))))
+  = do	{ (section', fvs) <- rnSection section
+	; return (HsPar (L loc section'), fvs) }
+
+rnExpr (HsPar (L loc (section@(SectionR {}))))
+  = do	{ (section', fvs) <- rnSection section
+	; return (HsPar (L loc section'), fvs) }
 
-rnExpr section@(SectionR op expr)
-  = rnLExpr op	 				`thenM` \ (op',   fvs_op) ->
-    rnLExpr expr	 				`thenM` \ (expr', fvs_expr) ->
-    checkSectionPrec InfixR section op' expr'	`thenM_`
-    returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
+rnExpr (HsPar e)
+  = do	{ (e', fvs_e) <- rnLExpr e
+	; return (HsPar e', fvs_e) }
 
+rnExpr expr@(SectionL {})
+  = do	{ addErr (sectionErr expr); rnSection expr }
+rnExpr expr@(SectionR {})
+  = do	{ addErr (sectionErr expr); rnSection expr }
+
+---------------------------------------------
 rnExpr (HsCoreAnn ann expr)
   = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
     returnM (HsCoreAnn ann expr', fvs_expr)
@@ -344,8 +350,24 @@ rnExpr (HsArrForm op fixity cmds)
 
 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
 	-- HsWrap
-\end{code}
 
+----------------------
+-- See Note [Parsing sections] in Parser.y.pp
+rnSection :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
+rnSection section@(SectionR op expr)
+  = do	{ (op', fvs_op)     <- rnLExpr op
+	; (expr', fvs_expr) <- rnLExpr expr
+	; checkSectionPrec InfixR section op' expr'
+	; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
+
+rnSection section@(SectionL expr op)
+  = do	{ (expr', fvs_expr) <- rnLExpr expr
+	; (op', fvs_op)     <- rnLExpr op
+	; checkSectionPrec InfixL section op' expr'
+	; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
+
+rnSection other = pprPanic "rnSection" (ppr other)
+\end{code}
 
 %************************************************************************
 %*									*
@@ -1198,6 +1220,11 @@ checkTransformStmt ctxt = addErr msg
     msg = ptext (sLit "Illegal transform or grouping in") <+> pprStmtContext ctxt
     
 ---------
+sectionErr :: HsExpr RdrName -> SDoc
+sectionErr expr
+  = hang (ptext (sLit "A section must be enclosed in parentheses"))
+       2 (ptext (sLit "thus:") <+> (parens (ppr expr)))
+
 patSynErr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
 patSynErr e = do { addErr (sep [ptext (sLit "Pattern syntax in expression context:"),
 			 	nest 4 (ppr e)])