Improve origin of constraints in subsumption checking

[ghc-hetmet.git] / compiler / typecheck / TcUnify.lhs

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index e24ea65..1868ad0 100644 (file)
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -65,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}
 
 
 %************************************************************************
@@ -682,7 +682,13 @@ tc_sub1 sub_ctxt act_sty actual_ty exp_ib exp_sty expected_ty
        ; co_fn2 <- tc_sub sub_ctxt tau' tau' exp_ib exp_sty expected_ty
 
                -- Deal with the dictionaries
-       ; co_fn1 <- instCall InstSigOrigin inst_tys (substTheta subst' theta)
+               -- The origin gives a helpful origin when we have
+               -- a function with type f :: Int -> forall a. Num a => ...
+               -- This way the (Num a) dictionary gets an OccurrenceOf f origin
+       ; let orig = case sub_ctxt of
+                       SubFun n -> OccurrenceOf n
+                       other    -> InstSigOrigin       -- Unhelpful
+       ; co_fn1 <- instCall orig inst_tys (substTheta subst' theta)
        ; return (co_fn2 <.> co_fn1) }
 
 -----------------------------------
@@ -841,7 +847,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 }
 
 ---------------