X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=0f9bf231c8c66b3c2475e73630a82bb4a5657533;hb=289ee3d0daa95445ead578f2b674987a4187993d;hp=ff49db6af6b04448f5a032cbb551f2d397b58b4a;hpb=cd290fc88d35d5a32c994664baa56a5eae250e9e;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index ff49db6..0f9bf23 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -42,7 +42,10 @@ module TcEnv( topIdLvl, -- New Ids - newLocalName, newDFunName, newFamInstTyConName + newLocalName, newDFunName, newFamInstTyConName, + + -- Errors + famInstNotFound ) where #include "HsVersions.h" @@ -55,7 +58,6 @@ import TcMType import TcType import TcGadt import qualified Type -import Id import Var import VarSet import VarEnv @@ -160,7 +162,21 @@ tcLookupLocatedTyCon :: Located Name -> TcM TyCon tcLookupLocatedTyCon = addLocM tcLookupTyCon -- Look up the representation tycon of a family instance. --- Return the rep tycon and the corresponding rep args +-- +-- The match must be unique - ie, match exactly one instance - but the +-- type arguments used for matching may be more specific than those of +-- the family instance declaration. +-- +-- Return the instance tycon and its type instance. For example, if we have +-- +-- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int') +-- +-- then we have a coercion (ie, type instance of family instance coercion) +-- +-- :Co:R42T Int :: T [Int] ~ :R42T Int +-- +-- which implies that :R42T was declared as 'data instance T [a]'. +-- tcLookupFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type]) tcLookupFamInst tycon tys | not (isOpenTyCon tycon) @@ -170,20 +186,8 @@ tcLookupFamInst tycon tys ; eps <- getEps ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env) ; case lookupFamInstEnv instEnv tycon tys of - - [(subst, fam_inst)] | variable_only_subst -> - return (rep_tc, substTyVars subst (tyConTyVars rep_tc)) - where -- NB: assumption is that (tyConTyVars rep_tc) is in - -- the domain of the substitution - rep_tc = famInstTyCon fam_inst - subst_domain = varEnvElts . getTvSubstEnv $ subst - tvs = map (Type.getTyVar "tcLookupFamInst") - subst_domain - variable_only_subst = all Type.isTyVarTy subst_domain && - sizeVarSet (mkVarSet tvs) == length tvs - -- renaming may have no repetitions - - other -> famInstNotFound tycon tys other + [(fam_inst, rep_tys)] -> return (famInstTyCon fam_inst, rep_tys) + other -> famInstNotFound tycon tys other } \end{code} @@ -636,7 +640,7 @@ Make a name for the dict fun for an instance decl. It's an *external* name, like otber top-level names, and hence must be made with newGlobalBinder. \begin{code} -newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name +newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name newDFunName clas (ty:_) loc = do { index <- nextDFunIndex ; is_boot <- tcIsHsBoot @@ -650,12 +654,12 @@ newDFunName clas (ty:_) loc newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc) \end{code} -Make a name for the representation tycon of a data/newtype instance. It's an +Make a name for the representation tycon of a family instance. It's an *external* name, like otber top-level names, and hence must be made with newGlobalBinder. \begin{code} -newFamInstTyConName :: Name -> SrcLoc -> TcM Name +newFamInstTyConName :: Name -> SrcSpan -> TcM Name newFamInstTyConName tc_name loc = do { index <- nextDFunIndex ; mod <- getModule