summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2009-05-28 16:49:00 +0000
committersimonpj@microsoft.com <unknown>2009-05-28 16:49:00 +0000
commit7a7a635688c768eb7bbeec37768d4d963581c9db (patch)
treeabc0e625fb89c7f02147d191e8ba9583946c503d
parent5463bfd3f0c3cb91d7852e6e35a0b3e3738da071 (diff)
downloadhaskell-7a7a635688c768eb7bbeec37768d4d963581c9db.tar.gz
Fix Trac #3261: make default types play nice with -Werror
The trial-and-error for type defaults was not playing nicely with -Werror. The fix is simple.
-rw-r--r--compiler/typecheck/TcSimplify.lhs13
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 7aaa1ae7ca..cf29748561 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -2903,12 +2903,16 @@ disambigGroup :: [Type] -- The default types
-> TcM () -- Just does unification, to fix the default types
disambigGroup default_tys dicts
- = try_default default_tys
+ = do { mb_chosen_ty <- try_default default_tys
+ ; case mb_chosen_ty of
+ Nothing -> return ()
+ Just chosen_ty -> do { unifyType chosen_ty (mkTyVarTy tyvar)
+ ; warnDefault dicts chosen_ty } }
where
(_,_,tyvar) = ASSERT(not (null dicts)) head dicts -- Should be non-empty
classes = [c | (_,c,_) <- dicts]
- try_default [] = return ()
+ try_default [] = return Nothing
try_default (default_ty : default_tys)
= tryTcLIE_ (try_default default_tys) $
do { tcSimplifyDefault [mkClassPred clas [default_ty] | clas <- classes]
@@ -2918,10 +2922,7 @@ disambigGroup default_tys dicts
-- For example, if Real a is reqd, but the only type in the
-- default list is Int.
- -- After this we can't fail
- ; warnDefault dicts default_ty
- ; unifyType default_ty (mkTyVarTy tyvar)
- ; return () -- TOMDO: do something with the coercion
+ ; return (Just default_ty) -- TOMDO: do something with the coercion
}