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,
; 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
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}
-- 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 =
-- 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,
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)))
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 =
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
----------------------
-- 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.
-- 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 ()
= 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 ()
= 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}
projects / ghc-hetmet.git / blobdiff