[Git][ghc/ghc][wip/T22696] validDerivPred: Reject non-type-variable constraints in IrredPreds
Ryan Scott (@RyanGlScott)
gitlab at gitlab.haskell.org
Wed Mar 22 22:22:52 UTC 2023
Ryan Scott pushed to branch wip/T22696 at Glasgow Haskell Compiler / GHC
Commits:
100f0eb7 by Ryan Scott at 2023-03-22T18:22:40-04:00
validDerivPred: Reject non-type-variable constraints in IrredPreds
This brings the `IrredPred` case in sync with the general wisdom in `Note
[Exotic derived instance contexts]`. Namely, we should reject arbitrarily
complex constraints that are inferred from `deriving` clauses. This has the
nice property that `deriving` clauses whose inferred instance context mention
`TypeError` will now emit the type error in the resulting error message, which
better matches existing intuitions about how `TypeError` should work.
This changes the behavior of `deriving` in a way that existing code might
break, so I have made a mention of this in the GHC User's Guide. It seems very,
very unlikely that much code is relying on this strange behavior, however, and
even if it is, there is a clear migration path using `StandaloneDeriving`.
Fixes #22696.
- - - - -
8 changed files:
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Validity.hs
- docs/users_guide/9.8.1-notes.rst
- + testsuite/tests/deriving/should_compile/T22696.hs
- testsuite/tests/deriving/should_compile/all.T
- testsuite/tests/deriving/should_compile/T14339.hs → testsuite/tests/deriving/should_fail/T14339.hs
- + testsuite/tests/deriving/should_fail/T14339.stderr
- testsuite/tests/deriving/should_fail/all.T
Changes:
=====================================
compiler/GHC/Tc/Deriv/Infer.hs
=====================================
@@ -1057,13 +1057,41 @@ case where we really want that instance decl for C.
So for now we simply require that the derived instance context
should have only type-variable constraints.
-Here is another example:
- data Fix f = In (f (Fix f)) deriving( Eq )
-Here, if we are prepared to allow -XUndecidableInstances we
-could derive the instance
+Here are some other notable examples:
+
+* data Fix f = In (f (Fix f)) deriving( Eq )
+
+ Here, if we are prepared to allow -XUndecidableInstances we
+ could derive the instance
+
instance Eq (f (Fix f)) => Eq (Fix f)
-but this is so delicate that I don't think it should happen inside
-'deriving'. If you want this, write it yourself!
+
+ but this is so delicate that I don't think it should happen inside
+ 'deriving'. If you want this, write it yourself using StandaloneDeriving!
+
+* Derived instances whose instance context would mention TypeError, such
+ as the code from the deriving/should_fail/T14339 test case:
+
+ newtype Foo = Foo Int
+
+ class Bar a where
+ bar :: a
+
+ instance (TypeError (Text "Boo")) => Bar Foo where
+ bar = undefined
+
+ newtype Baz = Baz Foo
+ deriving Bar
+
+ The `deriving Bar` clause would generate this instance:
+
+ instance TypeError (Text "Boo") => Bar Baz
+
+ Because `TypeError ...` is not a type-variable constraint, we reject it. This
+ has the desirable side effect of causing the TypeError to fire in the
+ resulting error message. Again, if you want a derived instance like this, you
+ will have to write it yourself using StandaloneDeriving. (See
+ deriving/should_compile/T22696 for an example of this.)
NB: if you want to lift this condition, make sure you still meet the
termination conditions! If not, the deriving mechanism generates
=====================================
compiler/GHC/Tc/Validity.hs
=====================================
@@ -1762,14 +1762,26 @@ validDerivPred head_size pred
visible_tys = filterOutInvisibleTypes (classTyCon cls) tys -- (VD2)
IrredPred {} -> check_size (pSizeType pred)
- -- Very important that we do the "too many variable occurrences"
- -- check here, via check_size. Example (test T21302):
+ && isEmptyUniqSet (tyConsOfType pred)
+ -- The reasons why we each of these conditions:
+ --
+ -- - `check_size (pSizeType pred)`:
+ --
+ -- This perform a "too many variable occurrences" check via
+ -- check_size. Example (test T21302):
+ --
-- instance c Eq a => Eq (BoxAssoc a)
-- data BAD = BAD (BoxAssoc Int) deriving( Eq )
- -- We don't want to accept an inferred predicate (c0 Eq Int)
+ --
+ -- We don't want to accept an inferred predicate (c0 Eq Int)
-- from that `deriving(Eq)` clause, because the c0 is fresh,
-- so we'll think it's a "new" one, and loop in
- -- GHC.Tc.Deriv.Infer.simplifyInstanceContexts
+ -- GHC.Tc.Deriv.Infer.simplifyInstanceContexts.
+ --
+ -- - `isEmptyUniqSet (tyConsOfType pred)`:
+ --
+ -- This checks that the predicate does not mention any type
+ -- constructors. See Note [Exotic derived instance contexts].
where
check_size pred_size = isNothing (pred_size `ltPatersonSize` head_size)
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -35,6 +35,31 @@ Compiler
- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``.
See GHC ticket #23049.
+- Data types with ``deriving`` clauses now reject inferred instance contexts
+ that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as
+ this one: ::
+
+ newtype Foo = Foo Int
+
+ class Bar a where
+ bar :: a
+
+ instance (TypeError (Text "Boo")) => Bar Foo where
+ bar = undefined
+
+ newtype Baz = Baz Foo
+ deriving Bar
+
+ Here, the derived ``Bar`` instance for ``Baz`` would look like this: ::
+
+ instance TypeError (Text "Boo") => Bar Baz
+
+ While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``"
+ in the resulting error message. If you really want to derive this instance and
+ defer the error to sites where the instance is used, you must do so manually
+ with :extension:`StandaloneDeriving`, e.g. ::
+
+ deriving instance TypeError (Text "Boo") => Bar Baz
GHCi
~~~~
=====================================
testsuite/tests/deriving/should_compile/T22696.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+module T22696 where
+
+import GHC.TypeLits
+
+newtype Foo = Foo Int
+
+class Bar a where
+ bar :: a
+
+instance (TypeError (Text "Boo")) => Bar Foo where
+ bar = undefined
+
+newtype Baz = Baz Foo
+
+deriving instance TypeError (Text "Boo") => Bar Baz
=====================================
testsuite/tests/deriving/should_compile/all.T
=====================================
@@ -101,7 +101,6 @@ test('T13919', normal, compile, [''])
test('T13998', normal, compile, [''])
test('T14045b', normal, compile, [''])
test('T14094', normal, compile, [''])
-test('T14339', normal, compile, [''])
test('T14331', normal, compile, [''])
test('T14332', normal, compile, [''])
test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques'])
@@ -140,3 +139,4 @@ test('T20501', normal, compile, [''])
test('T20719', normal, compile, [''])
test('T20994', normal, compile, [''])
test('T22167', normal, compile, [''])
+test('T22696', normal, compile, [''])
=====================================
testsuite/tests/deriving/should_compile/T14339.hs → testsuite/tests/deriving/should_fail/T14339.hs
=====================================
@@ -16,10 +16,10 @@ instance (TypeError (Text "Boo")) => Bar Foo where
newtype Baz = Baz Foo
deriving Bar
--- Apparently we derive
+-- We derive:
+--
-- instance TypeError (Text "Boo") => Bar Baz
--
--- Is that really what we want? It defers the type
--- error... surely we should use standalone deriving
--- if that is what we want?
--- See GHC.Tc.Validity.validDerivPred and #22696.
\ No newline at end of file
+-- And error out due to the TypeError. See also deriving/should_compile/T22696,
+-- which uses StandaloneDeriving to write a valid instance with a TypeError
+-- constraint in its instance context.
=====================================
testsuite/tests/deriving/should_fail/T14339.stderr
=====================================
@@ -0,0 +1,4 @@
+
+T14339.hs:17:12: error: [GHC-64725]
+ • Boo
+ • When deriving the instance for (Bar Baz)
=====================================
testsuite/tests/deriving/should_fail/all.T
=====================================
@@ -69,6 +69,7 @@ test('T12801', normal, compile_fail, [''])
test('T13154c', normal, compile_fail, [''])
test('T14365', [extra_files(['T14365B.hs','T14365B.hs-boot'])],
multimod_compile_fail, ['T14365A',''])
+test('T14339', normal, compile_fail, [''])
test('T14728a', normal, compile_fail, [''])
test('T14728b', normal, compile_fail, [''])
test('T14916', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/100f0eb7a8f178d0dfc5213ac12cf9a66f309f3d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/100f0eb7a8f178d0dfc5213ac12cf9a66f309f3d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230322/e57cb985/attachment-0001.html>
More information about the ghc-commits
mailing list