Wildcard binders in type declarations (#23501)
Add support for wildcard binders in type declarations:
type Const a b = a -- BEFORE: the `b` had to be named
-- even if unused on the RHS
type Const a _ = a -- AFTER: the compiler accepts
-- a wildcard binder `_`
The new feature is part of GHC Proposal #425 "Invisible binders in type declarations", and more specifically its amendment #641.
Just like a named binder, a wildcard binder _
may be:
- plain:
_
- kinded:
(_ :: k -> Type)
- invisible, plain:
@_
- invisible, kinded:
@(_ :: k -> Type)
Those new forms of binders are allowed to occur on the LHSs of data, newtype, type, class, and type/data family declarations:
data D _ = ...
newtype N _ = ...
type T _ = ...
class C _ where ...
type family F _
data family DF _
(Test case: testsuite/tests/typecheck/should_compile/T23501a.hs
)
However, we choose to reject them in forall telescopes and type family result variable binders (the latter being part of the TypeFamilyDependencies
extension):
type family Fd a = _ -- disallowed (WildcardBndrInTyFamResultVar)
fn :: forall _. Int -- disallowed (WildcardBndrInForallTelescope)
(Test case: testsuite/tests/rename/should_fail/T23501_fail.hs
)
See the new Notes:
Note [Type variable binders]
Note [Wildcard binders in disallowed contexts]
To accommodate the new forms of binders, HsTyVarBndr
was changed as follows (demonstrated without x-fields for clarity)
-- BEFORE (ignoring x-fields and locations)
data HsTyVarBndr flag
= UserTyVar flag Name
| KindedTyVar flag Name HsKind
-- AFTER (ignoring x-fields and locations)
data HsTyVarBndr flag = HsTvb flag HsBndrVar HsBndrKind
data HsBndrVar = HsBndrVar Name | HsBndrWildCard
data HsBndrKind = HsBndrNoKind | HsBndrKind LHsKind
The rest of the patch is downstream from this change.
To avoid a breaking change to the TH AST, we generate fresh names to replace wildcard binders instead of adding a dedicated representation for them (as discussed in #641).
And to put a cherry on top of the cake, we now allow wildcards in kind-polymorphic type variable binders in constructor patterns, see Note [Type patterns: binders and unifiers]
and the tyPatToBndr
function in GHC.Tc.Gen.HsType
; example:
fn (MkT @(_ :: forall k. k -> Type) _ _) = ...
(Test case: testsuite/tests/typecheck/should_compile/T23501b.hs
)