X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=96dc2614e359dfce4fc437d6df51b62ace923c5d;hp=d6177b403e4aec06a63993d4358b22cdbee0fd71;hb=2c8aabcad1d2f2c469cb8a10afa7b66beeaedd45;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516 diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index d6177b4..96dc261 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -203,6 +203,7 @@ tcLookupFamInst tycon tys = do { env <- getGblEnv ; eps <- getEps ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env) + ; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ ppr instEnv) ; case lookupFamInstEnv instEnv tycon tys of [] -> return Nothing ((fam_inst, rep_tys):_) @@ -210,7 +211,7 @@ tcLookupFamInst tycon tys } tcLookupDataFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type]) --- Find the instance of a data famliy +-- Find the instance of a data family -- Note [Looking up family instances for deriving] tcLookupDataFamInst tycon tys | not (isFamilyTyCon tycon) @@ -460,7 +461,7 @@ tcExtendGlobalTyVars gtv_var extra_global_tvs \begin{code} tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a -- Just pop the new rules into the EPS and envt resp - -- All the rules come from an interface file, not soruce + -- All the rules come from an interface file, not source -- Nevertheless, some may be for this module, if we read -- its interface instead of its source code tcExtendRules lcl_rules thing_inside @@ -548,9 +549,9 @@ tcGetDefaultTys :: Bool -- True <=> interactive context Bool)) -- True <=> Use extended defaulting rules tcGetDefaultTys interactive = do { dflags <- getDOpts - ; let ovl_strings = dopt Opt_OverloadedStrings dflags + ; let ovl_strings = xopt Opt_OverloadedStrings dflags extended_defaults = interactive - || dopt Opt_ExtendedDefaultRules dflags + || xopt Opt_ExtendedDefaultRules dflags -- See also Trac #1974 flags = (ovl_strings, extended_defaults) @@ -606,8 +607,8 @@ as well as explicit user written ones. \begin{code} data InstInfo a = InstInfo { - iSpec :: Instance, -- Includes the dfun id. Its forall'd type - iBinds :: InstBindings a -- variables scope over the stuff in InstBindings! + iSpec :: Instance, -- Includes the dfun id. Its forall'd type + iBinds :: InstBindings a -- variables scope over the stuff in InstBindings! } iDFunId :: InstInfo a -> DFunId @@ -625,7 +626,7 @@ data InstBindings a -- witness dictionary is identical to the argument -- dictionary. Hence no bindings, no pragmas. - CoercionI -- The coercion maps from newtype to the representation type + Coercion -- The coercion maps from newtype to the representation type -- (mentioning type variables bound by the forall'd iSpec variables) -- E.g. newtype instance N [a] = N1 (Tree a) -- co : N [a] ~ Tree a @@ -637,7 +638,13 @@ data InstBindings a -- in TcDeriv pprInstInfo :: InstInfo a -> SDoc -pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))] +pprInstInfo info = hang (ptext (sLit "instance")) + 2 (sep [ ifPprDebug (pprForAll tvs) + , pprThetaArrowTy theta, ppr tau + , ptext (sLit "where")]) + where + (tvs, theta, tau) = tcSplitSigmaTy (idType (iDFunId info)) + pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info)) @@ -674,7 +681,7 @@ newDFunName clas tys loc \end{code} 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 +*external* name, like other top-level names, and hence must be made with newGlobalBinder. \begin{code}