From 6070e794008e61944761426250362a1f866e0a24 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:49:15 +0000 Subject: [PATCH] Fix type checking of imported data instances Mon Sep 18 19:48:41 EDT 2006 Manuel M T Chakravarty * Fix type checking of imported data instances Mon Sep 11 20:06:51 EDT 2006 Manuel M T Chakravarty * Fix type checking of imported data instances - When reading a data/newtype instance from an interface, the data constructors have their own universals that do not necessarily match up with their tycon's type parameters. (Whereas when type checking source, they are always the same.) - Hence, we need to be careful when building the wrapper signature of imported data constructors from data/newtype instances, and rename the type variables in the instance types appropriately. --- compiler/basicTypes/MkId.lhs | 16 +++++++++++++--- compiler/types/TyCon.lhs | 2 ++ 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 54bbae9..3e54813 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -47,7 +47,8 @@ import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, import TysWiredIn ( charTy, mkListTy ) import PrelRules ( primOpRules ) import Type ( TyThing(..), mkForAllTy, tyVarsOfTypes, - newTyConInstRhs, mkTopTvSubst, substTyVar, substTy ) + newTyConInstRhs, mkTopTvSubst, substTyVar, substTy, + substTys, zipTopTvSubst ) import TcGadt ( gadtRefine, refineType, emptyRefinement ) import HsBinds ( ExprCoFn(..), isIdCoercion ) import Coercion ( mkSymCoercion, mkUnsafeCoercion, isEqPred ) @@ -60,7 +61,8 @@ import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy, import CoreUtils ( exprType, dataConOrigInstPat, mkCoerce ) import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding ) import Literal ( nullAddrLit, mkStringLit ) -import TyCon ( TyCon, isNewTyCon, tyConDataCons, FieldLabel, +import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons, + FieldLabel, tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon, isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe, @@ -240,6 +242,12 @@ mkDataConIds wrap_name wkr_name data_con -- extra constraints where necessary. wrap_tvs = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs subst = mkTopTvSubst eq_spec + famSubst = ASSERT( length (tyConTyVars tycon ) == + length (mkTyVarTys univ_tvs) ) + zipTopTvSubst (tyConTyVars tycon) (mkTyVarTys univ_tvs) + -- substitution mapping the type constructor's type + -- arguments to the universals of the data constructor + -- (crucial when type checking interfaces) dict_tys = mkPredTys theta result_ty_args = map (substTyVar subst) univ_tvs result_ty = case tyConFamInst_maybe tycon of @@ -248,7 +256,9 @@ mkDataConIds wrap_name wkr_name data_con -- family instance constructor Just (familyTyCon, instTys) -> - mkTyConApp familyTyCon (map (substTy subst) instTys) + mkTyConApp familyTyCon ( substTys subst + . substTys famSubst + $ instTys) wrap_ty = mkForAllTys wrap_tvs $ mkFunTys dict_tys $ mkFunTys orig_arg_tys $ result_ty -- NB: watch out here if you allow user-written equality diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 31cb19b..b359660 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -101,6 +101,8 @@ data TyCon tyConTyVars :: [TyVar], -- Scopes over (a) the algTcStupidTheta -- (b) the cached types in -- algTyConRhs.NewTyCon + -- (c) the family instance + -- types if present -- But not over the data constructors tyConArgPoss :: Maybe [Int], -- for associated families: for each -- 1.7.10.4