From: simonpj@microsoft.com <unknown>
Date: Fri, 24 Nov 2006 08:40:11 +0000 (+0000)
Subject: Gather constraints in program order
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ecd655aaaa4ae495933415ad1ff6f6132ff3967f

Gather constraints in program order

Provoked by a suggestion of Simon's, this patch makes a half-hearted attempt
to gather constraints in program order, so that we tend to report an error
at its first occurrence, rather than its last.  Examples:
	mdofail001, tcfail015

It's "half-hearted" because generally-speaking the typechecker does not
guaranteed to keep constraints in order; it treats them as a set.  Nevertheless
this very small change seems to improve matters, so it seems a good one.
---

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 42f4ff4..b624a14 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -702,10 +702,20 @@ emptyLIE          = emptyBag
 unitLIE inst 	  = unitBag inst
 mkLIE insts	  = listToBag insts
 plusLIE lie1 lie2 = lie1 `unionBags` lie2
-consLIE inst lie  = inst `consBag` lie
 plusLIEs lies	  = unionManyBags lies
 lieToList	  = bagToList
 listToLIE	  = listToBag
+
+consLIE inst lie  = lie `snocBag` inst
+-- Putting the new Inst at the *end* of the bag is a half-hearted attempt
+-- to ensure that we tend to report the *leftmost* type-constraint error
+-- E.g. 	f :: [a]
+--		f = [1,2,3]
+-- we'd like to complain about the '1', not the '3'.
+--
+-- "Half-hearted" because the rest of the type checker makes no great
+-- claims for retaining order in the constraint set.  Still, this 
+-- seems to improve matters slightly.  Exampes: mdofail001, tcfail015
 \end{code}
 
 
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 794e09d..2a3691a 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -1971,9 +1971,6 @@ extractResults (Avails _ avails) wanteds
 		-- The sought Id can be one of the givens, via a superclass chain
 		-- and then we definitely don't want to generate an x=x binding!
 
---		| getSrcLoc id `precedesSrcLoc` srcSpanStart span
---		-> go avails (addBind binds w_span id (nlHsVar w_id)) irreds ws
-
 		| otherwise
 		-> go avails (addBind binds w (nlHsVar id)) irreds ws