Fix Trac #2188: scoping in TH declarations quotes

[ghc-hetmet.git] / compiler / rename / RnExpr.lhs

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 8c96a5f..71da0f1 100644 (file)
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -34,7 +34,6 @@ import HsSyn
 import TcRnMonad
 import RnEnv
 import HscTypes         ( availNames )
-import RnNames         ( getLocalDeclBinders, extendRdrEnvRn )
 import RnTypes         ( rnHsTypeFVs, 
                          mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
 import RnPat            (rnQuasiQuote, rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat,
@@ -886,22 +885,22 @@ rn_rec_stmts_and_then :: [LStmt RdrName]
                          -- the FreeVars of the Segments
                       -> ([Segment (LStmt Name)] -> RnM (a, FreeVars))
                       -> RnM (a, FreeVars)
-rn_rec_stmts_and_then s cont = do
-  -- (A) make the mini fixity env for all of the stmts
-  fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)
+rn_rec_stmts_and_then s cont
+  = do { -- (A) Make the mini fixity env for all of the stmts
+         fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)
 
-  -- (B) do the LHSes
-  new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s
+         -- (B) Do the LHSes
+       ; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s
 
-  --    bring them and their fixities into scope
-  let bound_names = map unLoc $ collectLStmtsBinders (map fst new_lhs_and_fv)
-  bindLocalNamesFV_WithFixities bound_names fix_env $ 
-    warnUnusedLocalBinds bound_names $ do
-
-  -- (C) do the right-hand-sides and thing-inside
-  segs <- rn_rec_stmts bound_names new_lhs_and_fv
-  cont segs
+         --    ...bring them and their fixities into scope
+       ; let bound_names = map unLoc $ collectLStmtsBinders (map fst new_lhs_and_fv)
+       ; bindLocalNamesFV_WithFixities bound_names fix_env $ do
 
+         -- (C) do the right-hand-sides and thing-inside
+       { segs <- rn_rec_stmts bound_names new_lhs_and_fv
+       ; (res, fvs) <- cont segs 
+       ; warnUnusedLocalBinds bound_names fvs
+       ; return (res, fvs) }}
 
 -- get all the fixity decls in any Let stmt
 collectRecStmtsFixities l = 
@@ -914,8 +913,7 @@ collectRecStmtsFixities l =
                              
 -- left-hand sides
 
-rn_rec_stmt_lhs :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
-                                           -- these fixities need to be brought into scope with the names
+rn_rec_stmt_lhs :: MiniFixityEnv
                 -> LStmt RdrName
                    -- rename LHS, and return its FVs
                    -- Warning: we will only need the FreeVars below in the case of a BindStmt,
@@ -956,8 +954,7 @@ rn_rec_stmt_lhs _ stmt@(L _ (TransformStmt _ _ _))  -- Syntactically illegal in m
 rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt _ _))   -- Syntactically illegal in mdo
   = pprPanic "rn_rec_stmt" (ppr stmt)
   
-rn_rec_stmts_lhs :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
-                                            -- these fixities need to be brought into scope with the names
+rn_rec_stmts_lhs :: MiniFixityEnv
                  -> [LStmt RdrName] 
                  -> RnM [(LStmtLR Name RdrName, FreeVars)]
 rn_rec_stmts_lhs fix_env stmts =