Commit f76f0d0e authored by Simon Peyton Jones's avatar Simon Peyton Jones

A batch of changes related to the handling of binders in instance decls

The issue is that in
    instnace C T where
      data S = ...
      f = ...
neither S nor f is really a binder; they are *occurrences*.  Moreover
Haskell dictates that these particular occurrences are disambiguated
by looking at the class whose instance they occur in.

Some of this was not handled right for associated types.  And
RnNames.getLocalNonValBinders was a bit messhy; this patch tidies it
up.

(And thenM is finally gone from RnSource.)
parent d50a0937
......@@ -372,7 +372,7 @@ data Parent = NoParent | ParentIs Name
{- Note [Parents]
~~~~~~~~~~~~~~~~~
What Children
Parent Children
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
data T Data constructors
Record-field ids
......@@ -436,18 +436,15 @@ globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts env = foldOccEnv (++) [] env
instance Outputable GlobalRdrElt where
ppr gre = hang (ppr name)
2 (parens (ppr (gre_par gre) <+> pprNameProvenance gre))
where
name = gre_name gre
ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))
2 (pprNameProvenance gre)
pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
pprGlobalRdrEnv env
= vcat (map pp (occEnvElts env))
where
pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+>
vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
| gre <- gres]
vcat (map ppr gres)
\end{code}
\begin{code}
......@@ -475,8 +472,9 @@ lookupGRE_Name env name
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
-- Returns all the qualifiers by which 'x' is in scope
-- Nothing means "the unqualified version is in scope"
-- [] means the thing is not in scope at all
getGRE_NameQualifier_maybes env
= map qualifier_maybe . map gre_prov . lookupGRE_Name env
= map (qualifier_maybe . gre_prov) . lookupGRE_Name env
where
qualifier_maybe LocalDef = Nothing
qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
......
......@@ -319,7 +319,7 @@ repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now
; repInst cxt1 inst_ty1 decls }
; return (loc, dec) }
where
(tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
(tvs, cxt, L _ cls, tys) = splitHsInstDeclTy ty
repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
repForD (L loc (ForeignImport name typ (CImport cc s ch cis)))
......
......@@ -304,19 +304,19 @@ mkHsAppTys fun_ty (arg_ty:arg_tys)
splitHsInstDeclTy
:: OutputableBndr name
=> HsType name
-> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
=> LHsType name
-> ([LHsTyVarBndr name], HsContext name, Located name, [LHsType name])
-- Split up an instance decl type, returning the pieces
splitHsInstDeclTy inst_ty
splitHsInstDeclTy linst_ty@(L _ inst_ty)
= case inst_ty of
HsParTy (L _ ty) -> splitHsInstDeclTy ty
HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
other -> split_tau [] [] other
HsParTy ty -> splitHsInstDeclTy ty
HsForAllTy _ tvs cxt ty -> split_tau tvs (unLoc cxt) ty
_ -> split_tau [] [] linst_ty
-- The type vars should have been computed by now, even if they were implicit
where
split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
split_tau tvs cxt (L loc (HsPredTy (HsClassP cls tys))) = (tvs, cxt, L loc cls, tys)
split_tau tvs cxt (L _ (HsParTy ty)) = split_tau tvs cxt ty
split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
-- Splits HsType into the (init, last) parts
......
......@@ -624,7 +624,7 @@ rnMethodBind cls sig_fn
(L loc bind@(FunBind { fun_id = name, fun_infix = is_infix
, fun_matches = MatchGroup matches _ }))
= setSrcSpan loc $ do
sel_name <- wrapLocM (lookupInstDeclBndr cls) name
sel_name <- wrapLocM (lookupInstDeclBndr cls (ptext (sLit "method"))) name
let plain_name = unLoc sel_name
-- We use the selector name as the binder
......
......@@ -236,7 +236,7 @@ lookupExactOcc name
_ -> pprPanic "lookupExactOcc" (ppr name $$ ppr gres) }
-----------------------------------------------
lookupInstDeclBndr :: Name -> RdrName -> RnM Name
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
-- This is called on the method name on the left-hand side of an
-- instance declaration binding. eg. instance Functor T where
-- fmap = ...
......@@ -248,7 +248,10 @@ lookupInstDeclBndr :: Name -> RdrName -> RnM Name
-- name is only in scope qualified. I.e. even if method op is
-- in scope as M.op, we still allow plain 'op' on the LHS of
-- an instance decl
lookupInstDeclBndr cls rdr
--
-- The "what" parameter says "method" or "associated type",
-- depending on what we are looking up
lookupInstDeclBndr cls what rdr
= do { when (isQual rdr)
(addErr (badQualBndrErr rdr))
-- In an instance decl you aren't allowed
......@@ -256,7 +259,7 @@ lookupInstDeclBndr cls rdr
-- (Although it'd make perfect sense.)
; lookupSubBndr (ParentIs cls) doc rdr }
where
doc = ptext (sLit "method of class") <+> quotes (ppr cls)
doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
-----------------------------------------------
lookupConstructorFields :: Name -> RnM [Name]
......@@ -443,7 +446,8 @@ lookupOccRn rdr_name
-- and only happens for failed lookups
; if isQual rdr_name && allow_qual && is_ghci
then lookupQualifiedName rdr_name
else unboundName WL_Any rdr_name } } } } }
else do { traceRn (text "lookupOccRn" <+> ppr rdr_name)
; unboundName WL_Any rdr_name } } } } } }
lookupGlobalOccRn :: RdrName -> RnM Name
......@@ -453,7 +457,8 @@ lookupGlobalOccRn rdr_name
= do { mb_name <- lookupGlobalOccRn_maybe rdr_name
; case mb_name of
Just n -> return n
Nothing -> unboundName WL_Global rdr_name }
Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name)
; unboundName WL_Global rdr_name } }
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
-- No filter function; does not report an error on failure
......@@ -489,7 +494,8 @@ lookupGreRn rdr_name
; case mb_gre of {
Just gre -> return gre ;
Nothing -> do
{ name <- unboundName WL_Global rdr_name
{ traceRn (text "lookupGreRn" <+> ppr rdr_name)
; name <- unboundName WL_Global rdr_name
; return (GRE { gre_name = name, gre_par = NoParent,
gre_prov = LocalDef }) }}}
......@@ -549,7 +555,8 @@ lookupQualifiedName rdr_name
name <- availNames avail,
nameOccName name == occ ] of
(n:ns) -> ASSERT (null ns) return n
_ -> unboundName WL_Any rdr_name
_ -> do { traceRn (text "lookupQualified" <+> ppr rdr_name)
; unboundName WL_Any rdr_name }
| otherwise
= pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
......@@ -644,14 +651,14 @@ lookupBindGroupOcc mb_bound_names what rdr_name
---------------
lookupLocalDataTcNames :: NameSet -> SDoc -> RdrName -> RnM [Name]
-- GHC extension: look up both the tycon and data con
-- for con-like things
-- for con-like things. Used for top-level fixity signatures
-- Complain if neither is in scope
lookupLocalDataTcNames bound_names what rdr_name
lookupLocalDataTcNames bndr_set what rdr_name
| Just n <- isExact_maybe rdr_name
-- Special case for (:), which doesn't get into the GlobalRdrEnv
= do { n' <- lookupExactOcc n; return [n'] } -- For this we don't need to try the tycon too
| otherwise
= do { mb_gres <- mapM (lookupBindGroupOcc (Just bound_names) what)
= do { mb_gres <- mapM (lookupBindGroupOcc (Just bndr_set) what)
(dataTcOccs rdr_name)
; let (errs, names) = splitEithers mb_gres
; when (null names) (addErr (head errs)) -- Bleat about one only
......
......@@ -7,7 +7,7 @@
module RnNames (
rnImports, getLocalNonValBinders,
rnExports, extendGlobalRdrEnvRn,
gresFromAvails,
gresFromAvails, lookupTcdName,
reportUnusedNames, finishWarnings,
) where
......@@ -469,53 +469,9 @@ used for source code.
*** See "THE NAMING STORY" in HsDecls ****
Instances of type families
~~~~~~~~~~~~~~~~~~~~~~~~~~
Family instances contain data constructors that we need to collect and we also
need to descend into the type instances of associated families in class
instances. The type constructor of a family instance is a usage occurence.
Hence, we don't return it as a subname in 'AvailInfo'; otherwise, we would get
a duplicate declaration error.
Note [Looking up family names in family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
module M where
type family T a :: *
type instance M.T Int = Bool
We might think that we can simply use 'lookupOccRn' when processing the type
instance to look up 'M.T'. Alas, we can't! The type family declaration is in
the *same* HsGroup as the type instance declaration. Hence, as we are
currently collecting the binders declared in that HsGroup, these binders will
not have been added to the global environment yet.
In the case of type classes, this problem does not arise, as a class instance
does not define any binders of its own. So, we simply don't attempt to look
up the class names of class instances in 'get_local_binders' below.
If we don't look up class instances, can't we get away without looking up type
instances, too? No, we can't. Data type instances define data constructors
and we need to
(1) collect those in 'get_local_binders' and
(2) we need to get their parent name in 'get_local_binders', too, to
produce an appropriate 'AvailTC'.
This parent name is exactly the family name of the type instance that is so
difficult to look up.
We solve this problem as follows:
(a) We process all type declarations *other* than type instances first.
(b) Then, we compute an 'OccEnv' from the result of the first step.
(c) Finally, we process all type instances (both those on the toplevel and
those nested in class instances) and check for the family names in the
'GlobalRdrEnv' produced in the previous step before using 'lookupOccRn'.
\begin{code}
getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
-- Get all the top-level binders bound the group *except*
-- for value bindings, which are treated separately
-- Specificaly we return AvailInfo for
......@@ -525,52 +481,48 @@ getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
-- foreign imports
-- (in hs-boot files) value signatures
getLocalNonValBinders group
= do { gbl_env <- getGblEnv
; get_local_binders gbl_env group }
get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo]
get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs,
hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls })
= do { -- separate out the family instance declarations
let (tyinst_decls1, tycl_decls_noinsts)
= partition (isFamInstDecl . unLoc) (concat tycl_decls)
tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
-- process all type/class decls except family instances
; tc_avails <- mapM new_tc tycl_decls_noinsts
-- Create a temporary env of the type binders
-- See Note [Looking up family names in family instances]
-- NB: associated types may be a sub-bndr of a class
-- AvailTC C [C,T,op]
-- Hence availNames, not availName
; let local_tc_env :: OccEnv Name
local_tc_env = mkOccEnv [ (occ, n)
| a <- tc_avails
, n <- availNames a
, let occ = nameOccName n
, isTcOcc occ ]
getLocalNonValBinders fixity_env
(HsGroup { hs_valds = val_binds,
hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls })
= do { -- Separate out the family instance declarations
let (tyinst_decls, tycl_decls_noinsts)
= partition (isFamInstDecl . unLoc) (concat tycl_decls)
-- Process all type/class decls *except* family instances
; tc_avails <- mapM new_tc tycl_decls_noinsts
; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
; setEnvs envs $ do {
-- Bring these things into scope first
-- See Note [Looking up family names in family instances]
-- Process all family instances
; ti_avails <- mapM (new_ti local_tc_env) tyinst_decls
-- finish off with value binder in case of a hs-boot file
-- to bring new data constructors into scope
; ti_avails <- mapM (new_ti Nothing) tyinst_decls
; nti_avails <- concatMapM new_assoc inst_decls
-- Finish off with value binders:
-- foreign decls for an ordinary module
-- type sigs in case of a hs-boot file only
; is_boot <- tcIsHsBoot
; let val_bndrs | is_boot = hs_boot_sig_bndrs
| otherwise = for_hs_bndrs
; val_avails <- mapM new_simple val_bndrs
; return (val_avails ++ tc_avails ++ ti_avails) }
where
is_hs_boot = isHsBoot (tcg_src gbl_env) ;
; let avails = ti_avails ++ nti_avails ++ val_avails
new_bndrs = availsToNameSet avails `unionNameSets`
availsToNameSet tc_avails
; envs <- extendGlobalRdrEnvRn avails fixity_env
; return (envs, new_bndrs) } }
where
for_hs_bndrs :: [Located RdrName]
for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
-- In a hs-boot file, the value binders come from the
-- *signatures*, and there should be no foreign binders
val_bndrs :: [Located RdrName]
val_bndrs | is_hs_boot = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns]
| otherwise = for_hs_bndrs
hs_boot_sig_bndrs = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns]
ValBindsIn _ val_sigs = val_binds
new_simple :: Located RdrName -> RnM AvailInfo
new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
......@@ -580,21 +532,89 @@ get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs,
= do { names@(main_name : _) <- mapM newTopSrcBinder (hsTyClDeclBinders tc_decl)
; return (AvailTC main_name names) }
new_ti local_tc_env ti_decl -- ONLY for type/data instances
= do { let L loc tc_rdr = tcdLName (unLoc ti_decl)
; main_name <- setSrcSpan loc $
case lookupOccEnv local_tc_env (rdrNameOcc tc_rdr) of
Nothing -> lookupGlobalOccRn tc_rdr
Just n -> return n
-- See Note [Looking up family names in family instances]
new_ti :: Maybe Name -> LTyClDecl RdrName -> RnM AvailInfo
new_ti mb_cls ti_decl -- ONLY for type/data instances
= do { main_name <- lookupTcdName mb_cls (unLoc ti_decl)
; sub_names <- mapM newTopSrcBinder (hsTyClDeclBinders ti_decl)
; return (AvailTC main_name sub_names) }
; return (AvailTC (unLoc main_name) sub_names) }
-- main_name is not bound here!
get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
new_assoc :: LInstDecl RdrName -> RnM [AvailInfo]
new_assoc (L _ (InstDecl inst_ty _ _ ats))
= do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
; mapM (new_ti (Just cls_nm)) ats }
where
(_, _, L loc cls_rdr, _) = splitHsInstDeclTy inst_ty
lookupTcdName :: Maybe Name -> TyClDecl RdrName -> RnM (Located Name)
-- Used for TyData and TySynonym only
-- See Note [Family instance binders]
lookupTcdName mb_cls tc_decl
| not (isFamInstDecl tc_decl) -- The normal case
= ASSERT2( isNothing mb_cls, ppr tc_rdr ) -- Parser prevents this
lookupLocatedTopBndrRn tc_rdr
| Just cls <- mb_cls -- Associated type; c.f RnBinds.rnMethodBind
= wrapLocM (lookupInstDeclBndr cls (ptext (sLit "associated type"))) tc_rdr
| otherwise -- Family instance; tc_rdr is an *occurrence*
= lookupLocatedOccRn tc_rdr
where
tc_rdr = tcdLName tc_decl
\end{code}
Note [Looking up family names in family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
module M where
type family T a :: *
type instance M.T Int = Bool
We might think that we can simply use 'lookupOccRn' when processing the type
instance to look up 'M.T'. Alas, we can't! The type family declaration is in
the *same* HsGroup as the type instance declaration. Hence, as we are
currently collecting the binders declared in that HsGroup, these binders will
not have been added to the global environment yet.
Solution is simple: process the type family declarations first, extend
the environment, and then process the type instances.
Note [Family instance binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data family F a
data instance F T = X1 | X2
The 'data instance' decl has an *occurrence* of F (and T), and *binds*
X1 and X2. (This is unlike a normal data type declaration which would
bind F too.) So we want an AvailTC F [X1,X2].
Now consider a similar pair:
class C a where
data G a
instance C S where
data G S = Y1 | Y2
The 'data G S' *binds* Y1 and Y2, and has an *occurrence* of G.
But there is a small complication: in an instance decl, we don't use
qualified names on the LHS; instead we use the class to disambiguate.
Thus:
module M where
import Blib( G )
class C a where
data G a
instance C S where
data G S = Y1 | Y2
Even though there are two G's in scope (M.G and Blib.G), the occurence
of 'G' in the 'instance C S' decl is unambiguous, becuase C has only
one associated type called G. This is exactly what happens for methods,
and it is only consistent to do the same thing for types. That's the
role of the function lookupTcdName; the (Maybe Name) give the class of
the encloseing instance decl, if any.
%************************************************************************
%* *
......
......@@ -20,17 +20,11 @@ import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
import RdrHsSyn ( extractHsRhoRdrTyVars )
import RnHsSyn
import RnTypes
import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
makeMiniFixityEnv)
import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
lookupTopBndrRn, lookupLocatedTopBndrRn,
lookupOccRn, bindLocalNamesFV,
bindLocatedLocalsFV, bindPatSigTyVarsFV,
bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
bindLocalNames, checkDupRdrNames, mapFvRn
)
import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
import HscTypes ( AvailInfo(..), availsToNameSet )
import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds,
renameSigs, mkSigTvFn, makeMiniFixityEnv )
import RnEnv
import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn, lookupTcdName )
import HscTypes ( AvailInfo(..) )
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad
......@@ -57,15 +51,6 @@ import Maybes( orElse )
import Data.Maybe
\end{code}
\begin{code}
-- XXX
thenM :: Monad a => a b -> (b -> a c) -> a c
thenM = (>>=)
thenM_ :: Monad a => a b -> a c -> a c
thenM_ = (>>)
\end{code}
@rnSourceDecl@ `renames' declarations.
It simultaneously performs dependency analysis and precedence parsing.
It also does the following error checks:
......@@ -103,14 +88,13 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
-- (A) Process the fixity declarations, creating a mapping from
-- FastStrings to FixItems.
-- Also checks for duplcates.
local_fix_env <- makeMiniFixityEnv fix_decls;
local_fix_env <- makeMiniFixityEnv fix_decls ;
-- (B) Bring top level binders (and their fixities) into scope,
-- *except* for the value bindings, which get brought in below.
-- 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 ;
(tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;
setEnvs tc_envs $ do {
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
......@@ -127,11 +111,9 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
-- 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 { val_binders = 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
} ;
let { val_binders = collectHsValBinders new_lhs ;
all_bndr_set = addListToNameSet tc_bndrs val_binders ;
val_avails = map Avail val_binders } ;
(tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
traceRn (ptext (sLit "Val binders") <+> (ppr val_binders)) ;
setEnvs (tcg_env, tcl_env) $ do {
......@@ -270,7 +252,7 @@ rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
--
-- The returned FixitySigs are not actually used for anything,
-- except perhaps the GHCi API
rnSrcFixityDecls bound_names fix_decls
rnSrcFixityDecls bndr_set fix_decls
= do fix_decls <- mapM rn_decl fix_decls
return (concat fix_decls)
where
......@@ -282,7 +264,7 @@ rnSrcFixityDecls bound_names fix_decls
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 bound_names what rdr_name
do names <- lookupLocalDataTcNames bndr_set what rdr_name
return [ L loc (FixitySig (L name_loc name) fixity)
| name <- names ]
what = ptext (sLit "fixity signature")
......@@ -304,10 +286,10 @@ gather them together.
\begin{code}
-- checks that the deprecations are defined locally, and that there are no duplicates
rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
rnSrcWarnDecls _bound_names []
rnSrcWarnDecls _ []
= return NoWarnings
rnSrcWarnDecls bound_names decls
rnSrcWarnDecls bndr_set decls
= do { -- check for duplicates
; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
in addErrAt loc (dupWarnDecl lrdr' rdr))
......@@ -317,8 +299,8 @@ rnSrcWarnDecls bound_names decls
where
rn_deprec (Warning rdr_name txt)
-- ensures that the names are defined locally
= lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
return [(nameOccName name, txt) | name <- names]
= do { names <- lookupLocalDataTcNames bndr_set what rdr_name
; return [(nameOccName name, txt) | name <- names] }
what = ptext (sLit "deprecation")
......@@ -364,8 +346,8 @@ rnAnnProvenance provenance = do
\begin{code}
rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
rnDefaultDecl (DefaultDecl tys)
= mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
return (DefaultDecl tys', fvs)
= do { (tys', fvs) <- mapFvRn (rnHsTypeFVs doc_str) tys
; return (DefaultDecl tys', fvs) }
where
doc_str = text "In a `default' declaration"
\end{code}
......@@ -379,20 +361,20 @@ rnDefaultDecl (DefaultDecl tys)
\begin{code}
rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
rnHsForeignDecl (ForeignImport name ty spec)
= getTopEnv `thenM` \ (topEnv :: HscEnv) ->
lookupLocatedTopBndrRn name `thenM` \ name' ->
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
= do { topEnv :: HscEnv <- getTopEnv
; name' <- lookupLocatedTopBndrRn name
; (ty', fvs) <- rnHsTypeFVs (fo_decl_msg name) ty
-- Mark any PackageTarget style imports as coming from the current package
let packageId = thisPackage $ hsc_dflags topEnv
spec' = patchForeignImport packageId spec
-- Mark any PackageTarget style imports as coming from the current package
; let packageId = thisPackage $ hsc_dflags topEnv
spec' = patchForeignImport packageId spec
in return (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) ->
return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
= do { name' <- lookupLocatedOccRn name
; (ty', fvs) <- rnHsTypeFVs (fo_decl_msg name) ty
; 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
......@@ -438,30 +420,28 @@ patchCCallTarget packageId callTarget
rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
-- Used for both source and interface file decls
= rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
= do { inst_ty' <- rnHsSigType (text "an instance decl") inst_ty
-- Rename the bindings
-- The typechecker (not the renamer) checks that all
-- the bindings are for the right class
let
(inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
in
extendTyVarEnvForMethodBinds inst_tyvars (
-- (Slightly strangely) the forall-d tyvars scope over
-- the method bindings too
rnMethodBinds cls (\_ -> []) -- No scoped tyvars
mbinds
) `thenM` \ (mbinds', meth_fvs) ->
; let (inst_tyvars, _, L _ cls, _) = splitHsInstDeclTy inst_ty'
; (mbinds', meth_fvs) <- extendTyVarEnvForMethodBinds inst_tyvars $
rnMethodBinds cls (\_ -> []) -- No scoped tyvars
mbinds
-- (Slightly strangely) the forall-d tyvars
-- scope over the method bindings too
-- Rename the associated types
-- The typechecker (not the renamer) checks that all
-- the declarations are for the right class
let
at_names = map (tcdLName . unLoc) ats -- The names of the associated types
in
checkDupRdrNames at_names `thenM_`
; let at_names = map (tcdLName . unLoc) ats -- The names of the associated types
; checkDupRdrNames at_names
-- See notes with checkDupRdrNames for methods, above
rnATInsts ats `thenM` \ (ats', at_fvs) ->
; traceRn (text "rnATInsts" <+> ppr ats)
; (ats', at_fvs) <- rnATInsts cls ats
-- Rename the prags and signatures.
-- Note that the type variables are not in scope here,
......@@ -470,17 +450,15 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
-- works OK.
--
-- But the (unqualified) method names are in scope
let
binders = collectHsBindsBinders mbinds'
bndr_set = mkNameSet binders
in
bindLocalNames binders
(renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
return (InstDecl inst_ty' mbinds' uprags' ats',
meth_fvs `plusFV` at_fvs
`plusFV` hsSigsFVs uprags'
`plusFV` extractHsTyNames inst_ty')
; let binders = collectHsBindsBinders mbinds'
bndr_set = mkNameSet binders
; uprags' <- bindLocalNames binders $
renameSigs (Just bndr_set) okInstDclSig uprags
; return (InstDecl inst_ty' mbinds' uprags' ats',
meth_fvs `plusFV` at_fvs
`plusFV` hsSigsFVs uprags'
`plusFV` extractHsTyNames inst_ty') }
-- We return the renamed associated data type declarations so
-- that they can be entered into the list of type declarations
-- for the binding group, but we also keep a copy in the instance.
......@@ -496,14 +474,13 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
Renaming of the associated types in instances.
\begin{code}
rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
rnATInsts atDecls = rnList rnATInst atDecls
rnATInsts :: Name -> [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
rnATInsts cls atDecls = rnList rnATInst atDecls
where
rnATInst tydecl@TyData {} = rnTyClDecl tydecl
rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
rnATInst tydecl =
pprPanic "RnSource.rnATInsts: invalid AT instance"
(ppr (tcdName tydecl))
rnATInst tydecl@TyData {} = rnTyClDecl (Just cls) tydecl
rnATInst tydecl@TySynonym {} = rnTyClDecl (Just cls) tydecl
rnATInst tydecl = pprPanic "RnSource.rnATInsts: invalid AT instance"
(ppr (tcdName tydecl))
\end{code}
For the method bindings in class and instance decls, we extend the
......@@ -573,8 +550,8 @@ rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
rn_var (RuleBndr (L loc _), id)
= return (RuleBndr (L loc id), emptyFVs)
rn_var (RuleBndrSig (L loc _) t, id)
= rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
return (RuleBndrSig (L loc id) t', fvs)
= do { (t', fvs) <- rnHsTypeFVs doc t
; return (RuleBndrSig (L loc id) t', fvs) }