From 44c2d7662bd6074206c422533d3963cdb44e7199 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 17 Jun 2002 16:21:42 +0000
Subject: [PATCH] [project @ 2002-06-17 16:21:42 by simonpj] Ignore fewer type
 errors in tcSimplifyTop; fixes tc106

---
 ghc/compiler/typecheck/TcSimplify.lhs |   49 ++++++++++++++-------------------
 1 file changed, 21 insertions(+), 28 deletions(-)

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index c28105a..f08b5f5 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -1598,42 +1598,49 @@ tcSimplifyTop wanted_lie
 	std_groups = equivClasses cmp_by_tyvar stds
 
 		-- Pick the ones which its worth trying to disambiguate
-	(std_oks, std_bads) = partition worth_a_try std_groups
-
-		-- Have a try at disambiguation
-		-- if the type variable isn't bound
+		-- namely, the onese whose type variable isn't bound
 		-- up with one of the non-standard classes
+	(std_oks, std_bads)	= partition worth_a_try std_groups
 	worth_a_try group@(d:_) = not (non_std_tyvars `intersectsVarSet` tyVarsOfInst d)
 	non_std_tyvars		= unionVarSets (map tyVarsOfInst non_stds)
 
 		-- Collect together all the bad guys
-	bad_guys = non_stds ++ concat std_bads
+	bad_guys 	       = non_stds ++ concat std_bads
+    	(tidy_env, tidy_dicts) = tidyInsts bad_guys
+    	(bad_ips, non_ips)     = partition is_ip tidy_dicts
+    	(no_insts, ambigs)     = partition no_inst non_ips
+    	is_ip d   = any isIPPred (predsOfInst d)
+    	no_inst d = not (isTyVarDict d) || tyVarsOfInst d `subVarSet` fixed_tvs
+    	fixed_tvs = oclose (predsOfInsts tidy_dicts) emptyVarSet
     in
 
-    ifErrsTc (returnTc []) (
-	-- Don't check for ambiguous things
-	-- if there has been an error; errors often
+	-- Report definite errors
+    mapNF_Tc (addTopInstanceErrs tidy_env) (groupInsts no_insts)	`thenNF_Tc_`
+    mapNF_Tc (addTopIPErrs tidy_env)       (groupInsts bad_ips)		`thenNF_Tc_`
+
+	-- Deal with ambiguity errors, but only if
+	-- if there has not been an error so far; errors often
 	-- give rise to spurious ambiguous Insts
+    ifErrsTc (returnTc []) (
 	
-    
-	-- And complain about the ones that don't fall under
+	-- Complain about the ones that don't fall under
 	-- the Haskell rules for disambiguation
 	-- This group includes both non-existent instances
 	--	e.g. Num (IO a) and Eq (Int -> Int)
 	-- and ambiguous dictionaries
 	--	e.g. Num a
-        addTopAmbigErrs bad_guys	`thenNF_Tc_`
+	mapNF_Tc (addAmbigErr tidy_env)	ambigs	`thenNF_Tc_`
 
 	-- Disambiguate the ones that look feasible
         mapTc disambigGroup std_oks
     )					`thenTc` \ binds_ambig ->
 
-
     returnTc (binds `andMonoBinds` andMonoBindList binds_ambig)
   where
-    wanteds	= lieToList wanted_lie
+    wanteds = lieToList wanted_lie
 
-    d1 `cmp_by_tyvar` d2 = get_tv d1 `compare` get_tv d2
+----------------------------------
+d1 `cmp_by_tyvar` d2 = get_tv d1 `compare` get_tv d2
 
 get_tv d   = case getDictClassTys d of
 		   (clas, [ty]) -> tcGetTyVar "tcSimplify" ty
@@ -1887,20 +1894,6 @@ groupInsts (inst:insts) = (inst:friends) : groupInsts others
 			  loc_msg	    = showSDoc (pprInstLoc (instLoc inst))
 			  is_friend friend  = showSDoc (pprInstLoc (instLoc friend)) == loc_msg
 
-
-addTopAmbigErrs dicts
-  = mapNF_Tc (addTopInstanceErrs tidy_env) (groupInsts no_insts)	`thenNF_Tc_`
-    mapNF_Tc (addTopIPErrs tidy_env)       (groupInsts bad_ips)		`thenNF_Tc_`
-    mapNF_Tc (addAmbigErr tidy_env)	   ambigs			`thenNF_Tc_`
-    returnNF_Tc ()
-  where
-    fixed_tvs = oclose (predsOfInsts tidy_dicts) emptyVarSet
-    (tidy_env, tidy_dicts) = tidyInsts dicts
-    (bad_ips, non_ips)     = partition is_ip tidy_dicts
-    (no_insts, ambigs)     = partition no_inst non_ips
-    is_ip d   = any isIPPred (predsOfInst d)
-    no_inst d = not (isTyVarDict d) || tyVarsOfInst d `subVarSet` fixed_tvs
-
 plural [x] = empty
 plural xs  = char 's'
 
-- 
1.7.10.4