diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 71e4b5f319bb28e2cc4952aa162ba686f5a27a6f..6e65c7eaa83d89720b7f15463fd79fd81323c05b 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 0000000000000000000000000000000000000000..0f9275b1c08b5f75ff62924cbf8eea3be61bc752 --- /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 0000000000000000000000000000000000000000..cad595e1d2ee9dd0418d264a24a7e34ddff9aa59 --- /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 9879f2d9b0fa29142647ccb9fd20a58df89758bc..4a8e419acbc90810dff695d2f9e6acf68b1f566b 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, [''])