diff options
| author | simonpj@microsoft.com <unknown> | 2008-12-30 16:44:32 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2008-12-30 16:44:32 +0000 |
| commit | 46934dd87e13143ec2e97f075309a9e2c0945889 (patch) | |
| tree | 4ec9e6824cf41a31f712681de7ca93c8889e45fc /compiler/iface | |
| parent | 04c3bfc687db82659a7fe5a8b0fa4244c52560b7 (diff) | |
| download | haskell-46934dd87e13143ec2e97f075309a9e2c0945889.tar.gz | |
Avoid nasty name clash with associated data types (fixes Trac #2888)
The main bug was in TcHsType; see Note [Avoid name clashes for
associated data types]. However I did a bit of re-factoring while
I was abouut it.
I'm still a but unhappy with the use of TyCon.setTyConArgPoss; it'd
be better to construct the TyCon correctly in the first place. But
that means passing an extra parameter to tcTyDecl1... maybe we should
do this.
Diffstat (limited to 'compiler/iface')
| -rw-r--r-- | compiler/iface/BuildTyCl.lhs | 9 | ||||
| -rw-r--r-- | compiler/iface/TcIface.lhs | 15 |
2 files changed, 9 insertions, 15 deletions
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs index 6f56d4f4e1..b8c04d3c4c 100644 --- a/compiler/iface/BuildTyCl.lhs +++ b/compiler/iface/BuildTyCl.lhs @@ -8,7 +8,7 @@ module BuildTyCl ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass, mkAbstractTyConRhs, mkOpenDataTyConRhs, - mkNewTyConRhs, mkDataTyConRhs + mkNewTyConRhs, mkDataTyConRhs, setAssocFamilyPermutation ) where #include "HsVersions.h" @@ -175,6 +175,13 @@ mkNewTyConRhs tycon_name tycon con eta_reduce tvs ty = (reverse tvs, ty) +setAssocFamilyPermutation :: [TyVar] -> TyThing -> TyThing +setAssocFamilyPermutation clas_tvs (ATyCon tc) + = ATyCon (setTyConArgPoss clas_tvs tc) +setAssocFamilyPermutation _clas_tvs other + = pprPanic "setAssocFamilyPermutation" (ppr other) + + ------------------------------------------------------ buildDataCon :: Name -> Bool -> [StrictnessMark] diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 7f74cf2cd2..28b03119ac 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -427,7 +427,7 @@ tcIfaceDecl ignore_prags ; sigs <- mapM tc_sig rdr_sigs ; fds <- mapM tc_fd rdr_fds ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats - ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats) + ; let ats = map (setAssocFamilyPermutation tyvars) ats' ; cls <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec ; return (AClass cls) } where @@ -445,19 +445,6 @@ tcIfaceDecl ignore_prags ; tvs2' <- mapM tcIfaceTyVar tvs2 ; return (tvs1', tvs2') } - -- For each AT argument compute the position of the corresponding class - -- parameter in the class head. This will later serve as a permutation - -- vector when checking the validity of instance declarations. - setTyThingPoss (ATyCon tycon) atTyVars = - let classTyVars = map fst tv_bndrs - poss = catMaybes - . map ((`elemIndex` classTyVars) . fst) - $ atTyVars - -- There will be no Nothing, as we already passed renaming - in - ATyCon (setTyConArgPoss tycon poss) - setTyThingPoss _ _ = panic "TcIface.setTyThingPoss" - tcIfaceDecl _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name}) = do { name <- lookupIfaceTop rdr_name ; return (ATyCon (mkForeignTyCon name ext_name |