[commit: ghc] ghc-7.10: Fixes (hopefully!) T9858 (7adecba)
git at git.haskell.org
git at git.haskell.org
Mon May 11 11:47:21 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-7.10
Link : http://ghc.haskell.org/trac/ghc/changeset/7adecba752789f4a20ea0acf91720d3fb53e6007/ghc
>---------------------------------------------------------------
commit 7adecba752789f4a20ea0acf91720d3fb53e6007
Author: Iavor S. Diatchki <diatchki at galois.com>
Date: Thu Apr 16 11:13:24 2015 -0700
Fixes (hopefully!) T9858
The changes are:
1. No impredicative types in `Typeable`
2. Distinguish normal tuples, from tuples of constraints.
(cherry picked from commit d8d541d85defcf3bbbddaeee8cfac70b74f47ffc)
>---------------------------------------------------------------
7adecba752789f4a20ea0acf91720d3fb53e6007
compiler/deSugar/DsBinds.hs | 6 +++-
compiler/typecheck/TcInteract.hs | 34 +++++++++-------------
testsuite/tests/typecheck/should_fail/T9858b.hs | 10 +++++++
.../tests/typecheck/should_fail/T9858b.stderr | 8 +++++
testsuite/tests/typecheck/should_fail/all.T | 1 +
testsuite/tests/typecheck/should_run/T9858c.hs | 19 ++++++++++++
testsuite/tests/typecheck/should_run/T9858c.stdout | 1 +
testsuite/tests/typecheck/should_run/all.T | 1 +
8 files changed, 58 insertions(+), 22 deletions(-)
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 51679a8..72f0801 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -41,10 +41,11 @@ import Module
import PrelNames
import TysPrim ( mkProxyPrimTy )
import TyCon ( isTupleTyCon, tyConDataCons_maybe
- , tyConName, isPromotedTyCon, isPromotedDataCon )
+ , tyConName, isPromotedTyCon, isPromotedDataCon, tyConKind )
import TcEvidence
import TcType
import Type
+import Kind (returnsConstraintKind)
import Coercion hiding (substCo)
import TysWiredIn ( eqBoxDataCon, coercibleDataCon, tupleCon )
import Id
@@ -1014,6 +1015,9 @@ dsEvTypeable ev =
hash_name_fs
| isPromotedTyCon tc = appendFS (mkFastString "$k") name_fs
| isPromotedDataCon tc = appendFS (mkFastString "$c") name_fs
+ | isTupleTyCon tc &&
+ returnsConstraintKind (tyConKind tc)
+ = appendFS (mkFastString "$p") name_fs
| otherwise = name_fs
hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, hash_name_fs]
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 7c03e46..62e106c 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -12,7 +12,7 @@ import TcCanonical
import TcFlatten
import VarSet
import Type
-import Kind (isKind, isConstraintKind)
+import Kind (isKind, isConstraintKind )
import Unify
import InstEnv( lookupInstEnv, instanceDFunId )
import CoAxiom(sfInteractTop, sfInteractInert)
@@ -2130,10 +2130,14 @@ Other notes:
-- | Assumes that we've checked that this is the 'Typeable' class,
-- and it was applied to the correc arugment.
matchTypeableClass :: Class -> Kind -> Type -> CtLoc -> TcS LookupInstResult
-matchTypeableClass clas k t loc
+matchTypeableClass clas _k t loc
+
+ -- See Note [No Typeable for qualified types]
| isForAllTy t = return NoInstance
- | isConstraintKind k = return NoInstance
- -- See Note [No Typeable for qualified types]
+ -- Is the type of the form `C => t`?
+ | Just (t1,_) <- splitFunTy_maybe t,
+ isConstraintKind (typeKind t1) = return NoInstance
+
| Just (tc, ks) <- splitTyConApp_maybe t
, all isKind ks = doTyCon tc ks
| Just (f,kt) <- splitAppTy_maybe t = doTyApp f kt
@@ -2186,8 +2190,6 @@ matchTypeableClass clas k t loc
We do not support impredicative typeable, such as
Typeable (forall a. a->a)
Typeable (Eq a => a -> a)
- Typeable (Eq a)
- Typeable (() :: Constraint)
Typeable (() => Int)
Typeable (((),()) => Int)
@@ -2198,19 +2200,9 @@ a TypeRep for them. For qualified but not polymorphic types, like
* We don't need a TypeRep for these things. TypeReps are for
monotypes only.
- * The types (Eq a, Show a) => ...blah...
- and Eq a => Show a => ...blah...
- are represented the same way, as a curried function;
- that is, the tuple before the '=>' is just syntactic
- sugar. But since we can abstract over tuples of constraints,
- we really do have tuples of constraints as well.
-
- This dichotomy is not well worked out, and Trac #9858 comment:76
- shows that Typeable treated it one way, while newtype instance
- matching treated it another. Or maybe it was the fact that
- '*' and Constraint are distinct to the type checker, but are
- the same afterwards. Anyway, the result was a function of
- type (forall ab. a -> b), which is pretty dire.
-
-So the simple solution is not to attempt Typable for constraints.
+ * Perhaps we could treat `=>` as another type constructor for `Typeable`
+ purposes, and thus support things like `Eq Int => Int`, however,
+ at the current state of affairs this would be an odd exception as
+ no other class works with impredicative types.
+ For now we leave it off, until we have a better story for impredicativity.
-}
diff --git a/testsuite/tests/typecheck/should_fail/T9858b.hs b/testsuite/tests/typecheck/should_fail/T9858b.hs
new file mode 100644
index 0000000..643002f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9858b.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module T9858b where
+import Data.Typeable
+
+test = typeRep (Proxy :: Proxy (Eq Int => Int))
+
+
+
diff --git a/testsuite/tests/typecheck/should_fail/T9858b.stderr b/testsuite/tests/typecheck/should_fail/T9858b.stderr
new file mode 100644
index 0000000..b57098e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9858b.stderr
@@ -0,0 +1,8 @@
+
+T9858b.hs:7:8: error:
+ No instance for (Typeable (Eq Int => Int))
+ (maybe you haven't applied a function to enough arguments?)
+ arising from a use of ‘typeRep’
+ In the expression: typeRep (Proxy :: Proxy (Eq Int => Int))
+ In an equation for ‘test’:
+ test = typeRep (Proxy :: Proxy (Eq Int => Int))
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 482b622..de01268 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -360,3 +360,4 @@ test('T10285',
extra_clean(['T10285a.hi', 'T10285a.o']),
multimod_compile_fail, ['T10285', '-v0'])
test('T9858a', normal, compile_fail, [''])
+test('T9858b', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_run/T9858c.hs b/testsuite/tests/typecheck/should_run/T9858c.hs
new file mode 100644
index 0000000..7120715
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T9858c.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE KindSignatures #-}
+module Main(main) where
+
+import Data.Typeable
+import GHC.Exts
+
+test1 :: Bool
+test1 = typeRep (Proxy :: Proxy (() :: *)) ==
+ typeRep (Proxy :: Proxy (() :: Constraint))
+
+test2 :: Bool
+test2 = typeRepTyCon (typeRep (Proxy :: Proxy (Int,Int))) ==
+ typeRepTyCon (typeRep (Proxy :: Proxy (Eq Int, Eq Int)))
+
+main :: IO ()
+main = print (test1,test2)
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T9858c.stdout b/testsuite/tests/typecheck/should_run/T9858c.stdout
new file mode 100644
index 0000000..78a8f06
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T9858c.stdout
@@ -0,0 +1 @@
+(False,False)
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index 1301c17..990688f 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -116,3 +116,4 @@ test('T9497a-run', [exit_code(1)], compile_and_run, ['-fdefer-typed-holes'])
test('T9497b-run', [exit_code(1)], compile_and_run, ['-fdefer-typed-holes -fno-warn-typed-holes'])
test('T9497c-run', [exit_code(1)], compile_and_run, ['-fdefer-type-errors -fno-warn-typed-holes'])
test('T9858b', normal, compile_and_run, [''])
+test('T9858c', normal, compile_and_run, [''])
More information about the ghc-commits
mailing list