diff options
author | Richard Eisenberg <rae@richarde.dev> | 2021-09-30 18:09:57 -0400 |
---|---|---|
committer | Zubin <zubin.duggal@gmail.com> | 2021-10-13 12:43:38 +0000 |
commit | 68c76415c52d3db1199c623b96585d02e0d40b0d (patch) | |
tree | a52da54f28761d7e70aa538f1ade9bfc0bb04e24 | |
parent | 19cd403bced51bc27a11f0257c25497154e86889 (diff) | |
download | haskell-68c76415c52d3db1199c623b96585d02e0d40b0d.tar.gz |
Care about specificity in pattern type argswip/T20443
Close #20443.
-rw-r--r-- | compiler/GHC/Tc/Gen/Pat.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T20443a.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T20443b.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T20443b.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 |
6 files changed, 40 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index 78a4e22901..f008442857 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -1212,9 +1212,11 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of { checkTc (con_arity == no_of_args) -- Check correct arity (arityErr (text "constructor") con_like con_arity no_of_args) - ; let con_binders = conLikeUserTyVarBinders con_like - ; checkTc (type_args `leLength` con_binders) - (conTyArgArityErr con_like (length con_binders) (length type_args)) + -- forgetting to filter out inferred binders led to #20443 + ; let con_spec_binders = filter ((== SpecifiedSpec) . binderArgFlag) $ + conLikeUserTyVarBinders con_like + ; checkTc (type_args `leLength` con_spec_binders) + (conTyArgArityErr con_like (length con_spec_binders) (length type_args)) ; let pats_w_tys = zipEqual "tcConArgs" arg_pats arg_tys ; (type_args', (arg_pats', res)) @@ -1224,7 +1226,7 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of -- This unification is straight from Figure 7 of -- "Type Variables in Patterns", Haskell'18 ; _ <- zipWithM (unifyType Nothing) type_args' (substTyVars tenv $ - binderVars con_binders) + binderVars con_spec_binders) -- OK to drop coercions here. These unifications are all about -- guiding inference based on a user-written type annotation -- See Note [Typechecking type applications in patterns] diff --git a/testsuite/tests/typecheck/should_compile/T20443a.hs b/testsuite/tests/typecheck/should_compile/T20443a.hs new file mode 100644 index 0000000000..c4b552a3f2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T20443a.hs @@ -0,0 +1,13 @@ +module T20443a where + +import Data.Kind + +data Proxy t where + Proxy :: forall {k} (t :: k) . Proxy t + +a :: () -> Proxy Int +-- a = Proxy @Type @Int -- This would, rightfully, not compile +a () = Proxy @Int + +b :: Proxy Int -> () +b (Proxy @Int) = () -- This should compile, but doesn't diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index ca903c6295..49d380016d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -688,6 +688,7 @@ test('T16204b', normal, compile, ['']) test('T16225', normal, compile, ['']) test('T13951', normal, compile, ['']) test('T16312', normal, compile, ['-O']) +test('T20443a', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) test('T16827', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T20443b.hs b/testsuite/tests/typecheck/should_fail/T20443b.hs new file mode 100644 index 0000000000..03b44f343d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T20443b.hs @@ -0,0 +1,13 @@ +module T20443b where + +import Data.Kind + +data Proxy t where + Proxy :: forall {k} (t :: k) . Proxy t + +a :: () -> Proxy Int +-- a = Proxy @Type @Int -- This would, rightfully, not compile +a () = Proxy @Int + +b :: Proxy Int -> () +b (Proxy @Type @Int) = () diff --git a/testsuite/tests/typecheck/should_fail/T20443b.stderr b/testsuite/tests/typecheck/should_fail/T20443b.stderr new file mode 100644 index 0000000000..050b945db0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T20443b.stderr @@ -0,0 +1,6 @@ + +T20443b.hs:13:4: error: + • Too many type arguments in constructor pattern for ‘Proxy’ + Expected no more than 1; got 2 + • In the pattern: Proxy @Type @Int + In an equation for ‘b’: b (Proxy @Type @Int) = () diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 37bbc911b9..65d85e23fa 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -582,6 +582,7 @@ test('ExplicitSpecificity9', normal, compile_fail, ['']) test('ExplicitSpecificity10', normal, compile_fail, ['']) test('T18357', normal, compile_fail, ['']) test('T18357a', normal, compile_fail, ['']) +test('T20443b', normal, compile_fail, ['']) test('T18357b', normal, compile_fail, ['']) test('T17301', normal, compile_fail, ['']) test('T17567', normal, compile_fail, ['']) |