From 9eecdf33864ddfaa4a6489227ea29a16f7ffdd44 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 21 Aug 2023 15:22:59 +0200
Subject: [PATCH] Remove ScopedTypeVariables => TypeAbstractions
This commit implements [amendment 604](https://github.com/ghc-proposals/ghc-proposals/pull/604/)
to [GHC proposal 448](https://github.com/ghc-proposals/ghc-proposals/pull/448)
by removing the implication of language extensions
ScopedTypeVariables => TypeAbstractions
To limit breakage, we now allow type arguments in constructor patterns
when both ScopedTypeVariables and TypeApplications are enabled, but
we emit a warning notifying the user that this is deprecated behaviour
that will go away starting in GHC 9.12.
Fixes #23776
---
compiler/GHC/Driver/DynFlags.hs | 1 -
compiler/GHC/Driver/Session.hs | 3 ---
compiler/GHC/Rename/HsType.hs | 1 +
compiler/GHC/Rename/Pat.hs | 24 ++++++++++++++++---
compiler/GHC/Tc/Errors/Ppr.hs | 9 +++++++
compiler/GHC/Tc/Errors/Types.hs | 9 +++++++
compiler/GHC/Types/Error/Codes.hs | 1 +
.../tests/typecheck/should_fail/T23776.hs | 9 +++++++
testsuite/tests/typecheck/should_fail/all.T | 1 +
9 files changed, 51 insertions(+), 7 deletions(-)
create mode 100644 testsuite/tests/typecheck/should_fail/T23776.hs
diff --git a/compiler/GHC/Driver/DynFlags.hs b/compiler/GHC/Driver/DynFlags.hs
index 7bf3341b404e..a9e89ffac835 100644
--- a/compiler/GHC/Driver/DynFlags.hs
+++ b/compiler/GHC/Driver/DynFlags.hs
@@ -1413,7 +1413,6 @@ languageExtensions (Just GHC2021)
LangExt.PostfixOperators,
LangExt.RankNTypes,
LangExt.ScopedTypeVariables,
- LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables"
LangExt.StandaloneDeriving,
LangExt.StandaloneKindSignatures,
LangExt.TupleSections,
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 0ed06940087f..8cc82e9fc5d5 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -2797,9 +2797,6 @@ impliedXFlags
, (LangExt.MultiParamTypeClasses, turnOn, LangExt.ConstrainedClassMethods) -- c.f. #7854
, (LangExt.TypeFamilyDependencies, turnOn, LangExt.TypeFamilies)
- -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables"
- , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions)
-
, (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off!
, (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index f88bc1e7afd8..83d7de121f88 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -38,6 +38,7 @@ module GHC.Rename.HsType (
extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars,
nubL, nubN,
+
-- Error helpers
badKindSigErr
) where
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 79900c349bc9..331cfdd99789 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -7,6 +7,7 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -657,9 +658,26 @@ rnConPatAndThen mk con (PrefixCon tyargs pats)
where
check_lang_exts :: RnM ()
check_lang_exts =
- unlessXOptM LangExt.TypeAbstractions $
- for_ (listToMaybe tyargs) $ \ arg ->
- addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg)
+ for_ (listToMaybe tyargs) $ \ arg ->
+ do { type_abs <- xoptM LangExt.TypeAbstractions
+ ; type_app <- xoptM LangExt.TypeApplications
+ ; scoped_tvs <- xoptM LangExt.ScopedTypeVariables
+ ; if | type_abs
+ -> return ()
+
+ -- As per [GHC Proposal 604](https://github.com/ghc-proposals/ghc-proposals/pull/604/),
+ -- we allow type applications in constructor patterns when -XTypeApplications and
+ -- -XScopedTypeVariables are both enabled, but we emit a warning when doing so.
+ --
+ -- This warning is scheduled to become an error in GHC 9.12, in
+ -- which case we will get the usual error (below),
+ -- which suggests enabling -XTypeAbstractions.
+ | type_app && scoped_tvs
+ -> addDiagnostic TcRnDeprecatedInvisTyArgInConPat
+
+ | otherwise
+ -> addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg)
+ }
rnConPatTyArg (HsConPatTyArg at t) = do
t' <- rnHsTyPat HsTypePatCtx t
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 5080f4675ef1..fd36158ba4d5 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1845,6 +1845,11 @@ instance Diagnostic TcRnMessage where
text "whereas" <+> quotes (text "forall {a}.") <+> text "and" <+> quotes (text "forall a ->") <+> text "do not."
]]
+ TcRnDeprecatedInvisTyArgInConPat ->
+ mkSimpleDecorated $
+ cat [ text "Type applications in constructor patterns will require"
+ , text "the TypeAbstractions extension starting from GHC 9.12." ]
+
TcRnInvisBndrWithoutSig _ hs_bndr ->
mkSimpleDecorated $
vcat [ hang (text "Invalid invisible type variable binder:")
@@ -2446,6 +2451,8 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnMissingRoleAnnotations
TcRnIllegalInvisTyVarBndr{}
-> ErrorWithoutFlag
+ TcRnDeprecatedInvisTyArgInConPat {}
+ -> WarningWithoutFlag
TcRnInvalidInvisTyVarBndr{}
-> ErrorWithoutFlag
TcRnInvisBndrWithoutSig{}
@@ -3100,6 +3107,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnIllegalInvisTyVarBndr{}
-> [suggestExtension LangExt.TypeAbstractions]
+ TcRnDeprecatedInvisTyArgInConPat{}
+ -> [suggestExtension LangExt.TypeAbstractions]
TcRnInvalidInvisTyVarBndr{}
-> noHints
TcRnInvisBndrWithoutSig name _
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 588dca81e8c6..e19cab083434 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -3067,6 +3067,15 @@ data TcRnMessage where
-> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)
-> TcRnMessage
+ {-| TcRnDeprecatedInvisTyArgInConPat is a warning that triggers on type applications
+ in constructor patterns when the user has not enabled '-XTypeAbstractions'
+ but instead has enabled both '-XScopedTypeVariables' and '-XTypeApplications'.
+
+ This warning is a deprecation mechanism that is scheduled until GHC 9.12.
+ -}
+ TcRnDeprecatedInvisTyArgInConPat
+ :: TcRnMessage
+
{-| TcRnLoopySuperclassSolve is a warning, controlled by @-Wloopy-superclass-solve@,
that is triggered when GHC solves a constraint in a possibly-loopy way,
violating the class instance termination rules described in the section
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index c71d69e9f26f..9ea1a158dc3b 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -594,6 +594,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382
GhcDiagnosticCode "TcRnBadTyConTelescope" = 87279
GhcDiagnosticCode "TcRnPatersonCondFailure" = 22979
+ GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat" = 69797
-- TcRnTypeApplicationsDisabled
GhcDiagnosticCode "TypeApplication" = 23482
diff --git a/testsuite/tests/typecheck/should_fail/T23776.hs b/testsuite/tests/typecheck/should_fail/T23776.hs
new file mode 100644
index 000000000000..29d02ff43a10
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T23776.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE GHC2021 #-}
+
+module T23776 where
+
+import Data.Kind
+
+foo :: Maybe a -> Maybe a
+foo (Just @b x) = Just @b x
+foo _ = Nothing
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 406fffb6ab33..5cef546ad5d4 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -699,3 +699,4 @@ test('VisFlag5', normal, compile_fail, [''])
test('T22684', normal, compile_fail, [''])
test('T23514a', normal, compile_fail, [''])
test('T22478c', normal, compile_fail, [''])
+test('T23776', normal, compile, ['']) # to become an error in GHC 9.12
--
GitLab