X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=169cf7b5c46b5d78dbf1f41b1d8267353d90971f;hb=536ef736dfc1568670d44072abfb4f16c84bcdb8;hp=03c1bb21cc7df069e96ee0c8aa25059748aaaaa3;hpb=ab22f4e6456820c1b5169d75f5975a94e61f54ce;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 03c1bb2..169cf7b 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}    
 
     
@@ -842,7 +841,8 @@ unifyTheta :: TcThetaType -> TcThetaType -> TcM ()
 -- Acutal and expected types
 unifyTheta theta1 theta2
   = do	{ checkTc (equalLength theta1 theta2)
-		  (ptext SLIT("Contexts differ in length"))
+		  (vcat [ptext SLIT("Contexts differ in length"),
+			 nest 2 $ parens $ ptext SLIT("Use -fglasgow-exts to allow this")])
 	; uList unifyPred theta1 theta2 }
 
 ---------------
@@ -966,6 +966,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)