X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=70d3f41b8e49a2852feb885b9944407f0baa6bd6;hb=032e31a4f05e6e8e560d113c73dca47c0c18df10;hp=8c96a5f11a488a6e1b0a32984c3b718ecc59b225;hpb=58de6cb725982dd1f57803cc838f233d5fd9c42c;p=ghc-hetmet.git diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 8c96a5f..70d3f41 100644 --- 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, @@ -563,18 +562,18 @@ rnBracket (VarBr n) = do { name <- lookupOccRn n ; return () } -- only way that is going to happen ; returnM (VarBr name, unitFV name) } where - msg = ptext SLIT("Need interface for Template Haskell quoted Name") + msg = ptext (sLit "Need interface for Template Haskell quoted Name") rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e ; return (ExpBr e', fvs) } -rnBracket (PatBr p) = do { addErr (ptext SLIT("Tempate Haskell pattern brackets are not supported yet")); +rnBracket (PatBr p) = do { addErr (ptext (sLit "Tempate Haskell pattern brackets are not supported yet")); failM } rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t ; return (TypBr t', fvs) } where - doc = ptext SLIT("In a Template-Haskell quoted type") + doc = ptext (sLit "In a Template-Haskell quoted type") rnBracket (DecBr group) = do { gbl_env <- getGblEnv @@ -815,7 +814,7 @@ rnParallelStmts ctxt segs thing_inside = do return (((seg':segs'), thing), delListFromNameSet fvs bndrs) cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2 - dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:") + dupErr vs = addErr (ptext (sLit "Duplicate binding in parallel list comprehension for:") <+> quotes (ppr (head vs))) \end{code} @@ -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, @@ -934,7 +932,7 @@ rn_rec_stmt_lhs fix_env (L loc (BindStmt pat expr a b)) fv_pat)] rn_rec_stmt_lhs fix_env (L loc (LetStmt binds@(HsIPBinds _))) - = do { addErr (badIpBinds (ptext SLIT("an mdo expression")) binds) + = do { addErr (badIpBinds (ptext (sLit "an mdo expression")) binds) ; failM } rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds))) @@ -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 = @@ -995,7 +992,7 @@ rn_rec_stmt all_bndrs (L loc (BindStmt pat' expr _ _)) fv_pat L loc (BindStmt pat' expr' bind_op fail_op))] rn_rec_stmt all_bndrs (L loc (LetStmt binds@(HsIPBinds _))) _ - = do { addErr (badIpBinds (ptext SLIT("an mdo expression")) binds) + = do { addErr (badIpBinds (ptext (sLit "an mdo expression")) binds) ; failM } rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do @@ -1155,7 +1152,7 @@ mkAssertErrorExpr ---------------------- -- Checking when a particular Stmt is ok checkLetStmt :: HsStmtContext Name -> HsLocalBinds RdrName -> RnM () -checkLetStmt (ParStmtCtxt _) (HsIPBinds binds) = addErr (badIpBinds (ptext SLIT("a parallel list comprehension:")) binds) +checkLetStmt (ParStmtCtxt _) (HsIPBinds binds) = addErr (badIpBinds (ptext (sLit "a parallel list comprehension:")) binds) checkLetStmt _ctxt _binds = return () -- We do not allow implicit-parameter bindings in a parallel -- list comprehension. I'm not sure what it might mean. @@ -1169,7 +1166,7 @@ checkRecStmt (DoExpr {}) = return () -- ..and in 'do' but only because of arrow -- so we leave it to the type checker checkRecStmt ctxt = addErr msg where - msg = ptext SLIT("Illegal 'rec' stmt in") <+> pprStmtContext ctxt + msg = ptext (sLit "Illegal 'rec' stmt in") <+> pprStmtContext ctxt --------- checkParStmt :: HsStmtContext Name -> RnM () @@ -1177,7 +1174,7 @@ checkParStmt ctxt = do { parallel_list_comp <- doptM Opt_ParallelListComp ; checkErr parallel_list_comp msg } where - msg = ptext SLIT("Illegal parallel list comprehension: use -XParallelListComp") + msg = ptext (sLit "Illegal parallel list comprehension: use -XParallelListComp") --------- checkTransformStmt :: HsStmtContext Name -> RnM () @@ -1186,19 +1183,19 @@ checkTransformStmt ListComp -- Ensure we are really within a list comprehension = do { transform_list_comp <- doptM Opt_TransformListComp ; checkErr transform_list_comp msg } where - msg = ptext SLIT("Illegal transform or grouping list comprehension: use -XTransformListComp") + msg = ptext (sLit "Illegal transform or grouping list comprehension: use -XTransformListComp") checkTransformStmt (ParStmtCtxt ctxt) = checkTransformStmt ctxt -- Ok to nest inside a parallel comprehension checkTransformStmt (TransformStmtCtxt ctxt) = checkTransformStmt ctxt -- Ok to nest inside a parallel comprehension checkTransformStmt ctxt = addErr msg where - msg = ptext SLIT("Illegal transform or grouping in") <+> pprStmtContext ctxt + msg = ptext (sLit "Illegal transform or grouping in") <+> pprStmtContext ctxt --------- -patSynErr e = do { addErr (sep [ptext SLIT("Pattern syntax in expression context:"), +patSynErr e = do { addErr (sep [ptext (sLit "Pattern syntax in expression context:"), nest 4 (ppr e)]) ; return (EWildPat, emptyFVs) } badIpBinds what binds - = hang (ptext SLIT("Implicit-parameter bindings illegal in") <+> what) + = hang (ptext (sLit "Implicit-parameter bindings illegal in") <+> what) 2 (ppr binds) \end{code}