diff options
Diffstat (limited to 'testsuite/tests/polykinds')
31 files changed, 121 insertions, 143 deletions
diff --git a/testsuite/tests/polykinds/KindVType.stderr b/testsuite/tests/polykinds/KindVType.stderr index feb1417675..bf8c99c03b 100644 --- a/testsuite/tests/polykinds/KindVType.stderr +++ b/testsuite/tests/polykinds/KindVType.stderr @@ -1,7 +1,7 @@ KindVType.hs:8:8: error: • Couldn't match type ‘Int’ with ‘Maybe’ - Expected type: Proxy Maybe - Actual type: Proxy Int + Expected: Proxy Maybe + Actual: Proxy Int • In the expression: Proxy :: Proxy Int In an equation for ‘foo’: foo = (Proxy :: Proxy Int) diff --git a/testsuite/tests/polykinds/T10503.hs b/testsuite/tests/polykinds/T10503.hs index 2b9900652f..d352ce720f 100644 --- a/testsuite/tests/polykinds/T10503.hs +++ b/testsuite/tests/polykinds/T10503.hs @@ -1,9 +1,10 @@ {-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-} module GHCBug where +import Data.Kind data Proxy p = Proxy -data KProxy (a :: *) = KProxy +data KProxy (a :: Type) = KProxy -h :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy *) => r) -> r -h = undefined +h :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy Type) => r) -> r +h x = undefined diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr deleted file mode 100644 index 0895bdba26..0000000000 --- a/testsuite/tests/polykinds/T10503.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -T10503.hs:8:6: error: - • Could not deduce: k ~ * - from the context: Proxy 'KProxy ~ Proxy 'KProxy - bound by a type expected by the context: - (Proxy 'KProxy ~ Proxy 'KProxy) => r - at T10503.hs:8:6-87 - ‘k’ is a rigid type variable bound by - the type signature for: - h :: forall k r. ((Proxy 'KProxy ~ Proxy 'KProxy) => r) -> r - at T10503.hs:8:6-87 - • In the ambiguity check for ‘h’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: - h :: forall k r. - (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy (*)) => r) - -> r diff --git a/testsuite/tests/polykinds/T11142.stderr b/testsuite/tests/polykinds/T11142.stderr index 4f5c5fcf29..780bbdc63f 100644 --- a/testsuite/tests/polykinds/T11142.stderr +++ b/testsuite/tests/polykinds/T11142.stderr @@ -1,17 +1,10 @@ T11142.hs:9:49: error: - • Expected kind ‘k1’, but ‘b’ has kind ‘k0’ + • Expected kind ‘k’, but ‘b’ has kind ‘k0’ + because kind variable ‘k’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall k (a :: k). SameKind a b’ + at T11142.hs:9:19-49 • In the second argument of ‘SameKind’, namely ‘b’ In the type signature: foo :: forall b. (forall k (a :: k). SameKind a b) -> () - -T11142.hs:10:7: error: - • Cannot instantiate unification variable ‘a0’ - with a type involving polytypes: - (forall k1 (a :: k1). SameKind a b) -> () - GHC doesn't yet support impredicative polymorphism - • In the expression: undefined - In an equation for ‘foo’: foo = undefined - • Relevant bindings include - foo :: (forall k1 (a :: k1). SameKind a b) -> () - (bound at T11142.hs:10:1) diff --git a/testsuite/tests/polykinds/T12444.stderr b/testsuite/tests/polykinds/T12444.stderr index 0ebd2986cf..0a75b049ec 100644 --- a/testsuite/tests/polykinds/T12444.stderr +++ b/testsuite/tests/polykinds/T12444.stderr @@ -1,13 +1,13 @@ T12444.hs:19:11: error: • Couldn't match type ‘b’ with ‘'Succ (c :+: b)’ + Expected: SNat ('Succ (c :+: b)) + Actual: SNat b ‘b’ is a rigid type variable bound by the type signature for: foo :: forall (c :: Nat) (b :: Nat). SNat ('Succ c) -> SNat b -> SNat ('Succ (c :+: b)) at T12444.hs:18:1-55 - Expected type: SNat ('Succ (c :+: b)) - Actual type: SNat b • In the expression: x In an equation for ‘foo’: foo _ x = x • Relevant bindings include diff --git a/testsuite/tests/polykinds/T12593.stderr b/testsuite/tests/polykinds/T12593.stderr index fcf194ba50..5ce7b07187 100644 --- a/testsuite/tests/polykinds/T12593.stderr +++ b/testsuite/tests/polykinds/T12593.stderr @@ -1,9 +1,16 @@ +T12593.hs:11:16: error: + • Expected kind ‘k0 -> k1 -> *’, but ‘Free k k1 k2 p’ has kind ‘*’ + • In the type signature: + run :: k2 q => + Free k k1 k2 p a b + -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + T12593.hs:12:31: error: • Expecting one more argument to ‘k’ Expected a type, but ‘k’ has kind - ‘((k0 -> Constraint) -> k1 -> *) -> Constraint’ + ‘((k2 -> Constraint) -> k3 -> *) -> Constraint’ • In the kind ‘k’ In the type signature: run :: k2 q => diff --git a/testsuite/tests/polykinds/T14172.stderr b/testsuite/tests/polykinds/T14172.stderr index 6a0d3927eb..d27f45bb9c 100644 --- a/testsuite/tests/polykinds/T14172.stderr +++ b/testsuite/tests/polykinds/T14172.stderr @@ -11,12 +11,10 @@ T14172.hs:6:46: error: In the type ‘(a -> f b) -> g a -> f (h _)’ T14172.hs:7:19: error: - • Occurs check: cannot construct the infinite type: a ~ g'0 a - Expected type: (f'0 a -> f (f'0 b)) - -> Compose f'0 g'0 a -> f (h a') - Actual type: (Unwrapped (Compose f'0 g'0 a) - -> f (Unwrapped (h a'))) - -> Compose f'0 g'0 a -> f (h a') + • Couldn't match type ‘a’ with ‘g'0 a’ + Expected: (f'0 a -> f (f'0 b)) -> Compose f'0 g'0 a -> f (h a') + Actual: (Unwrapped (Compose f'0 g'0 a) -> f (Unwrapped (h a'))) + -> Compose f'0 g'0 a -> f (h a') • In the first argument of ‘(.)’, namely ‘_Wrapping Compose’ In the expression: _Wrapping Compose . traverse In an equation for ‘traverseCompose’: diff --git a/testsuite/tests/polykinds/T14265.stderr b/testsuite/tests/polykinds/T14265.stderr index fa951ad920..cf3ab9acf3 100644 --- a/testsuite/tests/polykinds/T14265.stderr +++ b/testsuite/tests/polykinds/T14265.stderr @@ -1,8 +1,8 @@ T14265.hs:7:12: error: - • Found type wildcard ‘_’ standing for ‘_ :: k’ - Where: ‘k’, ‘_’ are rigid type variables bound by - the inferred type of f :: proxy _ -> () + • Found type wildcard ‘_’ standing for ‘w :: k’ + Where: ‘k’, ‘w’ are rigid type variables bound by + the inferred type of f :: proxy w -> () at T14265.hs:8:1-8 To use the inferred type, enable PartialTypeSignatures • In the first argument of ‘proxy’, namely ‘_’ @@ -10,9 +10,9 @@ T14265.hs:7:12: error: In the type signature: f :: proxy _ -> () T14265.hs:10:15: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of foo :: StateT _ _1 () + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () at T14265.hs:11:1-15 To use the inferred type, enable PartialTypeSignatures • In the first argument of ‘StateT’, namely ‘_’ @@ -20,9 +20,9 @@ T14265.hs:10:15: error: In the type signature: foo :: StateT _ _ () T14265.hs:10:17: error: - • Found type wildcard ‘_’ standing for ‘_1 :: * -> *’ - Where: ‘_1’ is a rigid type variable bound by - the inferred type of foo :: StateT _ _1 () + • Found type wildcard ‘_’ standing for ‘w1 :: * -> *’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () at T14265.hs:11:1-15 To use the inferred type, enable PartialTypeSignatures • In the second argument of ‘StateT’, namely ‘_’ diff --git a/testsuite/tests/polykinds/T14520.stderr b/testsuite/tests/polykinds/T14520.stderr index b8a1ed1bf0..20e1b5cf33 100644 --- a/testsuite/tests/polykinds/T14520.stderr +++ b/testsuite/tests/polykinds/T14520.stderr @@ -2,5 +2,6 @@ T14520.hs:15:24: error: • Expected kind ‘bat w w’, but ‘Id’ has kind ‘XXX @a0 @(*) (XXX @a0 @(a0 ~>> *) kat0 b0) b0’ + The type variables ‘kat0’, ‘b0’ are ambiguous • In the first argument of ‘Sing’, namely ‘(Id :: bat w w)’ In the type signature: sId :: Sing w -> Sing (Id :: bat w w) diff --git a/testsuite/tests/polykinds/T14555.stderr b/testsuite/tests/polykinds/T14555.stderr index 66fb55ae4f..3861872124 100644 --- a/testsuite/tests/polykinds/T14555.stderr +++ b/testsuite/tests/polykinds/T14555.stderr @@ -1,6 +1,7 @@ T14555.hs:12:34: error: - • Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’ + • Couldn't match kind ‘rep’ with ‘'GHC.Types.LiftedRep’ + Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’ • In the second argument of ‘Exp’, namely ‘(a -> b)’ In the type ‘Exp xs (a -> b)’ In the definition of data constructor ‘Lam’ diff --git a/testsuite/tests/polykinds/T14563.stderr b/testsuite/tests/polykinds/T14563.stderr index 1265ec0e3a..2d81507659 100644 --- a/testsuite/tests/polykinds/T14563.stderr +++ b/testsuite/tests/polykinds/T14563.stderr @@ -1,6 +1,7 @@ T14563.hs:9:39: error: - • Expected kind ‘TYPE rep -> TYPE rep''’, + • Couldn't match kind ‘rep''’ with ‘'GHC.Types.LiftedRep’ + Expected kind ‘TYPE rep -> TYPE rep''’, but ‘h’ has kind ‘TYPE rep -> *’ • In the second argument of ‘Lan’, namely ‘h’ In the type ‘Lan g h a’ diff --git a/testsuite/tests/polykinds/T14580.stderr b/testsuite/tests/polykinds/T14580.stderr index 8658a8484a..154e191f7e 100644 --- a/testsuite/tests/polykinds/T14580.stderr +++ b/testsuite/tests/polykinds/T14580.stderr @@ -1,6 +1,7 @@ T14580.hs:8:32: error: - • Expected kind ‘Cat a’, but ‘iso :: cat a b’ has kind ‘cat a b’ + • Couldn't match kind ‘b’ with ‘a -> *’ + Expected kind ‘Cat a’, but ‘iso :: cat a b’ has kind ‘cat a b’ • In the first argument of ‘ISO’, namely ‘(iso :: cat a b)’ In the type ‘ISO (iso :: cat a b)’ In the type declaration for ‘<-->’ diff --git a/testsuite/tests/polykinds/T14846.stderr b/testsuite/tests/polykinds/T14846.stderr index edb19408b2..2d49b819a0 100644 --- a/testsuite/tests/polykinds/T14846.stderr +++ b/testsuite/tests/polykinds/T14846.stderr @@ -1,6 +1,8 @@ T14846.hs:38:8: error: • Couldn't match type ‘ríki’ with ‘Hom riki’ + Expected: ríki a a + Actual: Hom riki a a ‘ríki’ is a rigid type variable bound by the type signature for: i :: forall {k5} {k6} {cls3 :: k6 -> Constraint} (xx :: k5) @@ -8,8 +10,6 @@ T14846.hs:38:8: error: StructI xx a => ríki a a at T14846.hs:38:8-48 - Expected type: ríki a a - Actual type: Hom riki a a • When checking that instance signature for ‘i’ is more general than its signature in the class Instance sig: forall {k1} {k2} {cls :: k2 -> Constraint} (xx :: k1) @@ -22,35 +22,13 @@ T14846.hs:38:8: error: ríki a a In the instance declaration for ‘Category (Hom riki)’ -T14846.hs:39:12: error: - • Could not deduce (StructI xx1 structured0) - arising from a use of ‘struct’ - from the context: Category riki - bound by the instance declaration at T14846.hs:37:10-65 - or from: StructI xx a - bound by the type signature for: - i :: forall {k5} {k6} {cls3 :: k6 -> Constraint} (xx :: k5) - (a :: Struct cls3). - StructI xx a => - Hom riki a a - at T14846.hs:38:8-48 - The type variables ‘xx1’, ‘structured0’ are ambiguous - Relevant bindings include - i :: Hom riki a a (bound at T14846.hs:39:3) - These potential instance exist: - instance forall k (xx :: k) (cls :: k -> Constraint) - (structured :: Struct cls). - (Structured xx cls ~ structured, cls xx) => - StructI xx structured - -- Defined at T14846.hs:28:10 - • In the expression: struct :: AStruct (Structured a cls) - In the expression: case struct :: AStruct (Structured a cls) of - In an equation for ‘i’: - i = case struct :: AStruct (Structured a cls) of - T14846.hs:39:44: error: - • Expected kind ‘Struct cls3 -> Constraint’, + • Couldn't match kind ‘k4’ with ‘Struct cls3’ + Expected kind ‘Struct cls3 -> Constraint’, but ‘cls’ has kind ‘k4 -> Constraint’ + ‘k4’ is a rigid type variable bound by + the instance declaration + at T14846.hs:37:10-65 • In the second argument of ‘Structured’, namely ‘cls’ In the first argument of ‘AStruct’, namely ‘(Structured a cls)’ In an expression type signature: AStruct (Structured a cls) diff --git a/testsuite/tests/polykinds/T15881.stderr b/testsuite/tests/polykinds/T15881.stderr index 8f395735db..47cc5abf5c 100644 --- a/testsuite/tests/polykinds/T15881.stderr +++ b/testsuite/tests/polykinds/T15881.stderr @@ -1,6 +1,6 @@ T15881.hs:8:18: error: - • Occurs check: cannot construct the infinite kind: k0 ~ k0 -> * + • Expected kind ‘k0’, but ‘n’ has kind ‘k0 -> *’ • In the first argument of ‘n’, namely ‘n’ In the kind ‘n n’ In the data type declaration for ‘A’ diff --git a/testsuite/tests/polykinds/T16244.stderr b/testsuite/tests/polykinds/T16244.stderr index d261a70ba3..6b932ad285 100644 --- a/testsuite/tests/polykinds/T16244.stderr +++ b/testsuite/tests/polykinds/T16244.stderr @@ -1,6 +1,6 @@ T16244.hs:11:18: error: - • Couldn't match kind ‘k1’ with ‘k’ + • Expected kind ‘k’, but ‘b’ has kind ‘k1’ ‘k1’ is a rigid type variable bound by the class declaration for ‘C’ at T16244.hs:11:26 diff --git a/testsuite/tests/polykinds/T16245.stderr b/testsuite/tests/polykinds/T16245.stderr index e478fe4e5f..4f7cc415c2 100644 --- a/testsuite/tests/polykinds/T16245.stderr +++ b/testsuite/tests/polykinds/T16245.stderr @@ -1,6 +1,6 @@ T16245.hs:11:36: error: - • Couldn't match kind ‘k1’ with ‘k’ + • Expected kind ‘k’, but ‘b’ has kind ‘k1’ ‘k1’ is a rigid type variable bound by the class declaration for ‘C’ at T16245.hs:11:45 diff --git a/testsuite/tests/polykinds/T17841.stderr b/testsuite/tests/polykinds/T17841.stderr index 6157f55399..11243a4322 100644 --- a/testsuite/tests/polykinds/T17841.stderr +++ b/testsuite/tests/polykinds/T17841.stderr @@ -1,6 +1,9 @@ T17841.hs:7:45: error: • Expected a type, but ‘t’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by + the class declaration for ‘Foo’ + at T17841.hs:7:17 • In the kind ‘t’ In the first argument of ‘Proxy’, namely ‘(a :: t)’ In the type signature: foo :: Proxy (a :: t) diff --git a/testsuite/tests/polykinds/T17963.stderr b/testsuite/tests/polykinds/T17963.stderr index 84201e0de4..5cade1ded2 100644 --- a/testsuite/tests/polykinds/T17963.stderr +++ b/testsuite/tests/polykinds/T17963.stderr @@ -1,13 +1,12 @@ T17963.hs:15:23: error: - • Couldn't match a lifted type with an unlifted type - ‘rep1’ is a rigid type variable bound by - the class declaration for ‘Category'’ - at T17963.hs:13:27-29 + • Couldn't match kind ‘rep1’ with ‘'LiftedRep’ When matching kinds k0 :: * ob :: TYPE rep1 - Expected kind ‘ob’, but ‘a’ has kind ‘k0’ + ‘rep1’ is a rigid type variable bound by + the class declaration for ‘Category'’ + at T17963.hs:13:27-29 • In the first argument of ‘cat’, namely ‘a’ In the type signature: id' :: forall a. cat a a In the class declaration for ‘Category'’ diff --git a/testsuite/tests/polykinds/T7224.stderr b/testsuite/tests/polykinds/T7224.stderr index 774a4bce69..c9d2236206 100644 --- a/testsuite/tests/polykinds/T7224.stderr +++ b/testsuite/tests/polykinds/T7224.stderr @@ -1,12 +1,18 @@ T7224.hs:6:19: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ + ‘i’ is a rigid type variable bound by + the class declaration for ‘PMonad'’ + at T7224.hs:5:21 • In the first argument of ‘m’, namely ‘i’ In the type signature: ret' :: a -> m i i a In the class declaration for ‘PMonad'’ T7224.hs:7:14: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ + ‘i’ is a rigid type variable bound by + the class declaration for ‘PMonad'’ + at T7224.hs:5:21 • In the first argument of ‘m’, namely ‘i’ In the type signature: bind' :: m i j a -> (a -> m j k b) -> m i k b diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr index 5c5055ea2a..f59e44d5cd 100644 --- a/testsuite/tests/polykinds/T7230.stderr +++ b/testsuite/tests/polykinds/T7230.stderr @@ -19,8 +19,8 @@ T7230.hs:48:32: error: Sing x -> Sing xs -> Sing (x : xs), in an equation for ‘crash’ at T7230.hs:48:17-26 - Expected type: SBool (Increasing xs) - Actual type: SBool (x :<<= x1) + Expected: SBool (Increasing xs) + Actual: SBool (x :<<= x1) • In the expression: x %:<<= y In an equation for ‘crash’: crash (SCons x (SCons y xs)) = x %:<<= y diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr index 37b00a7a70..5f4ff6d18f 100644 --- a/testsuite/tests/polykinds/T7278.stderr +++ b/testsuite/tests/polykinds/T7278.stderr @@ -1,5 +1,8 @@ T7278.hs:9:43: error: - • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k1’ + • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’ + ‘k’ is a rigid type variable bound by + the type signature for ‘f’ + at T7278.hs:9:1-49 • In the type signature: f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0 diff --git a/testsuite/tests/polykinds/T7328.stderr b/testsuite/tests/polykinds/T7328.stderr index 76f81555dd..d1ba591512 100644 --- a/testsuite/tests/polykinds/T7328.stderr +++ b/testsuite/tests/polykinds/T7328.stderr @@ -1,6 +1,6 @@ T7328.hs:8:34: error: - • Occurs check: cannot construct the infinite kind: k1 ~ k0 -> k1 + • Expected kind ‘k1’, but ‘f’ has kind ‘k0 -> k1’ • In the first argument of ‘Foo’, namely ‘f’ In the first argument of ‘Proxy’, namely ‘(Foo f)’ In the type signature: foo :: a ~ f i => Proxy (Foo f) diff --git a/testsuite/tests/polykinds/T7594.stderr b/testsuite/tests/polykinds/T7594.stderr index 5632e97707..ea5484d464 100644 --- a/testsuite/tests/polykinds/T7594.stderr +++ b/testsuite/tests/polykinds/T7594.stderr @@ -1,6 +1,8 @@ T7594.hs:37:12: error: • Couldn't match type ‘b’ with ‘IO ()’ + Expected: a -> b + Actual: a -> IO () ‘b’ is untouchable inside the constraints: (:&:) c0 Real a bound by a type expected by the context: @@ -10,8 +12,6 @@ T7594.hs:37:12: error: the inferred type of bar2 :: b at T7594.hs:37:1-19 Possible fix: add a type signature for ‘bar2’ - Expected type: a -> b - Actual type: a -> IO () • In the first argument of ‘app’, namely ‘print’ In the expression: app print q2 In an equation for ‘bar2’: bar2 = app print q2 diff --git a/testsuite/tests/polykinds/T7805.stderr b/testsuite/tests/polykinds/T7805.stderr index 9ca48645be..869ecc9200 100644 --- a/testsuite/tests/polykinds/T7805.stderr +++ b/testsuite/tests/polykinds/T7805.stderr @@ -1,6 +1,8 @@ T7805.hs:7:21: error: - Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’ - In the first argument of ‘HR’, namely ‘x’ - In the first argument of ‘F’, namely ‘(HR x)’ - In the type instance declaration for ‘F’ + • Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall a. a -> a + • In the first argument of ‘HR’, namely ‘x’ + In the first argument of ‘F’, namely ‘(HR x)’ + In the type instance declaration for ‘F’ diff --git a/testsuite/tests/polykinds/T8616.stderr b/testsuite/tests/polykinds/T8616.stderr index 2a8b6482aa..653f3beb1a 100644 --- a/testsuite/tests/polykinds/T8616.stderr +++ b/testsuite/tests/polykinds/T8616.stderr @@ -1,24 +1,15 @@ T8616.hs:8:16: error: • Couldn't match kind ‘k1’ with ‘*’ + When matching types + Any :: k1 + Proxy kproxy :: * ‘k1’ is a rigid type variable bound by the type signature for: withSomeSing :: forall k1 (kproxy :: k1). Proxy kproxy at T8616.hs:7:1-52 - When matching types - a0 :: * - Any :: k1 • In the expression: undefined :: (Any :: k) In an equation for ‘withSomeSing’: withSomeSing = undefined :: (Any :: k) • Relevant bindings include withSomeSing :: Proxy kproxy (bound at T8616.hs:8:1) - -T8616.hs:8:30: error: - • Expected a type, but ‘Any :: k’ has kind ‘k1’ - • In an expression type signature: (Any :: k) - In the expression: undefined :: (Any :: k) - In an equation for ‘withSomeSing’: - withSomeSing = undefined :: (Any :: k) - • Relevant bindings include - withSomeSing :: Proxy kproxy (bound at T8616.hs:8:1) diff --git a/testsuite/tests/polykinds/T9017.stderr b/testsuite/tests/polykinds/T9017.stderr index 8acf58c9b5..2fc5bb1792 100644 --- a/testsuite/tests/polykinds/T9017.stderr +++ b/testsuite/tests/polykinds/T9017.stderr @@ -1,17 +1,17 @@ T9017.hs:8:7: error: • Couldn't match kind ‘k2’ with ‘*’ + When matching types + a0 :: * -> * -> * + a :: k2 -> k3 -> * + Expected: a b (m b) + Actual: a0 b0 (m0 b0) ‘k2’ is a rigid type variable bound by the type signature for: foo :: forall {k2} {k3} (a :: k2 -> k3 -> *) (b :: k2) (m :: k2 -> k3). a b (m b) at T9017.hs:7:1-16 - When matching types - a0 :: * -> * -> * - a :: k2 -> k3 -> * - Expected type: a b (m b) - Actual type: a0 a1 (m0 a1) • In the expression: arr return In an equation for ‘foo’: foo = arr return • Relevant bindings include diff --git a/testsuite/tests/polykinds/T9144.stderr b/testsuite/tests/polykinds/T9144.stderr index f58a57254b..dc3e13ed11 100644 --- a/testsuite/tests/polykinds/T9144.stderr +++ b/testsuite/tests/polykinds/T9144.stderr @@ -1,8 +1,8 @@ T9144.hs:34:26: error: • Couldn't match type ‘Integer’ with ‘FooTerm’ - Expected type: DemoteRep @Nat ('KProxy @Nat) - Actual type: DemoteRep @Foo ('KProxy @Foo) + Expected: DemoteRep @Nat ('KProxy @Nat) + Actual: DemoteRep @Foo ('KProxy @Foo) • In the first argument of ‘toSing’, namely ‘n’ In the expression: toSing n In the expression: diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs index 3af1458427..d033b4016f 100644 --- a/testsuite/tests/polykinds/T9222.hs +++ b/testsuite/tests/polykinds/T9222.hs @@ -10,5 +10,8 @@ import Data.Proxy -- So this program is erroneous. (But the original ticket was -- a crash, and that's still fixed!) +-- Apr 2020: with simple subsumption (#17775), the type isn't +-- ambiguous any more + data Want :: (i,j) -> Type where Want :: (a ~ '(b,c) => Proxy b) -> Want a diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr deleted file mode 100644 index c8e98be09a..0000000000 --- a/testsuite/tests/polykinds/T9222.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -T9222.hs:14:3: error: - • Couldn't match type ‘c0’ with ‘c’ - ‘c0’ is untouchable - inside the constraints: a ~ '(b0, c0) - bound by a type expected by the context: - (a ~ '(b0, c0)) => Proxy b0 - at T9222.hs:14:3-43 - ‘c’ is a rigid type variable bound by - the type of the constructor ‘Want’: - forall {k1} {j1} (a :: (k1, j1)) (b :: k1) (c :: j1). - ((a ~ '(b, c)) => Proxy b) -> Want a - at T9222.hs:14:3-43 - • In the ambiguity check for ‘Want’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the definition of data constructor ‘Want’ - In the data type declaration for ‘Want’ diff --git a/testsuite/tests/polykinds/T9569.hs b/testsuite/tests/polykinds/T9569.hs index 634d742803..112037461a 100644 --- a/testsuite/tests/polykinds/T9569.hs +++ b/testsuite/tests/polykinds/T9569.hs @@ -9,18 +9,42 @@ data Proxy (c :: Constraint) class Deferrable (c :: Constraint) where defer :: Proxy c -> (c => a) -> a -deferPair :: (Deferrable c1, Deferrable c2) => - Proxy (c1,c2) -> ((c1,c2) => a) -> a +deferPair :: (Deferrable c1, Deferrable c2) + => Proxy (c1,c2) -> (((c1,c2) :: Constraint) => a) -> a + -- NB: ((c1,c2) :: Constraint) => blah + -- is different form + -- (c1,c2) => blah + -- The former has dict, the latter has two deferPair _ _ = undefined instance (Deferrable c1, Deferrable c2) => Deferrable (c1,c2) where -- defer p f = deferPair p f -- Succeeds defer = deferPair -- Fails +{- Notes Apr 2020. +~~~~~~~~~~~~~~~~~ +Note the careful type for deferPair! You can also say + +deferPair :: (Deferrable c1, Deferrable c2, d ~ (c1,c2)) + => Proxy (c1,c2) -> (d => a) -> a + +but NOT + +deferPair :: (Deferrable c1, Deferrable c2) + => Proxy (c1,c2) -> ((c1,c2) => a) -> a + +The point is that + (c1,c2) => a +is short for + c1 => c2 => a +-} + {- [G] Deferrable c1, Deferrable c2 - [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a ~ Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax + [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a + ~ + Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax [w] Deferrable c1x [w] Deferrable c2x -} diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 87ee448e32..592c6b2fec 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -97,7 +97,7 @@ test('T8705', normal, compile, ['']) test('T8985', normal, compile, ['']) test('T9106', normal, compile_fail, ['']) test('T9144', normal, compile_fail, ['']) -test('T9222', normal, compile_fail, ['']) +test('T9222', normal, compile, ['']) test('T9264', normal, compile, ['']) test('T9263', normal, makefile_test, []) test('T9063', normal, compile, ['']) @@ -114,7 +114,7 @@ test('PolyInstances', normal, compile, ['']) test('T10041', normal, compile, ['']) test('T10451', normal, compile_fail, ['']) test('T10516', normal, compile_fail, ['']) -test('T10503', normal, compile_fail, ['']) +test('T10503', normal, compile, ['']) test('T10570', normal, compile_fail, ['']) test('T10670', normal, compile, ['']) test('T10670a', normal, compile, ['']) |