Commit 116528c8 authored by Rik Steenkamp's avatar Rik Steenkamp Committed by Ben Gamari

Improve pattern synonym error messages (add `PatSynOrigin`)

Adds a new data constructor `PatSynOrigin Bool Name` to the `CtOrigin`
data type. This allows for better error messages when the origin of a
wanted constraint is a pattern synonym declaration.

Fixes T10873.

Reviewers: mpickering, simonpj, austin, thomie, bgamari

Reviewed By: simonpj, thomie, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1866

GHC Trac Issues: #10873
parent 20ab2adf
......@@ -27,6 +27,7 @@ import TyCon
import Class
import DataCon
import TcEvidence
import HsBinds ( PatSynBind(..) )
import Name
import RdrName ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual )
import PrelNames ( typeableClassName, hasKey, ptrRepLiftedDataConKey
......@@ -1820,6 +1821,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
= vcat [ no_inst_msg
, nest 2 extra_note
, vcat (pp_givens givens)
, in_other_words
, ppWhen (has_ambig_tvs && not (null unifiers && null givens))
(vcat [ ppUnless lead_with_ambig ambig_msg, binds_msg, potential_msg ])
, show_fixes (add_to_ctxt_fixes has_ambig_tvs ++ drv_fixes)
......@@ -1863,6 +1865,18 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
, text "These potential instance" <> plural unifiers
<+> text "exist:"]
in_other_words
| not lead_with_ambig
, ProvCtxtOrigin PSB{ psb_id = (L _ name)
, psb_def = (L _ pat) } <- orig
-- Here we check if the "required" context is empty, otherwise
-- the "In other words" is not strictly true
, null [ n | (_, SigSkol (PatSynCtxt n) _, _, _) <- givens, name == n ]
= vcat [ text "In other words, a successful match on the pattern"
, nest 2 $ ppr pat
, text "does not provide the constraint" <+> pprParendType pred ]
| otherwise = empty
-- Report "potential instances" only when the constraint arises
-- directly from the user's use of an overloaded function
want_potential (TypeEqOrigin {}) = False
......@@ -1870,7 +1884,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
add_to_ctxt_fixes has_ambig_tvs
| not has_ambig_tvs && all_tyvars
, (orig:origs) <- usefulContext ctxt pred
, (orig:origs) <- usefulContext ctxt ct
= [sep [ text "add" <+> pprParendType pred
<+> text "to the context of"
, nest 2 $ ppr_skol orig $$
......@@ -2000,11 +2014,11 @@ Once these conditions are satisfied, we can safely say that ambiguity prevents
the constraint from being solved. -}
usefulContext :: ReportErrCtxt -> TcPredType -> [SkolemInfo]
usefulContext ctxt pred
usefulContext :: ReportErrCtxt -> Ct -> [SkolemInfo]
usefulContext ctxt ct
= go (cec_encl ctxt)
where
pred_tvs = tyCoVarsOfType pred
pred_tvs = tyCoVarsOfType $ ctPred ct
go [] = []
go (ic : ics)
| implausible ic = rest
......@@ -2019,9 +2033,18 @@ usefulContext ctxt pred
| implausible_info (ic_info ic) = True
| otherwise = False
implausible_info (SigSkol (InfSigCtxt {}) _) = True
implausible_info _ = False
-- Do not suggest adding constraints to an *inferred* type signature!
implausible_info (SigSkol (InfSigCtxt {} ) _) = True
implausible_info (SigSkol (PatSynCtxt name) _)
| (ProvCtxtOrigin PSB{ psb_id = (L _ name') }) <- ctOrigin ct
, name == name' = True
implausible_info _ = False
-- Do not suggest adding constraints to an *inferred* type signature, or to
-- a pattern synonym signature when its "provided" context is the origin of
-- the wanted constraint. For example,
-- pattern Pat :: () => Show a => a -> Maybe a
-- pattern Pat x = Just x
-- This declaration should not give the possible fix:
-- add (Show a) to the "required" context of the signature for `Pat'
show_fixes :: [SDoc] -> SDoc
show_fixes [] = empty
......
......@@ -216,13 +216,13 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
tcCheckPatSynDecl :: PatSynBind Name Name
-> TcPatSynInfo
-> TcM (LHsBinds Id, TcGblEnv)
tcCheckPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details
, psb_def = lpat, psb_dir = dir }
tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
, psb_def = lpat, psb_dir = dir }
TPSI{ patsig_univ_tvs = univ_tvs, patsig_prov = prov_theta
, patsig_ex_tvs = ex_tvs, patsig_req = req_theta
, patsig_arg_tys = arg_tys, patsig_body_ty = pat_ty }
= addPatSynCtxt lname $
do { let origin = PatOrigin -- TODO
do { let origin = ProvCtxtOrigin psb
skol_info = SigSkol (PatSynCtxt name) (mkCheckExpType $
mkFunTys arg_tys pat_ty)
decl_arity = length arg_names
......
......@@ -2713,6 +2713,9 @@ data CtOrigin
| ExprSigOrigin -- e :: ty
| PatSigOrigin -- p :: ty
| PatOrigin -- Instantiating a polytyped pattern at a constructor
| ProvCtxtOrigin -- The "provided" context of a pattern synonym signature
(PatSynBind Name Name) -- Information about the pattern synonym, in particular
-- the name and the right-hand side
| RecordUpdOrigin
| ViewPatOrigin
......@@ -2949,6 +2952,10 @@ pprCtOrigin (Shouldn'tHappenOrigin note)
, text "in an error message, please report a bug mentioning" <+> quotes (text note) <+> text "at"
, text "https://ghc.haskell.org/trac/ghc/wiki/ReportABug >>" ]
pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })
= hang (ctoHerald <+> text "the \"provided\" constraints claimed by")
2 (text "the signature of" <+> quotes (ppr name))
pprCtOrigin simple_origin
= ctoHerald <+> pprCtO simple_origin
......
{-# LANGUAGE PatternSynonyms, GADTs #-}
module T10873 where
pattern Pat1 :: () => Show a => a -> Maybe a
pattern Pat1 x <- Just x
data T a where MkT :: (Ord a) => a -> T a
pattern Pat2 :: (Enum a) => Show a => a -> T a
pattern Pat2 x <- MkT x
T10873.hs:6:24: error:
• No instance for (Show a)
arising from the "provided" constraints claimed by
the signature of ‘Pat1’
In other words, a successful match on the pattern
Just x
does not provide the constraint (Show a)
• In the declaration for pattern synonym ‘Pat1’
T10873.hs:10:23: error:
• Could not deduce (Show a)
arising from the "provided" constraints claimed by
the signature of ‘Pat2’
from the context: Enum a
bound by the type signature for pattern synonym ‘Pat2’:
a -> T a
at T10873.hs:10:9-12
or from: Ord a
bound by a pattern with constructor:
MkT :: forall a. Ord a => a -> T a,
in a pattern synonym declaration
at T10873.hs:10:19-23
• In the declaration for pattern synonym ‘Pat2’
......@@ -8,6 +8,7 @@ test('T9705-1', normal, compile_fail, [''])
test('T9705-2', normal, compile_fail, [''])
test('unboxed-bind', normal, compile_fail, [''])
test('unboxed-wrapper-naked', normal, compile_fail, [''])
test('T10873', normal, compile_fail, [''])
test('T11010', normal, compile_fail, [''])
test('records-check-sels', normal, compile_fail, [''])
test('records-no-uni-update', normal, compile_fail, [''])
......
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