[commit: ghc] wip/new-flatten-skolems-Oct14: Test Trac #9662 (f7a008e)
git at git.haskell.org
git at git.haskell.org
Fri Oct 31 22:44:37 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/new-flatten-skolems-Oct14
Link : http://ghc.haskell.org/trac/ghc/changeset/f7a008e35c3bda82ac8fbeec3670a675e4021b83/ghc
>---------------------------------------------------------------
commit f7a008e35c3bda82ac8fbeec3670a675e4021b83
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Oct 31 22:44:39 2014 +0000
Test Trac #9662
>---------------------------------------------------------------
f7a008e35c3bda82ac8fbeec3670a675e4021b83
testsuite/tests/indexed-types/should_fail/T9662.hs | 52 ++++++++++++++
.../tests/indexed-types/should_fail/T9662.stderr | 84 ++++++++++++++++++++++
testsuite/tests/indexed-types/should_fail/all.T | 1 +
3 files changed, 137 insertions(+)
diff --git a/testsuite/tests/indexed-types/should_fail/T9662.hs b/testsuite/tests/indexed-types/should_fail/T9662.hs
new file mode 100644
index 0000000..22b34a1
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9662.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+module T9662 where
+
+data Exp a = Exp
+data (a:.b) = a:.b
+
+type family Plain e :: *
+type instance Plain (Exp a) = a
+type instance Plain (a:.b) = Plain a :. Plain b
+
+class (Plain (Unlifted pattern) ~ Tuple pattern) => Unlift pattern where
+ type Unlifted pattern
+ type Tuple pattern
+
+modify :: (Unlift pattern) =>
+ pattern ->
+ (Unlifted pattern -> a) ->
+ Exp (Tuple pattern) -> Exp (Plain a)
+modify p f = undefined
+
+
+data Atom a = Atom
+
+atom :: Atom a
+atom = Atom
+
+
+instance (Unlift pa, int ~ Atom Int) => Unlift (pa :. int) where
+ type Unlifted (pa :. int) = Unlifted pa :. Exp Int
+ type Tuple (pa :. int) = Tuple pa :. Int
+
+
+data Shape sh = Shape
+
+backpermute ::
+ (Exp sh -> Exp sh') ->
+ (Exp sh' -> Exp sh) ->
+ Shape sh -> Shape sh'
+backpermute = undefined
+
+test :: Shape (sh:.k:.m:.n) -> Shape (sh:.m:.n:.k)
+test =
+ backpermute
+ (modify (atom:.atom:.atom:.atom)
+ (\(sh:.k:.m:.n) -> (sh:.m:.n:.k)))
+ id
+{-
+ (modify (atom:.atom:.atom:.atom)
+ (\(ix:.m:.n:.k) -> (ix:.k:.m:.n)))
+-}
diff --git a/testsuite/tests/indexed-types/should_fail/T9662.stderr b/testsuite/tests/indexed-types/should_fail/T9662.stderr
new file mode 100644
index 0000000..ad804ab
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9662.stderr
@@ -0,0 +1,84 @@
+
+T9662.hs:46:8:
+ Couldn't match type ‘k’ with ‘Int’
+ ‘k’ is a rigid type variable bound by
+ the type signature for
+ test :: Shape (((sh :. k) :. m) :. n)
+ -> Shape (((sh :. m) :. n) :. k)
+ at T9662.hs:43:9
+ Expected type: Exp (((sh :. k) :. m) :. n)
+ -> Exp (((sh :. m) :. n) :. k)
+ Actual type: Exp
+ (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int))
+ -> Exp
+ (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int))
+ Relevant bindings include
+ test :: Shape (((sh :. k) :. m) :. n)
+ -> Shape (((sh :. m) :. n) :. k)
+ (bound at T9662.hs:44:1)
+ In the first argument of ‘backpermute’, namely
+ ‘(modify
+ (atom :. atom :. atom :. atom)
+ (\ (sh :. k :. m :. n) -> (sh :. m :. n :. k)))’
+ In the expression:
+ backpermute
+ (modify
+ (atom :. atom :. atom :. atom)
+ (\ (sh :. k :. m :. n) -> (sh :. m :. n :. k)))
+ id
+
+T9662.hs:46:8:
+ Couldn't match type ‘m’ with ‘Int’
+ ‘m’ is a rigid type variable bound by
+ the type signature for
+ test :: Shape (((sh :. k) :. m) :. n)
+ -> Shape (((sh :. m) :. n) :. k)
+ at T9662.hs:43:9
+ Expected type: Exp (((sh :. k) :. m) :. n)
+ -> Exp (((sh :. m) :. n) :. k)
+ Actual type: Exp
+ (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int))
+ -> Exp
+ (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int))
+ Relevant bindings include
+ test :: Shape (((sh :. k) :. m) :. n)
+ -> Shape (((sh :. m) :. n) :. k)
+ (bound at T9662.hs:44:1)
+ In the first argument of ‘backpermute’, namely
+ ‘(modify
+ (atom :. atom :. atom :. atom)
+ (\ (sh :. k :. m :. n) -> (sh :. m :. n :. k)))’
+ In the expression:
+ backpermute
+ (modify
+ (atom :. atom :. atom :. atom)
+ (\ (sh :. k :. m :. n) -> (sh :. m :. n :. k)))
+ id
+
+T9662.hs:46:8:
+ Couldn't match type ‘n’ with ‘Int’
+ ‘n’ is a rigid type variable bound by
+ the type signature for
+ test :: Shape (((sh :. k) :. m) :. n)
+ -> Shape (((sh :. m) :. n) :. k)
+ at T9662.hs:43:9
+ Expected type: Exp (((sh :. k) :. m) :. n)
+ -> Exp (((sh :. m) :. n) :. k)
+ Actual type: Exp
+ (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int))
+ -> Exp
+ (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int))
+ Relevant bindings include
+ test :: Shape (((sh :. k) :. m) :. n)
+ -> Shape (((sh :. m) :. n) :. k)
+ (bound at T9662.hs:44:1)
+ In the first argument of ‘backpermute’, namely
+ ‘(modify
+ (atom :. atom :. atom :. atom)
+ (\ (sh :. k :. m :. n) -> (sh :. m :. n :. k)))’
+ In the expression:
+ backpermute
+ (modify
+ (atom :. atom :. atom :. atom)
+ (\ (sh :. k :. m :. n) -> (sh :. m :. n :. k)))
+ id
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index 1e2c43d..71c89d9 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -129,4 +129,5 @@ test('T9371', normal, compile_fail, [''])
test('T9433', normal, compile_fail, [''])
test('BadSock', normal, compile_fail, [''])
test('T9580', normal, multimod_compile_fail, ['T9580', ''])
+test('T9662', normal, compile_fail, [''])
More information about the ghc-commits
mailing list