summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-03-24 18:44:08 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2020-03-24 18:44:28 -0400
commit5a775e62f1d8a5186e115a8ad958ad76714d3fc5 (patch)
tree59a3185a08652dd178dfe1bb009ba0a75f4d19da
parent2643ba465cd2a133b6f495f34fc59cd1a6d23525 (diff)
downloadhaskell-wip/T17955.tar.gz
Run checkNewDataCon before constraint-solving newtype constructorswip/T17955
Within `checkValidDataCon`, we used to run `checkValidType` on the argument types of a newtype constructor before running `checkNewDataCon`, which ensures that the user does not attempt non-sensical things such as newtypes with multiple arguments or constraints. This works out in most situations, but this falls over on a corner case revealed in #17955: ```hs newtype T = Coercible () T => T () ``` `checkValidType`, among other things, peforms an ambiguity check on the context of a data constructor, and that it turn invokes the constraint solver. It turns out that there is a special case in the constraint solver for representational equalities (read: `Coercible` constraints) that causes newtypes to be unwrapped (see `Note [Unwrap newtypes first]` in `TcCanonical`). This special case does not know how to cope with an ill formed newtype like `T`, so it ends up panicking. The solution is surprisingly simple: just invoke `checkNewDataCon` before `checkValidType` to ensure that the illicit newtype constructor context is detected before the constraint solver can run amok with it. Fixes #17955.
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs12
-rw-r--r--testsuite/tests/typecheck/should_fail/T17955.hs6
-rw-r--r--testsuite/tests/typecheck/should_fail/T17955.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T1
4 files changed, 21 insertions, 4 deletions
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index e85f471432..05a2a433a9 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -3992,9 +3992,6 @@ checkValidDataCon dflags existential_ok tc con
-- Reason: it's really the argument of an equality constraint
; checkValidMonoType orig_res_ty
- -- Check all argument types for validity
- ; checkValidType ctxt (dataConUserType con)
-
-- If we are dealing with a newtype, we allow levity polymorphism
-- regardless of whether or not UnliftedNewtypes is enabled. A
-- later check in checkNewDataCon handles this, producing a
@@ -4002,9 +3999,16 @@ checkValidDataCon dflags existential_ok tc con
; unless (isNewTyCon tc)
(mapM_ (checkForLevPoly empty) (dataConOrigArgTys con))
- -- Extra checks for newtype data constructors
+ -- Extra checks for newtype data constructors. Importantly, these
+ -- checks /must/ come before the call to checkValidType below. This
+ -- is because checkValidType invokes the constraint solver, and
+ -- invoking the solver on an ill formed newtype constructor can
+ -- confuse GHC to the point of panicking. See #17955 for an example.
; when (isNewTyCon tc) (checkNewDataCon con)
+ -- Check all argument types for validity
+ ; checkValidType ctxt (dataConUserType con)
+
-- Check that existentials are allowed if they are used
; checkTc (existential_ok || isVanillaDataCon con)
(badExistential con)
diff --git a/testsuite/tests/typecheck/should_fail/T17955.hs b/testsuite/tests/typecheck/should_fail/T17955.hs
new file mode 100644
index 0000000000..1bcb9a6d90
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17955.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+module T17955 where
+
+import Data.Coerce
+
+newtype T = Coercible () T => T ()
diff --git a/testsuite/tests/typecheck/should_fail/T17955.stderr b/testsuite/tests/typecheck/should_fail/T17955.stderr
new file mode 100644
index 0000000000..0762facf45
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17955.stderr
@@ -0,0 +1,6 @@
+
+T17955.hs:6:13: error:
+ • A newtype constructor cannot have a context in its type
+ T :: Coercible () T => () -> T
+ • In the definition of data constructor ‘T’
+ In the newtype declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 60e50ca241..1c2e55624a 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -557,3 +557,4 @@ test('T17566c', normal, compile_fail, [''])
test('T17773', normal, compile_fail, [''])
test('T17021', normal, compile_fail, [''])
test('T17021b', normal, compile_fail, [''])
+test('T17955', normal, compile_fail, [''])