diff options
| author | Bartosz Nitka <niteria@gmail.com> | 2016-05-16 12:47:25 -0700 |
|---|---|---|
| committer | Bartosz Nitka <niteria@gmail.com> | 2016-07-25 07:37:43 -0700 |
| commit | 1c59d376b2073f47de936ff49e463e0e1320f779 (patch) | |
| tree | 1e51ed2e359f6c0219c58fa4bfe69f55211510c9 | |
| parent | ae94a31e7f162b4a3ef6b6f837bd6006a98f639a (diff) | |
| download | haskell-1c59d376b2073f47de936ff49e463e0e1320f779.tar.gz | |
Make accept
This updates some test output after it got reordered by
determinism fixes. There's no corresponding commit
in the master branch.
46 files changed, 672 insertions, 86 deletions
diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr index 6e877617dc..f1cc36c5d6 100644 --- a/testsuite/tests/ado/ado004.stderr +++ b/testsuite/tests/ado/ado004.stderr @@ -2,23 +2,23 @@ TYPE SIGNATURES test1 :: forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int test2 :: - forall (f :: * -> *) b t. - (Applicative f, Num t, Num b) => + forall t b (f :: * -> *). + (Num b, Num t, Applicative f) => (t -> f b) -> f b test3 :: - forall (m :: * -> *) a t t1. - (Num t, Monad m) => - (t -> m t1) -> (t1 -> t1 -> m a) -> m a + forall a t (m :: * -> *) t1. + (Num t1, Monad m) => + (t1 -> m t) -> (t -> t -> m a) -> m a test4 :: - forall (m :: * -> *) a a1 t. + forall a a1 (m :: * -> *) t. (Num t, Monad m) => (t -> m a1) -> (a1 -> a1 -> m a) -> m a test5 :: - forall (m :: * -> *) a a1 t. + forall a a1 (m :: * -> *) t. (Num t, Monad m) => (t -> m a1) -> (a1 -> a1 -> m a) -> m a test6 :: - forall t (m :: * -> *) a. + forall a (m :: * -> *) t. (Num (m a), Monad m) => (m a -> m (m a)) -> t -> m a TYPE CONSTRUCTORS diff --git a/testsuite/tests/determinism/determ007/A.hs b/testsuite/tests/determinism/determ007/A.hs new file mode 100644 index 0000000000..9cc1705e45 --- /dev/null +++ b/testsuite/tests/determinism/determ007/A.hs @@ -0,0 +1,3 @@ +module A where + +data ADT a b = Z a b deriving Eq diff --git a/testsuite/tests/determinism/determ007/Makefile b/testsuite/tests/determinism/determ007/Makefile new file mode 100644 index 0000000000..c95e3f0fb9 --- /dev/null +++ b/testsuite/tests/determinism/determ007/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ007: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -O -dinitial-unique=16777215 -dunique-increment=-1 A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ007/all.T b/testsuite/tests/determinism/determ007/all.T new file mode 100644 index 0000000000..6d818588ba --- /dev/null +++ b/testsuite/tests/determinism/determ007/all.T @@ -0,0 +1,4 @@ +test('determ007', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ007']) diff --git a/testsuite/tests/determinism/determ007/determ007.stdout b/testsuite/tests/determinism/determ007/determ007.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ007/determ007.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ008/A.hs b/testsuite/tests/determinism/determ008/A.hs new file mode 100644 index 0000000000..df61b65108 --- /dev/null +++ b/testsuite/tests/determinism/determ008/A.hs @@ -0,0 +1,3 @@ +module A where + +data F a b = F { x :: !Int, y :: !(Float,Float), z :: !(a,b) } diff --git a/testsuite/tests/determinism/determ008/Makefile b/testsuite/tests/determinism/determ008/Makefile new file mode 100644 index 0000000000..eec3bccb0d --- /dev/null +++ b/testsuite/tests/determinism/determ008/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ008: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -O -dinitial-unique=16777215 -dunique-increment=-1 A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ008/all.T b/testsuite/tests/determinism/determ008/all.T new file mode 100644 index 0000000000..af4d8d7948 --- /dev/null +++ b/testsuite/tests/determinism/determ008/all.T @@ -0,0 +1,4 @@ +test('determ008', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ008']) diff --git a/testsuite/tests/determinism/determ008/determ008.stdout b/testsuite/tests/determinism/determ008/determ008.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ008/determ008.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ009/A.hs b/testsuite/tests/determinism/determ009/A.hs new file mode 100644 index 0000000000..4a8de21bc0 --- /dev/null +++ b/testsuite/tests/determinism/determ009/A.hs @@ -0,0 +1,4 @@ +module A where + +newtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)} + deriving Eq diff --git a/testsuite/tests/determinism/determ009/Makefile b/testsuite/tests/determinism/determ009/Makefile new file mode 100644 index 0000000000..caceae48b6 --- /dev/null +++ b/testsuite/tests/determinism/determ009/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ009: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ009/all.T b/testsuite/tests/determinism/determ009/all.T new file mode 100644 index 0000000000..7cae393162 --- /dev/null +++ b/testsuite/tests/determinism/determ009/all.T @@ -0,0 +1,4 @@ +test('determ009', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ009']) diff --git a/testsuite/tests/determinism/determ009/determ009.stdout b/testsuite/tests/determinism/determ009/determ009.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ009/determ009.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ011/A.hs b/testsuite/tests/determinism/determ011/A.hs new file mode 100644 index 0000000000..6e65c8ddce --- /dev/null +++ b/testsuite/tests/determinism/determ011/A.hs @@ -0,0 +1,26 @@ +module A where + +-- Reproduces an issue where rules would abstract over typeclass dictionaries +-- non-deterministically. +-- +-- Compare: +-- +-- RULES: "SPECLOL $csize" [ALWAYS] +-- forall ($dOrd_a1sc :: Ord Int) ($dNum_a1sd :: Num Int). +-- $csize_a1sg @ Int $dOrd_a1sc $dNum_a1sd +-- = $s$csize_d1zr] +-- with: +-- +-- RULES: "SPEC $csize" [ALWAYS] +-- forall ($dNum_a18n42 :: Num Int) ($dOrd_a18n43 :: Ord Int). +-- $csize_a18n3Z @ Int $dOrd_a18n43 $dNum_a18n42 +-- = $s$csize_d18mWO] + +class Size t where + size :: t -> t -> Int + +instance (Ord a, Num a) => Size [a] where + {-# SPECIALISE instance Size [Int] #-} + size (x:xs) (y:ys) | x+y > 4 = size xs ys + | otherwise = size xs ys + size _ _ = 0 diff --git a/testsuite/tests/determinism/determ011/Makefile b/testsuite/tests/determinism/determ011/Makefile new file mode 100644 index 0000000000..f50ed595ab --- /dev/null +++ b/testsuite/tests/determinism/determ011/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ011: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ011/all.T b/testsuite/tests/determinism/determ011/all.T new file mode 100644 index 0000000000..ba9ef62a18 --- /dev/null +++ b/testsuite/tests/determinism/determ011/all.T @@ -0,0 +1,4 @@ +test('determ011', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ011']) diff --git a/testsuite/tests/determinism/determ011/determ011.stdout b/testsuite/tests/determinism/determ011/determ011.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ011/determ011.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ012/A.hs b/testsuite/tests/determinism/determ012/A.hs new file mode 100644 index 0000000000..a61b2bc294 --- /dev/null +++ b/testsuite/tests/determinism/determ012/A.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FunctionalDependencies, + UndecidableInstances, FlexibleInstances #-} + +module T10109 where + +data Succ a + +class Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab +instance (Add a b ab) => Add (Succ a) b (Succ ab) + diff --git a/testsuite/tests/determinism/determ012/Makefile b/testsuite/tests/determinism/determ012/Makefile new file mode 100644 index 0000000000..307d9b57fe --- /dev/null +++ b/testsuite/tests/determinism/determ012/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ012: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ012/all.T b/testsuite/tests/determinism/determ012/all.T new file mode 100644 index 0000000000..f493d4241b --- /dev/null +++ b/testsuite/tests/determinism/determ012/all.T @@ -0,0 +1,4 @@ +test('determ012', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ012']) diff --git a/testsuite/tests/determinism/determ012/determ012.stdout b/testsuite/tests/determinism/determ012/determ012.stdout new file mode 100644 index 0000000000..713550b6a3 --- /dev/null +++ b/testsuite/tests/determinism/determ012/determ012.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling T10109 ( A.hs, A.o ) +[1 of 1] Compiling T10109 ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ013/A.hs b/testsuite/tests/determinism/determ013/A.hs new file mode 100644 index 0000000000..e2415a7f95 --- /dev/null +++ b/testsuite/tests/determinism/determ013/A.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators, + UndecidableInstances #-} + +module T9063 where + +import Data.Type.Equality +import Data.Proxy + +-- reproduces an issue where type variables in the axiom are in +-- non-deterministic order + +class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where + type FunnyEq (x :: a) (y :: a) :: Bool + type FunnyEq x y = x == y + +instance PEq ('KProxy :: KProxy Bool) + +foo :: Proxy (FunnyEq True True) -> Proxy (True == True) +foo = id diff --git a/testsuite/tests/determinism/determ013/Makefile b/testsuite/tests/determinism/determ013/Makefile new file mode 100644 index 0000000000..a28a13fa36 --- /dev/null +++ b/testsuite/tests/determinism/determ013/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ013: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ013/all.T b/testsuite/tests/determinism/determ013/all.T new file mode 100644 index 0000000000..0804f039a6 --- /dev/null +++ b/testsuite/tests/determinism/determ013/all.T @@ -0,0 +1,4 @@ +test('determ013', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ013']) diff --git a/testsuite/tests/determinism/determ013/determ013.stdout b/testsuite/tests/determinism/determ013/determ013.stdout new file mode 100644 index 0000000000..103261b5bc --- /dev/null +++ b/testsuite/tests/determinism/determ013/determ013.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling T9063 ( A.hs, A.o ) +[1 of 1] Compiling T9063 ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ014/A.hs b/testsuite/tests/determinism/determ014/A.hs new file mode 100644 index 0000000000..fb7a538ebd --- /dev/null +++ b/testsuite/tests/determinism/determ014/A.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE + ScopedTypeVariables + , DataKinds + , GADTs + , RankNTypes + , TypeOperators + , PolyKinds -- Comment out PolyKinds and the bug goes away. + #-} +{-# OPTIONS_GHC -O #-} + -- The bug is in SimplUtils.abstractFloats, so we need -O to trigger it + +module KeyValue where + +data AccValidation err a = AccFailure err | AccSuccess a + +data KeyValueError = MissingValue + +type WithKeyValueError = AccValidation [KeyValueError] + +missing :: forall f rs. RecApplicative rs => Rec (WithKeyValueError :. f) rs +missing = rpure missingField + where + missingField :: forall x. (WithKeyValueError :. f) x + missingField = Compose $ AccFailure [MissingValue] + +data Rec :: (u -> *) -> [u] -> * where + RNil :: Rec f '[] + (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs) + +newtype Compose (f :: l -> *) (g :: k -> l) (x :: k) + = Compose { getCompose :: f (g x) } + +type (:.) f g = Compose f g + +class RecApplicative rs where + rpure + :: (forall x. f x) + -> Rec f rs diff --git a/testsuite/tests/determinism/determ014/Makefile b/testsuite/tests/determinism/determ014/Makefile new file mode 100644 index 0000000000..d170232d76 --- /dev/null +++ b/testsuite/tests/determinism/determ014/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ014: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ014/all.T b/testsuite/tests/determinism/determ014/all.T new file mode 100644 index 0000000000..4d376f2d99 --- /dev/null +++ b/testsuite/tests/determinism/determ014/all.T @@ -0,0 +1,4 @@ +test('determ014', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ014']) diff --git a/testsuite/tests/determinism/determ014/determ014.stdout b/testsuite/tests/determinism/determ014/determ014.stdout new file mode 100644 index 0000000000..2607792b31 --- /dev/null +++ b/testsuite/tests/determinism/determ014/determ014.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling KeyValue ( A.hs, A.o ) +[1 of 1] Compiling KeyValue ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ015/A.hs b/testsuite/tests/determinism/determ015/A.hs new file mode 100644 index 0000000000..14b29170b1 --- /dev/null +++ b/testsuite/tests/determinism/determ015/A.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module A where + +infixr 7 :* +infix 8 :*: + +data HNil +data α :* β +type HSingle α = α :* HNil +type α :*: β = α :* β :* HNil + +data HList l where + HNil ∷ HList HNil + (:*) ∷ α → HList t → HList (α :* t) + +data First +data Next p + +data HIndex i where + First ∷ HIndex First + Next ∷ HIndex p → HIndex (Next p) + +class (l ~ (HHead l :* HTail l)) ⇒ HNonEmpty l where + type HHead l + type HTail l + +instance HNonEmpty (h :* t) where + type HHead (h :* t) = h + type HTail (h :* t) = t + +data HFromWitness n l where + HFromFirst ∷ HFromWitness First l + HFromNext ∷ (HNonEmpty l, HFromClass p (HTail l), + HTail (HFrom (Next p) l) ~ HFrom (Next p) (HTail l)) + ⇒ HFromWitness (Next p) l + +class HFromClass n l where + type HFrom n l + hFromWitness ∷ HFromWitness n l + +instance HFromClass First l where + type HFrom First l = l + hFromWitness = HFromFirst + +instance (HNonEmpty l, HFromClass p (HTail l)) ⇒ HFromClass (Next p) l where + type HFrom (Next p) l = HFrom p (HTail l) + hFromWitness = case hFromWitness ∷ HFromWitness p (HTail l) of + HFromFirst → HFromNext + HFromNext → HFromNext diff --git a/testsuite/tests/determinism/determ015/Makefile b/testsuite/tests/determinism/determ015/Makefile new file mode 100644 index 0000000000..4ba32f0e02 --- /dev/null +++ b/testsuite/tests/determinism/determ015/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ015: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ015/all.T b/testsuite/tests/determinism/determ015/all.T new file mode 100644 index 0000000000..e4d65f43b3 --- /dev/null +++ b/testsuite/tests/determinism/determ015/all.T @@ -0,0 +1,4 @@ +test('determ015', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ015']) diff --git a/testsuite/tests/determinism/determ015/determ015.stdout b/testsuite/tests/determinism/determ015/determ015.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ015/determ015.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ016/A.hs b/testsuite/tests/determinism/determ016/A.hs new file mode 100644 index 0000000000..81aa34d66d --- /dev/null +++ b/testsuite/tests/determinism/determ016/A.hs @@ -0,0 +1,19 @@ + +{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS -w #-} + +module A where + +data PSum a b = Empty | Tree a b [(PSum a b)] + +extractMinX ∷ (Ord a, Eq b, Num b) ⇒ PSum a b → ((a,b), PSum a b) +extractMinX Empty = undefined +extractMinX (Tree v r xs) = ((v,r), Empty) + +toListX ∷ (Ord a, Eq b, Num b) ⇒ PSum a b → [(a,b)] +toListX Empty = [] +toListX x = let (y, z) = extractMinX x in y : toListX z + +main ∷ IO () +main = print $ take 20 $ toListX $ (Empty :: PSum Int Int) diff --git a/testsuite/tests/determinism/determ016/Makefile b/testsuite/tests/determinism/determ016/Makefile new file mode 100644 index 0000000000..f6d0009fbb --- /dev/null +++ b/testsuite/tests/determinism/determ016/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ016: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ016/all.T b/testsuite/tests/determinism/determ016/all.T new file mode 100644 index 0000000000..40fa202002 --- /dev/null +++ b/testsuite/tests/determinism/determ016/all.T @@ -0,0 +1,4 @@ +test('determ016', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ016']) diff --git a/testsuite/tests/determinism/determ016/determ016.stdout b/testsuite/tests/determinism/determ016/determ016.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ016/determ016.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/determinism/determ017/A.hs b/testsuite/tests/determinism/determ017/A.hs new file mode 100644 index 0000000000..2540be4b29 --- /dev/null +++ b/testsuite/tests/determinism/determ017/A.hs @@ -0,0 +1,215 @@ +{- + Copyright 2009 Mario Blazevic + + This file is part of the Streaming Component Combinators (SCC) project. + + The SCC project is free software: you can redistribute it and/or + modify it under the terms of the GNU General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + SCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with SCC. If not, see <http://www.gnu.org/licenses/>. +-} + +-- | Module "Trampoline" defines the pipe computations and their basic building blocks. + +{-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, + TypeFamilies, KindSignatures, FlexibleContexts, + FlexibleInstances, OverlappingInstances, UndecidableInstances + #-} + +{- Somewhere we get: + + Wanted: AncestorFunctor (EitherFunctor a (TryYield a)) d + This should not reduce because of overlapping instances + + If it (erroneously) does reduce, via dfun2 we get + Wanted: Functor (EitherFunctor a (TryYield a) + Functor d' + Functor d + d ~ EitherFunctor d' s + AncestorFunctor (EitherFunctor a (TryYield a) d' + + + And that gives an infinite loop in the type checker! +-} + +{-# OPTIONS -w #-} + +module A where + +import Control.Monad (liftM, liftM2, when, ap) +-- import Control.Monad.Identity + +import Debug.Trace (trace) + + +------------- +class (Functor a, Functor d) => AncestorFunctor a d where + liftFunctor :: a x -> d x + +-- dfun 1 +instance Functor a => AncestorFunctor a a where + liftFunctor = trace "liftFunctor id" . id + +-- dfun 2 +instance ( Functor a + , Functor d' + , Functor d + , d ~ EitherFunctor d' s + , AncestorFunctor a d') + => AncestorFunctor a d where + liftFunctor = LeftF . (trace "liftFunctor other" . liftFunctor :: a x -> d' x) + +------------- +newtype Identity a = Identity { runIdentity :: a } + +instance Functor Identity where + fmap = liftM + +instance Applicative Identity where + pure = return + (<*>) = ap + +instance Monad Identity where + return a = Identity a + m >>= k = k (runIdentity m) + +newtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)} +data TrampolineState m s r = Done r | Suspend! (s (Trampoline m s r)) + +instance (Monad m, Functor s) => Functor (Trampoline m s) where + fmap = liftM + +instance (Monad m, Functor s) => Applicative (Trampoline m s) where + pure = return + (<*>) = ap + +instance (Monad m, Functor s) => Monad (Trampoline m s) where + return x = Trampoline (return (Done x)) + t >>= f = Trampoline (bounce t >>= apply f) + where apply f (Done x) = bounce (f x) + apply f (Suspend s) = return (Suspend (fmap (>>= f) s)) + +data Yield x y = Yield! x y +instance Functor (Yield x) where + fmap f (Yield x y) = trace "fmap yield" $ Yield x (f y) + +data Await x y = Await! (x -> y) +instance Functor (Await x) where + fmap f (Await g) = trace "fmap await" $ Await (f . g) + +data EitherFunctor l r x = LeftF (l x) | RightF (r x) +instance (Functor l, Functor r) => Functor (EitherFunctor l r) where + fmap f v = trace "fmap Either" $ + case v of + LeftF l -> trace "fmap LeftF" $ LeftF (fmap f l) + RightF r -> trace "fmap RightF" $ RightF (fmap f r) + +type TryYield x = EitherFunctor (Yield x) (Await Bool) + +suspend :: (Monad m, Functor s) => s (Trampoline m s x) -> Trampoline m s x +suspend s = Trampoline (return (Suspend s)) + +yield :: forall m x. Monad m => x -> Trampoline m (Yield x) () +yield x = suspend (Yield x (return ())) + +await :: forall m x. Monad m => Trampoline m (Await x) x +await = suspend (Await return) + +tryYield :: forall m x. Monad m => x -> Trampoline m (TryYield x) Bool +tryYield x = suspend (LeftF (Yield x (suspend (RightF (Await return))))) + +canYield :: forall m x. Monad m => Trampoline m (TryYield x) Bool +canYield = suspend (RightF (Await return)) + +liftBounce :: Monad m => m x -> Trampoline m s x +liftBounce = Trampoline . liftM Done + +fromTrampoline :: Monad m => Trampoline m s x -> m x +fromTrampoline t = bounce t >>= \(Done x)-> return x + +runTrampoline :: Monad m => Trampoline m Maybe x -> m x +runTrampoline = fromTrampoline + +coupleNestedFinite :: (Functor s, Monad m) => + Trampoline m (EitherFunctor s (TryYield a)) x + -> Trampoline m (EitherFunctor s (Await (Maybe a))) y -> Trampoline m s (x, y) +coupleNestedFinite t1 t2 = + trace "bounce start" $ + liftBounce (liftM2 (,) (bounce t1) (bounce t2)) + >>= \(s1, s2)-> trace "bounce end" $ + case (s1, s2) + of (Done x, Done y) -> return (x, y) + (Done x, Suspend (RightF (Await c2))) -> coupleNestedFinite (return x) (c2 Nothing) + (Suspend (RightF (LeftF (Yield _ c1))), Done y) -> coupleNestedFinite c1 (return y) + (Suspend (RightF (LeftF (Yield x c1))), Suspend (RightF (Await c2))) -> coupleNestedFinite c1 (c2 $ Just x) + (Suspend (RightF (RightF (Await c1))), Suspend s2@(RightF Await{})) -> coupleNestedFinite (c1 True) (suspend s2) + (Suspend (RightF (RightF (Await c1))), Done y) -> coupleNestedFinite (c1 False) (return y) + (Suspend (LeftF s), Done y) -> suspend (fmap (flip coupleNestedFinite (return y)) s) + (Done x, Suspend (LeftF s)) -> suspend (fmap (coupleNestedFinite (return x)) s) + (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNestedFinite $ suspend $ LeftF s1) s2) + (Suspend (LeftF s1), Suspend (RightF s2)) -> suspend (fmap (flip coupleNestedFinite (suspend $ RightF s2)) s1) + (Suspend (RightF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNestedFinite (suspend $ RightF s1)) s2) + +local :: forall m l r x. (Monad m, Functor r) => Trampoline m r x -> Trampoline m (EitherFunctor l r) x +local (Trampoline mr) = Trampoline (liftM inject mr) + where inject :: TrampolineState m r x -> TrampolineState m (EitherFunctor l r) x + inject (Done x) = Done x + inject (Suspend r) = Suspend (RightF $ fmap local r) + +out :: forall m l r x. (Monad m, Functor l) => Trampoline m l x -> Trampoline m (EitherFunctor l r) x +out (Trampoline ml) = Trampoline (liftM inject ml) + where inject :: TrampolineState m l x -> TrampolineState m (EitherFunctor l r) x + inject (Done x) = Done x + inject (Suspend l) = Suspend (LeftF $ fmap out l) + +liftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoline m a x -> Trampoline m d x +liftOut (Trampoline ma) = trace "liftOut" $ Trampoline (liftM inject ma) + where inject :: TrampolineState m a x -> TrampolineState m d x + inject (Done x) = Done x + inject (Suspend a) = trace "inject suspend" $ Suspend (liftFunctor $ trace "calling fmap" $ + fmap liftOut (trace "poking a" a)) + +data Sink (m :: * -> *) a x = + Sink {put :: forall d. (AncestorFunctor (EitherFunctor a (TryYield x)) d) => x -> Trampoline m d Bool, + canPut :: forall d. (AncestorFunctor (EitherFunctor a (TryYield x)) d) => Trampoline m d Bool} +newtype Source (m :: * -> *) a x = + Source {get :: forall d. (AncestorFunctor (EitherFunctor a (Await (Maybe x))) d) => Trampoline m d (Maybe x)} + +pipe :: forall m a x r1 r2. (Monad m, Functor a) => + (Sink m a x -> Trampoline m (EitherFunctor a (TryYield x)) r1) + -> (Source m a x -> Trampoline m (EitherFunctor a (Await (Maybe x))) r2) -> Trampoline m a (r1, r2) +pipe producer consumer = coupleNestedFinite (producer sink) (consumer source) where + sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline m (EitherFunctor a (TryYield x)) Bool), + canPut= liftOut (local canYield :: Trampoline m (EitherFunctor a (TryYield x)) Bool)} :: Sink m a x + source = Source (liftOut (local await :: Trampoline m (EitherFunctor a (Await (Maybe x))) (Maybe x))) :: Source m a x + +pipeProducer sink = do put sink 1 + (c, d) <- pipe + (\sink'-> do put sink' 2 + put sink 3 + put sink' 4 + return 5) + (\source'-> do Just n <- get source' + put sink n + put sink 6 + return n) + put sink c + put sink d + return (c, d) + +testPipe = print $ + runIdentity $ + runTrampoline $ + do (a, b) <- pipe + pipeProducer + (\source-> do Just n1 <- get source + return (n1, n1, n1)) + return (a, b) diff --git a/testsuite/tests/determinism/determ017/Makefile b/testsuite/tests/determinism/determ017/Makefile new file mode 100644 index 0000000000..6881e4318a --- /dev/null +++ b/testsuite/tests/determinism/determ017/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ017: + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=0 -dunique-increment=1 -O A.hs + $(CP) A.hi A.normal.hi + $(RM) A.hi A.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777215 -dunique-increment=-1 -O A.hs + diff A.hi A.normal.hi diff --git a/testsuite/tests/determinism/determ017/all.T b/testsuite/tests/determinism/determ017/all.T new file mode 100644 index 0000000000..8bff33b1fd --- /dev/null +++ b/testsuite/tests/determinism/determ017/all.T @@ -0,0 +1,4 @@ +test('determ017', + extra_clean(['A.o', 'A.hi', 'A.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ017']) diff --git a/testsuite/tests/determinism/determ017/determ017.stdout b/testsuite/tests/determinism/determ017/determ017.stdout new file mode 100644 index 0000000000..60c2bc368d --- /dev/null +++ b/testsuite/tests/determinism/determ017/determ017.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling A ( A.hs, A.o ) +[1 of 1] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr index 2b43dff8c9..463b66fcbf 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr @@ -5,7 +5,7 @@ Use :print or :force to determine these types Relevant bindings include it :: t (bound at <interactive>:4:1) These potential instances exist: - instance (Show a, Show b) => Show (Either a b) + instance (Show b, Show a) => Show (Either a b) -- Defined in ‘Data.Either’ instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ @@ -20,7 +20,7 @@ Use :print or :force to determine these types Relevant bindings include it :: t (bound at <interactive>:6:1) These potential instances exist: - instance (Show a, Show b) => Show (Either a b) + instance (Show b, Show a) => Show (Either a b) -- Defined in ‘Data.Either’ instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ diff --git a/testsuite/tests/ghci/scripts/T6018ghcifail.stderr b/testsuite/tests/ghci/scripts/T6018ghcifail.stderr index 110092d514..bdc6fe5a9d 100644 --- a/testsuite/tests/ghci/scripts/T6018ghcifail.stderr +++ b/testsuite/tests/ghci/scripts/T6018ghcifail.stderr @@ -56,7 +56,7 @@ Kind variable ‘k’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall k (a :: k) (b :: k). + forall k (b :: k) (a :: k). Fc a b = Int -- Defined at <interactive>:64:15 <interactive>:68:15: error: @@ -65,7 +65,7 @@ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall k (a :: k) (b :: k). + forall k (b :: k) (a :: k). Gc a b = Int -- Defined at <interactive>:68:15 <interactive>:81:15: error: diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index dcde1114e1..dc10d40638 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -3,7 +3,7 @@ T5095.hs:9:9: error: • Overlapping instances for Eq a arising from a use of ‘==’ Matching instances: instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31 - instance (Eq a, Eq b) => Eq (Either a b) + instance (Eq b, Eq a) => Eq (Either a b) -- Defined in ‘Data.Either’ instance Eq Ordering -- Defined in ‘GHC.Classes’ ...plus 24 others diff --git a/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr b/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr index c151553a3a..25fe0d26b2 100644 --- a/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr @@ -1,96 +1,96 @@ T6018failclosed.hs:11:5: error: - Type family equation violates injectivity annotation. - RHS of injective type family equation cannot be a type family: - IdProxyClosed a = IdClosed a -- Defined at T6018failclosed.hs:11:5 - In the equations for closed type family ‘IdProxyClosed’ - In the type family declaration for ‘IdProxyClosed’ + • Type family equation violates injectivity annotation. + RHS of injective type family equation cannot be a type family: + IdProxyClosed a = IdClosed a -- Defined at T6018failclosed.hs:11:5 + • In the equations for closed type family ‘IdProxyClosed’ + In the type family declaration for ‘IdProxyClosed’ T6018failclosed.hs:19:5: error: - Type family equation violates injectivity annotation. - RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘'Z’ - PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 - In the equations for closed type family ‘PClosed’ - In the type family declaration for ‘PClosed’ + • Type family equation violates injectivity annotation. + RHS of injective type family equation is a bare type variable + but these LHS type and kind patterns are not bare variables: ‘'Z’ + PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 + • In the equations for closed type family ‘PClosed’ + In the type family declaration for ‘PClosed’ T6018failclosed.hs:19:5: error: - Type family equations violate injectivity annotation: - PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 - PClosed ('S n) m = 'S (PClosed n m) - -- Defined at T6018failclosed.hs:20:5 - In the equations for closed type family ‘PClosed’ - In the type family declaration for ‘PClosed’ + • Type family equations violate injectivity annotation: + PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 + PClosed ('S n) m = 'S (PClosed n m) + -- Defined at T6018failclosed.hs:20:5 + • In the equations for closed type family ‘PClosed’ + In the type family declaration for ‘PClosed’ T6018failclosed.hs:25:5: error: - Type family equation violates injectivity annotation. - Type and kind variables ‘k’, ‘b’ - cannot be inferred from the right-hand side. - (enabling -fprint-explicit-kinds might help) - In the type family equation: - forall k k1 (b :: k) (c :: k1). - JClosed Int b c = Char -- Defined at T6018failclosed.hs:25:5 - In the equations for closed type family ‘JClosed’ - In the type family declaration for ‘JClosed’ + • Type family equation violates injectivity annotation. + Type and kind variables ‘k1’, ‘b’ + cannot be inferred from the right-hand side. + (enabling -fprint-explicit-kinds might help) + In the type family equation: + forall k k1 (c :: k) (b :: k1). + JClosed Int b c = Char -- Defined at T6018failclosed.hs:25:5 + • In the equations for closed type family ‘JClosed’ + In the type family declaration for ‘JClosed’ T6018failclosed.hs:30:5: error: - Type family equation violates injectivity annotation. - Type variable ‘n’ cannot be inferred from the right-hand side. - In the type family equation: - KClosed ('S n) m = 'S m -- Defined at T6018failclosed.hs:30:5 - In the equations for closed type family ‘KClosed’ - In the type family declaration for ‘KClosed’ + • Type family equation violates injectivity annotation. + Type variable ‘n’ cannot be inferred from the right-hand side. + In the type family equation: + KClosed ('S n) m = 'S m -- Defined at T6018failclosed.hs:30:5 + • In the equations for closed type family ‘KClosed’ + In the type family declaration for ‘KClosed’ T6018failclosed.hs:35:5: error: - Type family equation violates injectivity annotation. - RHS of injective type family equation cannot be a type family: - forall k (a :: k). - LClosed a = MaybeSynClosed a -- Defined at T6018failclosed.hs:35:5 - In the equations for closed type family ‘LClosed’ - In the type family declaration for ‘LClosed’ + • Type family equation violates injectivity annotation. + RHS of injective type family equation cannot be a type family: + forall k (a :: k). + LClosed a = MaybeSynClosed a -- Defined at T6018failclosed.hs:35:5 + • In the equations for closed type family ‘LClosed’ + In the type family declaration for ‘LClosed’ T6018failclosed.hs:39:5: error: - Type family equations violate injectivity annotation: - FClosed Char Bool Int = Int -- Defined at T6018failclosed.hs:39:5 - FClosed Bool Int Char = Int -- Defined at T6018failclosed.hs:40:5 - In the equations for closed type family ‘FClosed’ - In the type family declaration for ‘FClosed’ + • Type family equations violate injectivity annotation: + FClosed Char Bool Int = Int -- Defined at T6018failclosed.hs:39:5 + FClosed Bool Int Char = Int -- Defined at T6018failclosed.hs:40:5 + • In the equations for closed type family ‘FClosed’ + In the type family declaration for ‘FClosed’ T6018failclosed.hs:43:5: error: - Type family equations violate injectivity annotation: - IClosed Int Char Bool = Bool -- Defined at T6018failclosed.hs:43:5 - IClosed Int Int Int = Bool -- Defined at T6018failclosed.hs:44:5 - In the equations for closed type family ‘IClosed’ - In the type family declaration for ‘IClosed’ + • Type family equations violate injectivity annotation: + IClosed Int Char Bool = Bool -- Defined at T6018failclosed.hs:43:5 + IClosed Int Int Int = Bool -- Defined at T6018failclosed.hs:44:5 + • In the equations for closed type family ‘IClosed’ + In the type family declaration for ‘IClosed’ T6018failclosed.hs:49:3: error: - Type family equations violate injectivity annotation: - E2 'True = 'False -- Defined at T6018failclosed.hs:49:3 - E2 a = 'False -- Defined at T6018failclosed.hs:50:3 - In the equations for closed type family ‘E2’ - In the type family declaration for ‘E2’ + • Type family equations violate injectivity annotation: + E2 'True = 'False -- Defined at T6018failclosed.hs:49:3 + E2 a = 'False -- Defined at T6018failclosed.hs:50:3 + • In the equations for closed type family ‘E2’ + In the type family declaration for ‘E2’ T6018failclosed.hs:50:3: error: - Type family equation violates injectivity annotation. - Type variable ‘a’ cannot be inferred from the right-hand side. - In the type family equation: - E2 a = 'False -- Defined at T6018failclosed.hs:50:3 - In the equations for closed type family ‘E2’ - In the type family declaration for ‘E2’ + • Type family equation violates injectivity annotation. + Type variable ‘a’ cannot be inferred from the right-hand side. + In the type family equation: + E2 a = 'False -- Defined at T6018failclosed.hs:50:3 + • In the equations for closed type family ‘E2’ + In the type family declaration for ‘E2’ T6018failclosed.hs:61:3: error: - Type family equations violate injectivity annotation: - F a IO = IO a -- Defined at T6018failclosed.hs:61:3 - F Char b = b Int -- Defined at T6018failclosed.hs:62:3 - In the equations for closed type family ‘F’ - In the type family declaration for ‘F’ + • Type family equations violate injectivity annotation: + F a IO = IO a -- Defined at T6018failclosed.hs:61:3 + F Char b = b Int -- Defined at T6018failclosed.hs:62:3 + • In the equations for closed type family ‘F’ + In the type family declaration for ‘F’ T6018failclosed.hs:66:5: error: - Type family equation violates injectivity annotation. - Kind variable ‘k’ cannot be inferred from the right-hand side. - (enabling -fprint-explicit-kinds might help) - In the type family equation: - forall k (a :: k) (b :: k). - Gc a b = Int -- Defined at T6018failclosed.hs:66:5 - In the equations for closed type family ‘Gc’ - In the type family declaration for ‘Gc’ + • Type family equation violates injectivity annotation. + Kind variable ‘k’ cannot be inferred from the right-hand side. + (enabling -fprint-explicit-kinds might help) + In the type family equation: + forall k (b :: k) (a :: k). + Gc a b = Int -- Defined at T6018failclosed.hs:66:5 + • In the equations for closed type family ‘Gc’ + In the type family declaration for ‘Gc’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr index 72dc14e9c9..a2b602cb98 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr @@ -9,7 +9,7 @@ tcfail133.hs:68:7: error: These potential instances exist: instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ - instance (Show a, Show b, Number a, Digit b) => Show (a :@ b) + instance (Show b, Show a, Digit b, Number a) => Show (a :@ b) -- Defined at tcfail133.hs:11:54 ...plus 25 others ...plus five instances involving out-of-scope types |