Commit 51036008 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Don't skip validity checks for built-in classes (#17355)

Issue #17355 occurred because the control flow for
`TcValidity.check_valid_inst_head` was structured in such a way that
whenever it checked a special, built-in class (like `Generic` or
`HasField`), it would skip the most important check of all:
`checkValidTypePats`, which rejects nonsense like this:

```hs
instance Generic (forall a. a)
```

This fixes the issue by carving out `checkValidTypePats` from
`check_valid_inst_head` so that `checkValidTypePats` is always
invoked. `check_valid_inst_head` has also been renamed to
`check_special_inst_head` to reflect its new purpose of _only_
checking for instances headed by special classes.

Fixes #17355.

(cherry picked from commit f375e3fb)
parent e8175bed
......@@ -1360,7 +1360,8 @@ checkValidInstHead ctxt clas cls_args
= do { dflags <- getDynFlags
; is_boot <- tcIsHsBootOrSig
; is_sig <- tcIsHsig
; check_valid_inst_head dflags is_boot is_sig ctxt clas cls_args
; check_special_inst_head dflags is_boot is_sig ctxt clas cls_args
; checkValidTypePats (classTyCon clas) cls_args
}
{-
......@@ -1388,10 +1389,10 @@ in hsig files, where `is_sig` is True.
-}
check_valid_inst_head :: DynFlags -> Bool -> Bool
-> UserTypeCtxt -> Class -> [Type] -> TcM ()
check_special_inst_head :: DynFlags -> Bool -> Bool
-> UserTypeCtxt -> Class -> [Type] -> TcM ()
-- Wow! There are a surprising number of ad-hoc special cases here.
check_valid_inst_head dflags is_boot is_sig ctxt clas cls_args
check_special_inst_head dflags is_boot is_sig ctxt clas cls_args
-- If not in an hs-boot file, abstract classes cannot have instances
| isAbstractClass clas
......@@ -1441,7 +1442,7 @@ check_valid_inst_head dflags is_boot is_sig ctxt clas cls_args
= failWithTc (instTypeErr clas cls_args msg)
| otherwise
= checkValidTypePats (classTyCon clas) cls_args
= pure ()
where
clas_nm = getName clas
ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args
......
Subproject commit a925aaa505d9259f26e2f3fb2ffa2e9b66b48749
Subproject commit f9979c926ca539362b5a2412359750e8b498e53a
{-# LANGUAGE RankNTypes, DataKinds #-}
module T17355 where
import GHC.Generics
import GHC.Records
data Foo = Foo { poly :: forall a. a -> a }
instance Generic (forall a . a)
instance HasField "myPoly" Foo (forall a. a -> a) where
getField (Foo x) = x
T17355.hs:9:10: error:
• Illegal polymorphic type: forall a. a
• In the instance declaration for ‘Generic (forall a. a)’
T17355.hs:10:10: error:
• Illegal polymorphic type: forall a. a -> a
• In the instance declaration for
‘HasField "myPoly" Foo (forall a. a -> a)’
4607
test('tcfail001', normal, compile_fail, [''])
test('tcfail002', normal, compile_fail, [''])
test('tcfail003', normal, compile_fail, [''])
......@@ -513,3 +512,4 @@ test('T16059e', [extra_files(['T16059b.hs'])], multimod_compile_fail,
test('T16255', normal, compile_fail, [''])
test('T16204c', normal, compile_fail, [''])
test('T16517', normal, compile_fail, [''])
test('T17355', normal, compile_fail, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment