import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
makeMiniFixityEnv)
-import RnEnv ( lookupLocalDataTcNames,
- lookupLocatedTopBndrRn, lookupLocatedOccRn,
+import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
+ lookupTopBndrRn, lookupLocatedTopBndrRn,
lookupOccRn, newLocalsRn,
bindLocatedLocalsFV, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalNames, checkDupRdrNames, mapFvRn,
+ checkM
)
import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
-import HscTypes ( GenAvailInfo(..) )
+import HscTypes ( GenAvailInfo(..), availsToNameSet )
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad
import Outputable
import Bag
import FastString
-import SrcLoc ( Located(..), unLoc, noLoc )
+import SrcLoc
import DynFlags ( DynFlag(..) )
import Maybe ( isNothing )
import BasicTypes ( Boxity(..) )
import ListSetOps (findDupsEq)
+import List
import Control.Monad
\end{code}
thenM_ :: Monad a => a b -> a c -> a c
thenM_ = (>>)
-
-returnM :: Monad m => a -> m a
-returnM = return
-
-mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
-mappM = mapM
-
-mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
-mappM_ = mapM_
-
-checkM :: Monad m => Bool -> m () -> m ()
-checkM = unless
\end{code}
@rnSourceDecl@ `renames' declarations.
\begin{code}
-- Brings the binders of the group into scope in the appropriate places;
-- does NOT assume that anything is in scope already
---
--- The Bool determines whether (True) names in the group shadow existing
--- Unquals in the global environment (used in Template Haskell) or
--- (False) whether duplicates are reported as an error
-rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-
-rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
+rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
+-- Rename a HsGroup; used for normal source files *and* hs-boot files
+rnSrcDecls group@(HsGroup {hs_valds = val_decls,
hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_derivds = deriv_decls,
hs_fixds = fix_decls,
hs_warnds = warn_decls,
+ hs_annds = ann_decls,
hs_fords = foreign_decls,
hs_defds = default_decls,
hs_ruleds = rule_decls,
-- (B) Bring top level binders (and their fixities) into scope,
-- *except* for the value bindings, which get brought in below.
- avails <- getLocalNonValBinders group ;
- tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
+ -- However *do* include class ops, data constructors
+ -- And for hs-boot files *do* include the value signatures
+ tc_avails <- getLocalNonValBinders group ;
+ tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
setEnvs tc_envs $ do {
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
-- extend the record field env.
-- This depends on the data constructors and field names being in
-- scope from (B) above
- inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
+ inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
-- (D) Rename the left-hand sides of the value bindings.
-- This depends on everything from (B) being in scope,
-- It uses the fixity env from (A) to bind fixities for view patterns.
new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
-- bind the LHSes (and their fixities) in the global rdr environment
- let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
- lhs_avails = map Avail lhs_binders
+ let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
+ val_bndr_set = mkNameSet val_binders ;
+ all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
+ val_avails = map Avail val_binders
} ;
- (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
+ (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
setEnvs (tcg_env, tcl_env) $ do {
-- Now everything is in scope, as the remaining renaming assumes.
-- (F) Rename Value declarations right-hand sides
traceRn (text "Start rnmono") ;
- (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
+ (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
-- (G) Rename Fixity and deprecations
- -- rename fixity declarations and error if we try to
+ -- Rename fixity declarations and error if we try to
-- fix something from another module (duplicates were checked in (A))
- rn_fix_decls <- rnSrcFixityDecls fix_decls ;
- -- rename deprec decls;
+ rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
+
+ -- Rename deprec decls;
-- check for duplicates and ensure that deprecated things are defined locally
-- at the moment, we don't keep these around past renaming
- rn_warns <- rnSrcWarnDecls warn_decls ;
+ rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
-- (H) Rename Everything else
rnList rnHsRuleDecl rule_decls ;
-- Inside RULES, scoped type variables are on
(rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
- (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
- (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
+ (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
+ (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
+ (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
-- Haddock docs; no free vars
rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
hs_warnds = [], -- warns are returned in the tcg_env
-- (see below) not in the HsGroup
hs_fords = rn_foreign_decls,
+ hs_annds = rn_ann_decls,
hs_defds = rn_default_decls,
hs_ruleds = rn_rule_decls,
hs_docs = rn_docs } ;
- other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
- src_fvs4, src_fvs5] ;
+ other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
+ src_fvs5, src_fvs6, src_fvs7] ;
src_dus = bind_dus `plusDU` usesOnly other_fvs;
-- Note: src_dus will contain *uses* for locally-defined types
-- and classes, but no *defs* for them. (Because rnTyClDecl
%*********************************************************
\begin{code}
-rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
+rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
-- Rename the fixity decls, so we can put
-- the renamed decls in the renamed syntax tree
-- Errors if the thing being fixed is not defined locally.
--
-- The returned FixitySigs are not actually used for anything,
-- except perhaps the GHCi API
-rnSrcFixityDecls fix_decls
+rnSrcFixityDecls bound_names fix_decls
= do fix_decls <- mapM rn_decl fix_decls
return (concat fix_decls)
where
rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
= setSrcSpan name_loc $
-- this lookup will fail if the definition isn't local
- do names <- lookupLocalDataTcNames rdr_name
+ do names <- lookupLocalDataTcNames bound_names what rdr_name
return [ L loc (FixitySig (L name_loc name) fixity)
- | name <- names ]
+ | name <- names ]
+ what = ptext (sLit "fixity signature")
\end{code}
\begin{code}
-- checks that the deprecations are defined locally, and that there are no duplicates
-rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings
-rnSrcWarnDecls []
- = returnM NoWarnings
+rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
+rnSrcWarnDecls _bound_names []
+ = return NoWarnings
-rnSrcWarnDecls decls
+rnSrcWarnDecls bound_names decls
= do { -- check for duplicates
- ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
- ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
- returnM (WarnSome ((concat pairs_s))) }
+ ; mapM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
+ ; mapM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
+ return (WarnSome ((concat pairs_s))) }
where
rn_deprec (Warning rdr_name txt)
-- ensures that the names are defined locally
- = lookupLocalDataTcNames rdr_name `thenM` \ names ->
- returnM [(nameOccName name, txt) | name <- names]
+ = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
+ return [(nameOccName name, txt) | name <- names]
+ what = ptext (sLit "deprecation")
+
-- look for duplicates among the OccNames;
-- we check that the names are defined above
-- invt: the lists returned by findDupsEq always have at least two elements
%*********************************************************
%* *
-\subsection{Source code declarations}
+\subsection{Annotation declarations}
+%* *
+%*********************************************************
+
+\begin{code}
+rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
+rnAnnDecl (HsAnnotation provenance expr) = do
+ (provenance', provenance_fvs) <- rnAnnProvenance provenance
+ (expr', expr_fvs) <- rnLExpr expr
+ return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
+
+rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
+rnAnnProvenance provenance = do
+ provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
+ return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Default declarations}
%* *
%*********************************************************
rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
rnDefaultDecl (DefaultDecl tys)
= mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
- returnM (DefaultDecl tys', fvs)
+ return (DefaultDecl tys', fvs)
where
doc_str = text "In a `default' declaration"
\end{code}
rnHsForeignDecl (ForeignImport name ty spec)
= lookupLocatedTopBndrRn name `thenM` \ name' ->
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
- returnM (ForeignImport name' ty' spec, fvs)
+ return (ForeignImport name' ty' spec, fvs)
rnHsForeignDecl (ForeignExport name ty spec)
= lookupLocatedOccRn name `thenM` \ name' ->
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
- returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
+ return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
-- NB: a foreign export is an *occurrence site* for name, so
-- we add it to the free-variable list. It might, for example,
-- be imported from another module
bindLocalNames binders
(renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
- returnM (InstDecl inst_ty' mbinds' uprags' ats',
+ return (InstDecl inst_ty' mbinds' uprags' ats',
meth_fvs `plusFV` at_fvs
`plusFV` hsSigsFVs uprags'
`plusFV` extractHsTyNames inst_ty')
get_var (RuleBndrSig v _) = v
rn_var (RuleBndr (L loc _), id)
- = returnM (RuleBndr (L loc id), emptyFVs)
+ = return (RuleBndr (L loc id), emptyFVs)
rn_var (RuleBndrSig (L loc _) t, id)
= rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
- returnM (RuleBndrSig (L loc id) t', fvs)
+ return (RuleBndrSig (L loc id) t', fvs)
badRuleVar :: FastString -> Name -> SDoc
badRuleVar name var
rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
= lookupLocatedTopBndrRn name `thenM` \ name' ->
- returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
+ return (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
emptyFVs)
-- all flavours of type family declarations ("type family", "newtype fanily",
| is_vanilla -- Normal Haskell data type decl
= ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
-- data type is syntactically illegal
- bindTyVarsRn data_doc tyvars $ \ tyvars' ->
- do { tycon' <- if isFamInstDecl tydecl
+ do { tyvars <- pruneTyVars tydecl
+ ; bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
+ { tycon' <- if isFamInstDecl tydecl
then lookupLocatedOccRn tycon -- may be imported family
else lookupLocatedTopBndrRn tycon
; context' <- rnContext data_doc context
; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls
-- since that is done by RnNames.extendGlobalRdrEnvRn
- ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
+ ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = typats', tcdKindSig = Nothing,
tcdCons = condecls', tcdDerivs = derivs'},
(if isFamInstDecl tydecl
then unitFV (unLoc tycon') -- type instance => use
else emptyFVs))
- }
+ } }
| otherwise -- GADT
- = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
- do { tycon' <- if isFamInstDecl tydecl
+ = do { tycon' <- if isFamInstDecl tydecl
then lookupLocatedOccRn tycon -- may be imported family
else lookupLocatedTopBndrRn tycon
; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
- ; tyvars' <- bindTyVarsRn data_doc tyvars
- (\ tyvars' -> return tyvars')
+ ; (tyvars', typats')
+ <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
+ { typats' <- rnTyPats data_doc typatsMaybe
+ ; return (tyvars', typats') }
-- For GADTs, the type variables in the declaration
-- do not scope over the constructor signatures
-- data T a where { T1 :: forall b. b-> b }
+
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls
-- since that is done by RnNames.extendGlobalRdrEnvRn
- ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
+
+ ; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
tcdLName = tycon', tcdTyVars = tyvars',
- tcdTyPats = Nothing, tcdKindSig = sig,
+ tcdTyPats = typats', tcdKindSig = sig,
tcdCons = condecls', tcdDerivs = derivs'},
plusFVs (map conDeclFVs condecls') `plusFV`
deriv_fvs `plusFV`
L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
_ -> False
- none Nothing = True
- none (Just []) = True
- none _ = False
-
data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
- rn_derivs Nothing = returnM (Nothing, emptyFVs)
+ rn_derivs Nothing = return (Nothing, emptyFVs)
rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
- returnM (Just ds', extractHsTyNames_s ds')
+ return (Just ds', extractHsTyNames_s ds')
-- "type" and "type instance" declarations
-rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
+rnTyClDecl tydecl@(TySynonym {tcdLName = name,
tcdTyPats = typatsMaybe, tcdSynRhs = ty})
- = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
- do { name' <- if isFamInstDecl tydecl
+ = do { tyvars <- pruneTyVars tydecl
+ ; bindTyVarsRn syn_doc tyvars $ \ tyvars' -> do
+ { name' <- if isFamInstDecl tydecl
then lookupLocatedOccRn name -- may be imported family
else lookupLocatedTopBndrRn name
; typats' <- rnTyPats syn_doc typatsMaybe
; (ty', fvs) <- rnHsTypeFVs syn_doc ty
- ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
+ ; return (TySynonym {tcdLName = name', tcdTyVars = tyvars',
tcdTyPats = typats', tcdSynRhs = ty'},
delFVs (map hsLTyVarName tyvars') $
fvs `plusFV`
(if isFamInstDecl tydecl
then unitFV (unLoc name') -- type instance => use
else emptyFVs))
- }
+ } }
where
syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
%*********************************************************
\begin{code}
+-- Remove any duplicate type variables in family instances may have non-linear
+-- left-hand sides. Complain if any, but the first occurence of a type
+-- variable has a user-supplied kind signature.
+--
+pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
+pruneTyVars tydecl
+ | isFamInstDecl tydecl
+ = do { let pruned_tyvars = nubBy eqLTyVar tyvars
+ ; assertNoSigsInRepeats tyvars
+ ; return pruned_tyvars
+ }
+ | otherwise
+ = return tyvars
+ where
+ tyvars = tcdTyVars tydecl
+
+ assertNoSigsInRepeats [] = return ()
+ assertNoSigsInRepeats (tv:tvs)
+ = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
+ , tv' `eqLTyVar` tv]
+ ; checkErr (null offending_tvs) $
+ illegalKindSig (head offending_tvs)
+ ; assertNoSigsInRepeats tvs
+ }
+
+ illegalKindSig tv
+ = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
+ ptext (sLit "kind signature:"), quotes (ppr tv)]
+
+ tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
+
-- Although, we are processing type patterns here, all type variables will
-- already be in scope (they are the same as in the 'tcdTyVars' field of the
-- type declaration to which these patterns belong)
rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
rnConDecls _tycon condecls
- = mappM (wrapLocM rnConDecl) condecls
+ = mapM (wrapLocM rnConDecl) condecls
rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
-> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
-> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
rnConDeclDetails doc (PrefixCon tys)
- = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
- returnM (PrefixCon new_tys)
+ = mapM (rnLHsType doc) tys `thenM` \ new_tys ->
+ return (PrefixCon new_tys)
rnConDeclDetails doc (InfixCon ty1 ty2)
= rnLHsType doc ty1 `thenM` \ new_ty1 ->
rnLHsType doc ty2 `thenM` \ new_ty2 ->
- returnM (InfixCon new_ty1 new_ty2)
+ return (InfixCon new_ty1 new_ty2)
rnConDeclDetails doc (RecCon fields)
- = do { new_fields <- mappM (rnField doc) fields
+ = do { new_fields <- mapM (rnField doc) fields
-- No need to check for duplicate fields
-- since that is done by RnNames.extendGlobalRdrEnvRn
; return (RecCon new_fields) }
= lookupLocatedTopBndrRn name `thenM` \ new_name ->
rnLHsType doc ty `thenM` \ new_ty ->
rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
- returnM (ConDeclField new_name new_ty new_haddock_doc)
+ return (ConDeclField new_name new_ty new_haddock_doc)
-- Rename family declarations
--
|| not (null tyvars)) $ addErr needOneIdx -- no. of indexes >= 1
; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
; tycon' <- lookupLocatedTopBndrRn tycon
- ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
+ ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
emptyFVs)
} }
lookupIdxVars _ tyvars cont =
do { checkForDups tyvars;
- ; tyvars' <- mappM lookupIdxVar tyvars
+ ; tyvars' <- mapM lookupIdxVar tyvars
; cont tyvars'
}
-- Type index variables must be class parameters, which are the only
Get the mapping from constructors to fields for this module.
It's convenient to do this after the data type decls have been renamed
\begin{code}
-extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
-extendRecordFieldEnv decls
+extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
+extendRecordFieldEnv tycl_decls inst_decls
= do { tcg_env <- getGblEnv
- ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
+ ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
; return (tcg_env { tcg_field_env = field_env' }) }
where
-- we want to lookup:
lookup x = do { x' <- lookupLocatedTopBndrRn x
; return $ unLoc x'}
- get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
- get _ env = return env
+ all_data_cons :: [ConDecl RdrName]
+ all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
+ , L _ con <- cons ]
+ all_tycl_decls = at_tycl_decls ++ tycl_decls
+ at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
+ -- Do not forget associated types!
- get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
+ get_con (ConDecl { con_name = con, con_details = RecCon flds })
+ (RecFields env fld_set)
= do { con' <- lookup con
- ; flds' <- mappM lookup (map cd_fld_name flds)
- ; return $ extendNameEnv env con' flds' }
- get_con _ env
- = return env
+ ; flds' <- mapM lookup (map cd_fld_name flds)
+ ; let env' = extendNameEnv env con' flds'
+ fld_set' = addListToNameSet fld_set flds'
+ ; return $ (RecFields env' fld_set') }
+ get_con _ env = return env
\end{code}
%*********************************************************
rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
rnFds doc fds
- = mappM (wrapLocM rn_fds) fds
+ = mapM (wrapLocM rn_fds) fds
where
rn_fds (tys1, tys2)
= rnHsTyVars doc tys1 `thenM` \ tys1' ->
rnHsTyVars doc tys2 `thenM` \ tys2' ->
- returnM (tys1', tys2')
+ return (tys1', tys2')
rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
-rnHsTyVars doc tvs = mappM (rnHsTyVar doc) tvs
+rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
rnHsTyVar :: SDoc -> RdrName -> RnM Name
rnHsTyVar _doc tyvar = lookupOccRn tyvar
checkTH :: Outputable a => a -> String -> RnM ()
#ifdef GHCI
-checkTH _ _ = returnM () -- OK
+checkTH _ _ = return () -- OK
#else
checkTH e what -- Raise an error in a stage-1 compiler
= addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>