X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=5fcaea6cf1bc25d61f67f2ea3c50d3096a72ee25;hb=e68a891932d615590d9b1ab5752ada8142db5053;hp=03c1bb21cc7df069e96ee0c8aa25059748aaaaa3;hpb=ab22f4e6456820c1b5169d75f5975a94e61f54ce;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 03c1bb2..5fcaea6 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -41,7 +41,6 @@ import TysPrim import Inst import TyCon import TysWiredIn -import Id import Var import VarSet import VarEnv @@ -66,7 +65,7 @@ tcInfer tc_infer ; res <- tc_infer (mkTyVarTy box) ; res_ty <- readFilledBox box -- Guaranteed filled-in by now ; return (res, res_ty) } -\end{code} +\end{code} %************************************************************************ @@ -757,8 +756,8 @@ tcGen expected_ty extra_tvs thing_inside -- We expect expected_ty to be a forall -- Hence the tiresome but innocuous fixM ((tvs', theta', rho'), skol_info) <- fixM (\ ~(_, skol_info) -> do { (forall_tvs, theta, rho_ty) <- tcInstSkolType skol_info expected_ty - ; span <- getSrcSpanM - ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty) span + -- Get loation from monad, not from expected_ty + ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty) ; return ((forall_tvs, theta, rho_ty), skol_info) }) #ifdef DEBUG @@ -782,8 +781,9 @@ tcGen expected_ty extra_tvs thing_inside -- We expect expected_ty to be a forall -- Conclusion: include the free vars of the expected_ty in the -- list of "free vars" for the signature check. - ; dicts <- newDictBndrsO (SigOrigin skol_info) theta' - ; inst_binds <- tcSimplifyCheck sig_msg tvs' dicts lie + ; loc <- getInstLoc (SigOrigin skol_info) + ; dicts <- newDictBndrs loc theta' + ; inst_binds <- tcSimplifyCheck loc tvs' dicts lie ; checkSigTyVarsWrt free_tvs tvs' ; traceTc (text "tcGen:done") @@ -795,7 +795,6 @@ tcGen expected_ty extra_tvs thing_inside -- We expect expected_ty to be a forall ; returnM (co_fn, result) } where free_tvs = tyVarsOfType expected_ty `unionVarSet` extra_tvs - sig_msg = ptext SLIT("expected type of an expression") \end{code} @@ -966,6 +965,7 @@ u_tys outer nb1 orig_ty1 ty1 nb2 orig_ty2 ty2 go _ ty1@(ForAllTy _ _) ty2@(ForAllTy _ _) | length tvs1 == length tvs2 = do { tvs <- tcInstSkolTyVars UnkSkol tvs1 -- Not a helpful SkolemInfo + -- Get location from monad, not from tvs1 ; let tys = mkTyVarTys tvs in_scope = mkInScopeSet (mkVarSet tvs) subst1 = mkTvSubst in_scope (zipTyEnv tvs1 tys)