[project @ 2001-01-09 17:43:57 by rrt]

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

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 7098929..4748e9d 100644 (file)
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -760,10 +760,7 @@ addGiven avails given
         -- This assertion isn't necessarily true.  It's permitted
         -- to given a redundant context in a type signature (eg (Ord a, Eq a) => ...)
         -- and when typechecking instance decls we generate redundant "givens" too.
-    -- addAvail avails given avail
-    addAvail avails given avail `thenNF_Tc` \av ->
-    zonkInst given `thenNF_Tc` \given' ->
-    returnNF_Tc av     
+    addAvail avails given avail
   where
     avail = Avail (instToId given) NoRhs []
 
@@ -1073,7 +1070,6 @@ tcSimplifyTop wanted_lie
                -- Collect together all the bad guys
        bad_guys = non_stds ++ concat std_bads
     in
-
        -- Disambiguate the ones that look feasible
     mapTc disambigGroup std_oks                `thenTc` \ binds_ambig ->
 
@@ -1149,7 +1145,7 @@ disambigGroup dicts
     unifyTauTy chosen_default_ty (mkTyVarTy tyvar)     `thenTc_`
     reduceContext (text "disambig" <+> ppr dicts)
                  try_me [] dicts                       `thenTc` \ (binds, frees, ambigs) ->
-    ASSERT( null frees && null ambigs )
+    WARN( not (null frees && null ambigs), ppr frees $$ ppr ambigs )
     warnDefault dicts chosen_default_ty                        `thenTc_`
     returnTc binds
 
@@ -1248,14 +1244,6 @@ warnDefault dicts default_ty
                  warnTc True (vcat [ptext SLIT("Defaulting the following constraint(s) to type") <+> quotes (ppr default_ty),
                                     pprInstsInFull dicts])
 
-addRuleLhsErr dict
-  = addInstErrTcM (instLoc dict)
-       (tidy_env,
-        vcat [ptext SLIT("Could not deduce") <+> quotes (pprInst tidy_dict),
-              nest 4 (ptext SLIT("LHS of a rule must have no overloading"))])
-  where
-    (tidy_env, tidy_dict) = tidyInst emptyTidyEnv dict
-
 addTopIPErr dict
   = addInstErrTcM (instLoc dict) 
        (tidy_env,