diff options
author | simonpj@microsoft.com <unknown> | 2009-05-28 16:49:00 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2009-05-28 16:49:00 +0000 |
commit | 7a7a635688c768eb7bbeec37768d4d963581c9db (patch) | |
tree | abc0e625fb89c7f02147d191e8ba9583946c503d | |
parent | 5463bfd3f0c3cb91d7852e6e35a0b3e3738da071 (diff) | |
download | haskell-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.lhs | 13 |
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 } |