Commit 9fc65bb8 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor error generation for pattern synonyms

The result of a series of patches on type-error messages for
pattern synonyms had become a bit baroque. This tidies it up
a bit.  Still not fantastic, but better.
parent 0ad2021b
This diff is collapsed.
......@@ -241,9 +241,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
, patsig_ex_bndrs = ex_bndrs, patsig_req = req_theta
, patsig_arg_tys = arg_tys, patsig_body_ty = pat_ty }
= addPatSynCtxt lname $
do { let origin = ProvCtxtOrigin psb
skol_info = PatSynSigSkol name
decl_arity = length arg_names
do { let decl_arity = length arg_names
ty_arity = length arg_tys
(arg_names, rec_fields, is_infix) = collectPatSynArgInfo details
......@@ -274,16 +272,20 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
-- Note [Checking against a pattern signature]
; traceTc "tcpatsyn1" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs])
; traceTc "tcpatsyn2" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs'])
; prov_dicts <- mapM (emitWanted origin)
(substTheta (extendTCvInScopeList subst univ_tvs) prov_theta)
-- Add the free vars of 'prov_theta' to the in_scope set to
; let prov_theta' = substTheta (extendTCvInScopeList subst univ_tvs) prov_theta
-- Add univ_tvs to the in_scope set to
-- satisfy the substition invariant. There's no need to
-- add 'ex_tvs' as they are already in the domain of the
-- substitution.
-- See also Note [The substitution invariant] in TyCoRep.
; prov_dicts <- mapM (emitWanted (ProvCtxtOrigin psb)) prov_theta'
; args' <- zipWithM (tc_arg subst) arg_names arg_tys
; return (ex_tvs', prov_dicts, args') }
; let skol_info = SigSkol (PatSynCtxt name) (mkPhiTy req_theta pat_ty)
-- The type here is a bit bogus, but we do not print
-- the type for PatSynCtxt, so it doesn't matter
-- See TcRnTypes Note [Skolem info for pattern synonyms]
; (implics, ev_binds) <- buildImplicationFor tclvl skol_info univ_tvs req_dicts wanted
-- Solve the constraints now, because we are about to make a PatSyn,
......@@ -709,7 +711,7 @@ get_builder_sig sig_fun name builder_id need_dummy_arg
, sig_theta = req ++ prov
, sig_tau = add_void need_dummy_arg $
mkFunTys arg_tys body_ty
, sig_ctxt = PatSynBuilderCtxt name
, sig_ctxt = PatSynCtxt name
, sig_loc = getSrcSpan name })
| otherwise
= -- No signature, so fake up a TcIdSigInfo from the builder Id
......
......@@ -2577,11 +2577,6 @@ data SkolemInfo
TcType -- a programmer-supplied type signature
-- Location of the binding site is on the TyVar
| PatSynSigSkol Name -- Bound by a programmer-supplied type signature of a pattern
-- synonym. Here we cannot use a SigSkol, see
-- Note [Patterns synonyms and the data type Type] in
-- basicTypes\PatSyn.hs
| ClsSkol Class -- Bound at a class decl
| DerivSkol Type -- Bound by a 'deriving' clause;
......@@ -2645,8 +2640,6 @@ pprSkolInfo (InferSkol ids) = sep [ text "the inferred type of"
, vcat [ ppr name <+> dcolon <+> ppr ty
| (name,ty) <- ids ]]
pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty
pprSkolInfo (PatSynSigSkol name) = text "the type signature of pattern synonym"
<+> quotes (ppr name)
-- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding.
......@@ -2657,6 +2650,7 @@ pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo ctxt ty
= case ctxt of
FunSigCtxt f _ -> pp_sig f
PatSynCtxt {} -> pprUserTypeCtxt ctxt -- See Note [Skolem info for pattern synonyms]
_ -> vcat [ pprUserTypeCtxt ctxt <> colon
, nest 2 (ppr ty) ]
where
......@@ -2677,7 +2671,17 @@ pprPatSkolInfo (PatSynCon ps)
, nest 2 $ ppr ps <+> dcolon
<+> pprType (patSynType ps) <> comma ]
{-
{- Note [Skolem info for pattern synonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For pattern synonym SkolemInfo we have
SigSkol (PatSynCtxt p) ty
but the type 'ty' is not very helpful. The full pattern-synonym type
is has the provided and required pieces, which it is inconvenient to
record and display here. So we simply don't display the type at all,
contenting outselves with just the name of the pattern synonym, which
is fine. We could do more, but it doesn't seem worth it.
************************************************************************
* *
CtOrigin
......
......@@ -473,7 +473,7 @@ data UserTypeCtxt
| TypeAppCtxt -- Visible type application
| ConArgCtxt Name -- Data constructor argument
| TySynCtxt Name -- RHS of a type synonym decl
| PatSynBuilderCtxt Name -- Type sig for the builder of a bidirectional pattern synonym
| PatSynCtxt Name -- Type sig for a pattern synonym
| PatSigCtxt -- Type sig in pattern
-- eg f (x::t) = ...
-- or (x::t, y) = e
......@@ -670,9 +670,7 @@ pprUserTypeCtxt GhciCtxt = text "a type in a GHCi command"
pprUserTypeCtxt (ClassSCCtxt c) = text "the super-classes of class" <+> quotes (ppr c)
pprUserTypeCtxt SigmaCtxt = text "the context of a polymorphic type"
pprUserTypeCtxt (DataTyCtxt tc) = text "the context of the data type declaration for" <+> quotes (ppr tc)
pprUserTypeCtxt (PatSynBuilderCtxt n)
= vcat [ text "the type signature for bidirectional pattern synonym" <+> quotes (ppr n)
, text "when used in an expression context" ]
pprUserTypeCtxt (PatSynCtxt n) = text "the signature for pattern synonym" <+> quotes (ppr n)
pprSigCtxt :: UserTypeCtxt -> SDoc -> SDoc -> SDoc
-- (pprSigCtxt ctxt <extra> <type>)
......@@ -688,14 +686,12 @@ pprSigCtxt ctxt extra pp_ty
= hang (text "In" <+> extra <+> pprUserTypeCtxt ctxt <> colon)
2 pp_ty
where
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe (FunSigCtxt n _) = Just n
isSigMaybe (ConArgCtxt n) = Just n
isSigMaybe (ForSigCtxt n) = Just n
isSigMaybe (PatSynBuilderCtxt n) = Just n
isSigMaybe _ = Nothing
isSigMaybe (FunSigCtxt n _) = Just n
isSigMaybe (ConArgCtxt n) = Just n
isSigMaybe (ForSigCtxt n) = Just n
isSigMaybe (PatSynCtxt n) = Just n
isSigMaybe _ = Nothing
{-
************************************************************************
......
......@@ -451,9 +451,9 @@ forAllAllowed _ = False
representationPolymorphismForbidden :: UserTypeCtxt -> Bool
representationPolymorphismForbidden = go
where
go (ConArgCtxt _) = True -- A rep-polymorphic datacon won't be useful
go (PatSynBuilderCtxt _) = True -- Similar to previous case
go _ = False -- Other cases are caught by zonker
go (ConArgCtxt _) = True -- A rep-polymorphic datacon won't be useful
go (PatSynCtxt _) = True -- Similar to previous case
go _ = False -- Other cases are caught by zonker
----------------------------------------
-- | Fail with error message if the type is unlifted
......@@ -880,7 +880,7 @@ okIPCtxt ThBrackCtxt = True
okIPCtxt GhciCtxt = True
okIPCtxt SigmaCtxt = True
okIPCtxt (DataTyCtxt {}) = True
okIPCtxt (PatSynBuilderCtxt {}) = True
okIPCtxt (PatSynCtxt {}) = True
okIPCtxt (TySynCtxt {}) = True -- e.g. type Blah = ?x::Int
-- Trac #11466
......
......@@ -2,7 +2,7 @@
T11039.hs:8:15: error:
• Couldn't match type ‘f’ with ‘A’
‘f’ is a rigid type variable bound by
the type signature of pattern synonym ‘Q’ at T11039.hs:7:14
the signature for pattern synonym ‘Q’ at T11039.hs:7:14
Expected type: f a
Actual type: A a
• In the pattern: A a
......
......@@ -2,11 +2,11 @@
T11667.hs:12:22: error:
• Could not deduce (Num a) arising from the literal ‘42’
from the context: Eq a
bound by the type signature of pattern synonym ‘Pat1’
bound by the signature for pattern synonym ‘Pat1’
at T11667.hs:12:9-12
Possible fix:
add (Num a) to the context of
the type signature of pattern synonym ‘Pat1’
add (Num a) to the "required" context of
the signature for pattern synonym ‘Pat1’
• In the pattern: 42
In the pattern: Just 42
In the declaration for pattern synonym ‘Pat1’
......@@ -16,7 +16,7 @@ T11667.hs:18:28: error:
arising from the "provided" constraints claimed by
the signature of ‘Pat2’
‘b’ is a rigid type variable bound by
the type signature of pattern synonym ‘Pat2’ at T11667.hs:17:17
the signature for pattern synonym ‘Pat2’ at T11667.hs:17:17
• In the declaration for pattern synonym ‘Pat2’
• Relevant bindings include y :: b (bound at T11667.hs:18:21)
......@@ -32,12 +32,10 @@ T11667.hs:24:24: error:
T11667.hs:31:16: error:
• Could not deduce (Num a) arising from a use of ‘MkS’
from the context: (Eq a, Show a)
bound by the type signature for bidirectional pattern synonym ‘Pat4’
when used in an expression context:
(Eq a, Show a) => S a
bound by the signature for pattern synonym ‘Pat4’
at T11667.hs:31:1-21
Possible fix:
add (Num a) to the context of
the type signature of pattern synonym ‘Pat4’
add (Num a) to the "required" context of
the signature for pattern synonym ‘Pat4’
• In the expression: MkS 42
In an equation for ‘$bPat4’: $bPat4 = MkS 42
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