From 9cd07fc3c6ba4096407fe93496c251e18a062233 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Tue, 1 Apr 2014 14:34:11 +0100
Subject: [PATCH] Make sure that polykinded Typeable is defaultable (Trac
#8931)
(cherry picked from commit 791f4fa24dd6929ab2e55c9f8b870d8078337427)
---
compiler/typecheck/TcSimplify.lhs | 14 ++++++++++----
1 file changed, 10 insertions(+), 4 deletions(-)
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index af5772982600..a5a03d1377ab 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -16,7 +16,7 @@ import TcMType as TcM
import TcType
import TcSMonad as TcS
import TcInteract
-import Kind ( defaultKind_maybe )
+import Kind ( isKind, defaultKind_maybe )
import Inst
import FunDeps ( growThetaTyVars )
import Type ( classifyPredType, PredTree(..), getClassPredTys_maybe )
@@ -1249,16 +1249,22 @@ findDefaultableGroups
-> Cts -- Unsolved (wanted or derived)
-> [[(Ct,Class,TcTyVar)]]
findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds
- | null default_tys = []
- | otherwise = filter is_defaultable_group (equivClasses cmp_tv unaries)
+ | null default_tys = []
+ | otherwise = defaultable_groups
where
+ defaultable_groups = filter is_defaultable_group groups
+ groups = equivClasses cmp_tv unaries
unaries :: [(Ct, Class, TcTyVar)] -- (C tv) constraints
non_unaries :: [Ct] -- and *other* constraints
(unaries, non_unaries) = partitionWith find_unary (bagToList wanteds)
-- Finds unary type-class constraints
+ -- But take account of polykinded classes like Typeable,
+ -- which may look like (Typeable * (a:*)) (Trac #8931)
find_unary cc
- | Just (cls,[ty]) <- getClassPredTys_maybe (ctPred cc)
+ | Just (cls,tys) <- getClassPredTys_maybe (ctPred cc)
+ , Just (kinds, ty) <- snocView tys
+ , all isKind kinds
, Just tv <- tcGetTyVar_maybe ty
, isMetaTyVar tv -- We might have runtime-skolems in GHCi, and
-- we definitely don't want to try to assign to those!
--
GitLab