X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=a087059926fcba10fa8f56687272d4b82f5ecfa9;hp=d6177b403e4aec06a63993d4358b22cdbee0fd71;hb=c8c2f6bb7d79a2a6aeaa3233363fdf0bbbfad205;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516 diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index d6177b4..a087059 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):_) @@ -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))