Commit 62b82135 authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

More sensible SrcSpans for recursive pattern synonym errors (#16900)

Attach the `SrcSpan` of the first pattern synonym binding involved in
the recursive group when throwing the corresponding error message,
similarly to how it is done for type synonyms.

Fixes #16900.
parent a76b233d
Pipeline #7991 passed with stages
in 359 minutes and 31 seconds
......@@ -67,6 +67,7 @@ import qualified GHC.LanguageExtensions as LangExt
import ConLike
import Control.Monad
import Data.Foldable (find)
#include "HsVersions.h"
......@@ -485,12 +486,13 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
-- (This used to be optional, but isn't now.)
-- See Note [Polymorphic recursion] in HsBinds.
do { traceTc "tc_group rec" (pprLHsBinds binds)
; when hasPatSyn $ recursivePatSynErr binds
; whenIsJust mbFirstPatSyn $ \lpat_syn ->
recursivePatSynErr (getLoc lpat_syn) binds
; (binds1, thing) <- go sccs
; return ([(Recursive, binds1)], thing) }
-- Rec them all together
where
hasPatSyn = anyBag (isPatSyn . unLoc) binds
mbFirstPatSyn = find (isPatSyn . unLoc) binds
isPatSyn PatSynBind{} = True
isPatSyn _ = False
......@@ -511,10 +513,14 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
tc_sub_group rec_tc binds =
tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds
recursivePatSynErr :: OutputableBndrId (GhcPass p) =>
LHsBinds (GhcPass p) -> TcM a
recursivePatSynErr binds
= failWithTc $
recursivePatSynErr ::
OutputableBndrId (GhcPass p) =>
SrcSpan -- ^ The location of the first pattern synonym binding
-- (for error reporting)
-> LHsBinds (GhcPass p)
-> TcM a
recursivePatSynErr loc binds
= failAt loc $
hang (text "Recursive pattern synonym definition with following bindings:")
2 (vcat $ map pprLBind . bagToList $ binds)
where
......
{-# LANGUAGE PatternSynonyms #-}
module T16900 where
pattern P1 = P2
pattern P2 = P1
T16900.hs:4:1: error:
Recursive pattern synonym definition with following bindings:
P1 (defined at T16900.hs:4:1-15)
P2 (defined at T16900.hs:5:1-15)
|
4 | pattern P1 = P2
| ^^^^^^^^^^^^^^^
......@@ -45,3 +45,4 @@ test('T15289', normal, compile_fail, [''])
test('T15685', normal, compile_fail, [''])
test('T15692', normal, compile, ['']) # It has -fdefer-type-errors inside
test('T15694', normal, compile_fail, [''])
test('T16900', normal, compile_fail, ['-fdiagnostics-show-caret'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment