diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-11 23:55:10 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-13 10:57:13 +0100 |
| commit | 7afb7adf45216701e4f645676ecc0668f64b424d (patch) | |
| tree | a5a97c080a90fd25686d2f8bd735fd64a20d9a13 | |
| parent | c28dde37f3f274a2a1207dd4e175ea79769f5ead (diff) | |
| download | haskell-7afb7adf45216701e4f645676ecc0668f64b424d.tar.gz | |
Get in-scope set right in top_instantiate
...thereby being able to replace substThetaUnchecked
with substTheta
| -rw-r--r-- | compiler/typecheck/Inst.hs | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 25aa3cc81b..27382c5f98 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -172,7 +172,8 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType -- then wrap e :: rho topInstantiateInferred = top_instantiate False -top_instantiate :: Bool -- True <=> instantiate *all* variables +top_instantiate :: Bool -- True <=> instantiate *all* variables + -- False <=> instantiate only the invisible ones -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) top_instantiate inst_all orig ty | not (null binders && null theta) @@ -180,16 +181,21 @@ top_instantiate inst_all orig ty (inst_theta, leave_theta) | null leave_bndrs = (theta, []) | otherwise = ([], theta) - ; (subst, inst_tvs') <- newMetaTyVars (map (binderVar "top_inst") inst_bndrs) - ; let inst_theta' = substThetaUnchecked subst inst_theta - sigma' = substTyAddInScope subst (mkForAllTys leave_bndrs $ - mkFunTys leave_theta rho) + in_scope = mkInScopeSet (tyCoVarsOfType ty) + empty_subst = mkEmptyTCvSubst in_scope + inst_tvs = map (binderVar "top_inst") inst_bndrs + ; (subst, inst_tvs') <- mapAccumLM newMetaTyVarX empty_subst inst_tvs + ; let inst_theta' = substTheta subst inst_theta + sigma' = substTy subst (mkForAllTys leave_bndrs $ + mkFunTys leave_theta rho) ; wrap1 <- instCall orig (mkTyVarTys inst_tvs') inst_theta' ; traceTc "Instantiating" (vcat [ text "all tyvars?" <+> ppr inst_all , text "origin" <+> pprCtOrigin orig , text "type" <+> ppr ty + , text "theta" <+> ppr theta + , text "leave_bndrs" <+> ppr leave_bndrs , text "with" <+> ppr inst_tvs' , text "theta:" <+> ppr inst_theta' ]) |