[Git][ghc/ghc][wip/T21623] Wibbles to errors
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Mon Aug 22 16:50:50 UTC 2022
Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC
Commits:
3a8417cc by Simon Peyton Jones at 2022-08-22T17:52:09+01:00
Wibbles to errors
- - - - -
6 changed files:
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Utils/Unify.hs
- testsuite/tests/typecheck/should_fail/T5570.stderr
- testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
- testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr
- testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr
Changes:
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -2023,6 +2023,7 @@ pprTcSolverReportMsg _ (CannotUnifyWithPolytype item tv1 ty2) =
where
what = text $ levelString $
ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel
+
pprTcSolverReportMsg _
(Mismatch { mismatch_ea = add_ea
, mismatch_item = item
@@ -2051,11 +2052,11 @@ pprTcSolverReportMsg _
herald1 = conc [ "Couldn't match"
, if is_repr then "representation of" else ""
- , if add_ea then "expected" else ""
+ , if add_ea then "expected" else ""
, what ]
herald2 = conc [ "with"
- , if is_repr then "that of" else ""
- , if add_ea then ("actual " ++ what) else "" ]
+ , if is_repr then "that of" else ""
+ , if add_ea then ("actual " ++ what) else "" ]
padding = length herald1 - length herald2
@@ -2070,6 +2071,7 @@ pprTcSolverReportMsg _
add_space s1 s2 | null s1 = s2
| null s2 = s1
| otherwise = s1 ++ (' ' : s2)
+
pprTcSolverReportMsg _
(KindMismatch { kmismatch_what = thing
, kmismatch_expected = exp
@@ -2089,10 +2091,10 @@ pprTcSolverReportMsg _
pprTcSolverReportMsg ctxt
(TypeEqMismatch { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds
, teq_mismatch_item = item
- , teq_mismatch_ty1 = ty1 -- These types are the context
- , teq_mismatch_ty2 = ty2 -- of the mis-match
- , teq_mismatch_expected = exp -- These are the kinds that
- , teq_mismatch_actual = act -- don't match
+ , teq_mismatch_ty1 = ty1 -- These types are the actual types
+ , teq_mismatch_ty2 = ty2 -- that don't match; may be swapped
+ , teq_mismatch_expected = exp -- These are the context of
+ , teq_mismatch_actual = act -- the mis-match
, teq_mismatch_what = mb_thing })
= addArising ct_loc $ pprWithExplicitKindsWhen ppr_explicit_kinds msg
where
@@ -2132,8 +2134,8 @@ pprTcSolverReportMsg ctxt
| otherwise
= -- (TYPE _) ~ (CONSTRAINT _) or (TYPE _) ~ Bool, etc
maybe_num_args_msg $$
- sep [ text "Expected a" <+> pp_exp_thing <> text ", but"
- , case mb_thing of
+ sep [ text "Expected a" <+> pp_exp_thing <> comma
+ , text "but" <+> case mb_thing of
Nothing -> text "found something with kind"
Just thing -> quotes (ppr thing) <+> text "has kind"
, quotes (pprWithTYPE act) ]
@@ -2148,8 +2150,8 @@ pprTcSolverReportMsg ctxt
, [act_lev_ty] <- act_rr_args
, Just exp_lev <- levityType_maybe exp_lev_ty
, Just act_lev <- levityType_maybe act_lev_ty
- = sep [ text "Expected" <+> ppr_an_lev exp_lev <+> pp_exp_thing <> text ", but"
- , case mb_thing of
+ = sep [ text "Expected" <+> ppr_an_lev exp_lev <+> pp_exp_thing <> comma
+ , text "but" <+> case mb_thing of
Just thing -> quotes (ppr thing) <+> text "is" <+> ppr_lev act_lev
Nothing -> text "got" <+> ppr_an_lev act_lev <+> pp_exp_thing ]
msg_for_same_rep _ _
@@ -2157,8 +2159,8 @@ pprTcSolverReportMsg ctxt
-- (TYPE (BoxedRep lev)) ~ (TYPE IntRep); or CONSTRAINT ditto
msg_for_different_rep exp_rr_tc act_rr_tc
- = sep [ text "Expected a" <+> what <> text ", but"
- , case mb_thing of
+ = sep [ text "Expected a" <+> what <> comma
+ , text "but" <+> case mb_thing of
Just thing -> quotes (ppr thing)
Nothing -> quotes (pprWithTYPE act)
<+> text "has representation" <+> ppr_rep act_rr_tc ]
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -1699,7 +1699,7 @@ non-exported generic functions.
-}
unifyType :: Maybe TypedThing -- ^ If present, the thing that has type ty1
- -> TcTauType -> TcTauType -- ty1, ty2
+ -> TcTauType -> TcTauType -- ty1 (actual), ty2 (expected)
-> TcM TcCoercionN -- :: ty1 ~# ty2
-- Actual and expected types
-- Returns a coercion : ty1 ~ ty2
@@ -1753,6 +1753,8 @@ uType, uType_defer
--------------
-- It is always safe to defer unification to the main constraint solver
-- See Note [Deferred unification]
+-- ty1 is "actual"
+-- ty2 is "expected"
uType_defer t_or_k origin ty1 ty2
= do { co <- emitWantedEq origin t_or_k Nominal ty1 ty2
=====================================
testsuite/tests/typecheck/should_fail/T5570.stderr
=====================================
@@ -1,6 +1,7 @@
T5570.hs:7:16: error:
- • Expecting a lifted type, but ‘Double#’ is unlifted
+ • Expected a boxed type,
+ but ‘Double#’ has representation ‘DoubleRep’
• In the first argument of ‘($)’, namely ‘D#’
In the second argument of ‘($)’, namely ‘D# $ 3.0##’
In the expression: print $ D# $ 3.0##
=====================================
testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
=====================================
@@ -1,7 +1,6 @@
UnliftedNewtypesInstanceFail.hs:13:3: error:
- • Couldn't match kind ‘'IntRep’ with ‘'WordRep’
- Expected kind ‘TYPE 'WordRep’,
- but ‘Bar Bool’ has kind ‘TYPE 'IntRep’
+ • Expected a type with representation ‘WordRep’,
+ but ‘Bar Bool’ has representation ‘IntRep’
• In the newtype instance declaration for ‘Bar’
In the instance declaration for ‘Foo Bool’
=====================================
testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr
=====================================
@@ -1,6 +1,6 @@
UnliftedNewtypesMismatchedKind.hs:12:10: error:
- • Expecting a lifted type, but ‘Int#’ is unlifted
+ • Expected a boxed type, but ‘Int#’ has representation ‘IntRep’
• In the type ‘Int#’
In the definition of data constructor ‘MkT’
In the newtype declaration for ‘T’
=====================================
testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr
=====================================
@@ -1,12 +1,14 @@
UnliftedNewtypesMultiFieldGadt.hs:19:11: error:
- • Expecting an unlifted type, but ‘Bool’ is lifted
+ • Expected a type with representation ‘IntRep’, but
+ ‘Bool’ has representation ‘BoxedRep’
• In the type ‘Bool’
In the definition of data constructor ‘FooC’
In the newtype declaration for ‘Foo’
UnliftedNewtypesMultiFieldGadt.hs:19:19: error:
- • Expecting an unlifted type, but ‘Char’ is lifted
+ • Expected a type with representation ‘IntRep’, but
+ ‘Char’ has representation ‘BoxedRep’
• In the type ‘Char’
In the definition of data constructor ‘FooC’
In the newtype declaration for ‘Foo’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a8417cc86761f58881ddad449c252638d37f3aa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a8417cc86761f58881ddad449c252638d37f3aa
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220822/e0b4bd8a/attachment-0001.html>
More information about the ghc-commits
mailing list