From e7db36c175520210e443fff89cb594beb179705c Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Tue, 22 Aug 2023 13:29:29 +0200
Subject: [PATCH] Don't attempt pattern synonym error recovery
This commit gets rid of the pattern synonym error recovery mechanism
(recoverPSB). The rationale is that the fake pattern synonym binding
that the recovery mechanism introduced could lead to undesirable
knock-on errors, and it isn't really feasible to conjure up a
satisfactory binding as pattern synonyms can be used both in expressions
and patterns.
See Note [Pattern synonym error recovery] in GHC.Tc.TyCl.PatSyn.
It isn't such a big deal to eagerly fail compilation on a pattern synonym
that doesn't typecheck anyway.
Fixes #23467
---
compiler/GHC/Tc/TyCl/PatSyn.hs | 48 ++++++-------------
testsuite/tests/patsyn/should_fail/T23467.hs | 12 +++++
.../tests/patsyn/should_fail/T23467.stderr | 5 ++
testsuite/tests/patsyn/should_fail/all.T | 1 +
4 files changed, 32 insertions(+), 34 deletions(-)
create mode 100644 testsuite/tests/patsyn/should_fail/T23467.hs
create mode 100644 testsuite/tests/patsyn/should_fail/T23467.stderr
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 71e4b5f319bb..6e65c7eaa83d 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -41,7 +41,6 @@ import GHC.Core.Type ( typeKind, tidyForAllTyBinders, tidyTypes, tidyType, isMan
import GHC.Core.TyCo.Subst( extendTvSubstWithClone )
import GHC.Core.Predicate
-import GHC.Builtin.Types.Prim
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
@@ -86,36 +85,12 @@ tcPatSynDecl (L loc psb@(PSB { psb_id = L _ name })) sig_fn prag_fn
= setSrcSpanA loc $
addErrCtxt (text "In the declaration for pattern synonym"
<+> quotes (ppr name)) $
- recoverM (recoverPSB psb) $
- case (sig_fn name) of
+ -- See Note [Pattern synonym error recovery]
+ case sig_fn name of
Nothing -> tcInferPatSynDecl psb prag_fn
Just (TcPatSynSig tpsi) -> tcCheckPatSynDecl psb tpsi prag_fn
_ -> panic "tcPatSynDecl"
-recoverPSB :: PatSynBind GhcRn GhcRn
- -> TcM (LHsBinds GhcTc, TcGblEnv)
--- See Note [Pattern synonym error recovery]
-recoverPSB (PSB { psb_id = L _ name
- , psb_args = details })
- = do { matcher_name <- newImplicitBinder name mkMatcherOcc
- ; let placeholder = AConLike $ PatSynCon $
- mk_placeholder matcher_name
- ; gbl_env <- tcExtendGlobalEnv [placeholder] getGblEnv
- ; return (emptyBag, gbl_env) }
- where
- (_arg_names, is_infix) = collectPatSynArgInfo details
- mk_placeholder matcher_name
- = mkPatSyn name is_infix
- ([mkTyVarBinder SpecifiedSpec alphaTyVar], []) ([], [])
- [] -- Arg tys
- alphaTy
- (matcher_name, matcher_ty, True) Nothing
- [] -- Field labels
- where
- -- The matcher_id is used only by the desugarer, so actually
- -- and error-thunk would probably do just as well here.
- matcher_ty = mkSpecForAllTys [alphaTyVar] alphaTy
-
{- Note [Pattern synonym error recovery]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If type inference for a pattern synonym fails, we can't continue with
@@ -134,14 +109,19 @@ reporting no end (#15685).
So we use simplifyTop to completely solve the constraint, report
any errors, throw an exception.
-Even in the event of such an error we can recover and carry on, just
-as we do for value bindings, provided we plug in placeholder for the
-pattern synonym: see recoverPSB. The goal of the placeholder is not
-to cause a raft of follow-on errors. I've used the simplest thing for
-now, but we might need to elaborate it a bit later. (e.g. I've given
-it zero args, which may cause knock-on errors if it is used in a
-pattern.) But it'll do for now.
+Unlike for value bindings, we don't create a placeholder pattern
+synonym binding in an attempt to recover from the error, as this placeholder
+was occasionally the cause of strange follow-up errors to occur, as reported in #23467.
+It seems rather difficult to come up with a satisfactory placeholder:
+
+ - it would need to have the right number of arguments,
+ with the appropriate field names (if any),
+ - we could give each argument the type `forall a. a`; this would generally
+ work OK in pattern occurrences of the PatSyn, but not so in expressions,
+ e.g. "let x = Con y" would require (y :: forall a. a) which would cause
+ confusing errors.
+So, for now at least, we don't attempt to recover at all.
-}
tcInferPatSynDecl :: PatSynBind GhcRn GhcRn
diff --git a/testsuite/tests/patsyn/should_fail/T23467.hs b/testsuite/tests/patsyn/should_fail/T23467.hs
new file mode 100644
index 000000000000..0f9275b1c08b
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T23467.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module T23467 where
+
+data ConData = ConData { _pars :: Int }
+data Decl = ConDecl ConData
+
+pattern Con :: Decl -- The correct type would be Int -> Decl
+pattern Con { pars } = ConDecl (ConData pars)
+
+foo :: Decl -> Int
+foo (Con { pars }) = pars
diff --git a/testsuite/tests/patsyn/should_fail/T23467.stderr b/testsuite/tests/patsyn/should_fail/T23467.stderr
new file mode 100644
index 000000000000..cad595e1d2ee
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T23467.stderr
@@ -0,0 +1,5 @@
+
+T23467.hs:9:1: error: [GHC-18365]
+ • Pattern synonym ‘Con’ has one argument
+ but its type signature has 1 fewer arrows
+ • In the declaration for pattern synonym ‘Con’
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 9879f2d9b0fa..4a8e419acbc9 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -48,3 +48,4 @@ test('T16900', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('T14552', normal, compile_fail, [''])
test('T18856', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('T21479', normal, compile_fail, [''])
+test('T23467', normal, compile_fail, [''])
--
GitLab