summaryrefslogtreecommitdiff
path: root/compiler/typecheck/FunDeps.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2016-10-26 10:54:16 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2016-10-26 11:13:18 +0100
commit801c26372742fc79bd3756bdcb710031c716c402 (patch)
tree5e9bdbe7d1a9bfbbe08eb4cca810a19e6e76b8c3 /compiler/typecheck/FunDeps.hs
parenta182c0e81b59494b4c8b4c03b7b9b68d81ee3381 (diff)
downloadhaskell-801c26372742fc79bd3756bdcb710031c716c402.tar.gz
Fundeps work even for unary type classes
The functional-dependency improvement functions, improveFromAnother improveFromInstEnv had a side-condition that said the type class has to have at least two arguments. But not so, as Trac #12763 shows: class C a | -> a where ... is perfectly legal, albeit a bit of a corner case.
Diffstat (limited to 'compiler/typecheck/FunDeps.hs')
-rw-r--r--compiler/typecheck/FunDeps.hs3
1 files changed, 1 insertions, 2 deletions
diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs
index c40be7bb13..a42f7b4922 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -166,7 +166,7 @@ improveFromAnother :: loc
improveFromAnother loc pred1 pred2
| Just (cls1, tys1) <- getClassPredTys_maybe pred1
, Just (cls2, tys2) <- getClassPredTys_maybe pred2
- , tys1 `lengthAtLeast` 2 && cls1 == cls2
+ , cls1 == cls2
= [ FDEqn { fd_qtvs = [], fd_eqs = eqs, fd_pred1 = pred1, fd_pred2 = pred2, fd_loc = loc }
| let (cls_tvs, cls_fds) = classTvsFds cls1
, fd <- cls_fds
@@ -199,7 +199,6 @@ improveFromInstEnv _inst_env _ pred
= panic "improveFromInstEnv: not a class predicate"
improveFromInstEnv inst_env mk_loc pred
| Just (cls, tys) <- getClassPredTys_maybe pred
- , tys `lengthAtLeast` 2
, let (cls_tvs, cls_fds) = classTvsFds cls
instances = classInstances inst_env cls
rough_tcs = roughMatchTcs tys