diff options
48 files changed, 445 insertions, 374 deletions
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 0e687040e0..82dbd65848 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -1901,7 +1901,7 @@ tk_eq_msg ctxt ct ty1 ty2 orig@(TypeEqOrigin { uo_actual = act count_args ty = count isVisibleBinder $ fst $ splitPiTys ty tk_eq_msg ctxt ct ty1 ty2 - (KindEqOrigin cty1 mb_cty2 sub_o mb_sub_t_or_k) + (KindEqOrigin cty1 cty2 sub_o mb_sub_t_or_k) = vcat [ headline_eq_msg False ct ty1 ty2 , supplementary_msg ] where @@ -1911,17 +1911,15 @@ tk_eq_msg ctxt ct ty1 ty2 supplementary_msg = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions -> - case mb_cty2 of - Just cty2 - | printExplicitCoercions - || not (cty1 `pickyEqType` cty2) - -> vcat [ hang (text "When matching" <+> sub_whats) - 2 (vcat [ ppr cty1 <+> dcolon <+> + if printExplicitCoercions + || not (cty1 `pickyEqType` cty2) + then vcat [ hang (text "When matching" <+> sub_whats) + 2 (vcat [ ppr cty1 <+> dcolon <+> ppr (tcTypeKind cty1) , ppr cty2 <+> dcolon <+> ppr (tcTypeKind cty2) ]) , mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o ] - _ -> text "When matching the kind of" <+> quotes (ppr cty1) + else text "When matching the kind of" <+> quotes (ppr cty1) tk_eq_msg _ _ _ _ _ = panic "typeeq_mismatch_msg" @@ -2873,8 +2871,7 @@ relevantBindings want_filtering ctxt ct -- For *kind* errors, report the relevant bindings of the -- enclosing *type* equality, because that's more useful for the programmer ; let extra_tvs = case tidy_orig of - KindEqOrigin t1 m_t2 _ _ -> tyCoVarsOfTypes $ - t1 : maybeToList m_t2 + KindEqOrigin t1 t2 _ _ -> tyCoVarsOfTypes [t1,t2] _ -> emptyVarSet ct_fvs = tyCoVarsOfCt ct `unionVarSet` extra_tvs diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs index 29dc16ab07..cc1411ba90 100644 --- a/compiler/GHC/Tc/Gen/App.hs +++ b/compiler/GHC/Tc/Gen/App.hs @@ -244,9 +244,13 @@ tcApp works like this: when in checking mode. This is the shaded part of APP-Downarrow in Fig 5. -5. Use tcValArgs to typecheck the value arguments +5. Use unifyResultType to match up the result type of the call + with that expected by the context. See Note [Unify with + expected type before typechecking arguments] -6. After a gruesome special case for tagToEnum, rebuild the result. +6. Use tcValArgs to typecheck the value arguments + +7. After a gruesome special case for tagToEnum, rebuild the result. Some cases that /won't/ work: @@ -274,6 +278,34 @@ particular Ids: the renamer (Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr), and we want them to be instantiated impredicatively so that (f `op`), say, will work OK even if `f` is higher rank. + +Note [Unify with expected type before typechecking arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (#19364) + data Pair a b = Pair a b + baz :: MkPair Int Bool + baz = MkPair "yes" "no" + +We instantiate MkPair with `alpha`, `beta`, and push its argument +types (`alpha` and `beta`) into the arguments ("yes" and "no"). +But if we first unify the result type (Pair alpha beta) with the expected +type (Pair Int Bool) we will push the much more informative types +`Int` and `Bool` into the arguments. This makes a difference: + +Unify result type /after/ typechecking the args + • Couldn't match type ‘[Char]’ with ‘Bool’ + Expected type: Pair Foo Bar + Actual type: Pair [Char] [Char] + • In the expression: Pair "yes" "no" + +Unify result type /before/ typechecking the args + • Couldn't match type ‘[Char]’ with ‘Bool’ + Expected: Foo + Actual: String + • In the first argument of ‘Pair’, namely ‘"yes"’ + +The latter is much better. That is why we call unifyExpectedType +before tcValArgs. -} tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) @@ -288,7 +320,26 @@ tcApp rn_expr exp_res_ty ; (delta, inst_args, app_res_rho) <- tcInstFun do_ql True fun fun_sigma rn_args -- Quick look at result - ; quickLookResultType do_ql delta app_res_rho exp_res_ty + ; app_res_rho <- if do_ql + then quickLookResultType delta app_res_rho exp_res_ty + else return app_res_rho + + -- Unify with expected type from the context + -- See Note [Unify with expected type before typechecking arguments] + -- + -- perhaps_add_res_ty_ctxt: Inside an expansion, the addFunResCtxt stuff is + -- more confusing than helpful because the function at the head isn't in + -- the source program; it was added by the renamer. See + -- Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr + ; let perhaps_add_res_ty_ctxt thing_inside + | insideExpansion fun_ctxt + = thing_inside + | otherwise + = addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ + thing_inside + + ; res_co <- perhaps_add_res_ty_ctxt $ + unifyExpectedType rn_expr app_res_rho exp_res_ty ; whenDOptM Opt_D_dump_tc_trace $ do { inst_args <- mapM zonkArg inst_args -- Only when tracing @@ -304,35 +355,13 @@ tcApp rn_expr exp_res_ty -- Typecheck the value arguments ; tc_args <- tcValArgs do_ql inst_args - -- Zonk the result type, to ensure that we substitute out - -- any filled-in instantiation variable before calling tcWrapResultMono - -- In the Check case, this isn't really necessary, because tcWrapResultMono - -- just drops to tcUnify; but in the Infer case a filled-in instantiation - -- variable might perhaps escape into the constraint generator. The safe - -- thing to do is to any instantaition variables away. - -- See Note [Instantiation variables are short lived] - ; app_res_rho <- zonkQuickLook do_ql app_res_rho - - -- Special case for tagToEnum# - ; if isTagToEnum rn_fun - then tcTagToEnum rn_expr tc_fun fun_ctxt tc_args app_res_rho exp_res_ty - else - - do { -- Reconstruct - ; let tc_expr = rebuildHsApps tc_fun fun_ctxt tc_args - - -- Set a context for the helpful - -- "Probably cause: f applied to too many args" - -- But not in generated code, where we don't want - -- to mention internal (rebindable syntax) function names - set_res_ctxt thing_inside - | insideExpansion tc_args - = thing_inside - | otherwise - = addFunResCtxt tc_fun tc_args app_res_rho exp_res_ty thing_inside + -- Reconstruct, with special case for tagToEnum# + ; tc_expr <- if isTagToEnum rn_fun + then tcTagToEnum tc_fun fun_ctxt tc_args app_res_rho + else return (rebuildHsApps tc_fun fun_ctxt tc_args) -- Wrap the result - ; set_res_ctxt $ tcWrapResultMono rn_expr tc_expr app_res_rho exp_res_ty } } + ; return (mkHsWrapCo res_co tc_expr) } -------------------- wantQuickLook :: HsExpr GhcRn -> TcM Bool @@ -869,18 +898,28 @@ skipQuickLook :: Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst) skipQuickLook delta larg = return (delta, ValArg larg) ---------------- -quickLookResultType :: Bool -> Delta -> TcRhoType -> ExpRhoType -> TcM () +quickLookResultType :: Delta -> TcRhoType -> ExpRhoType -> TcM TcRhoType -- This function implements the shaded bit of rule APP-Downarrow in -- Fig 5 of the QL paper: "A quick look at impredicativity" (ICFP'20). - -quickLookResultType do_ql delta app_res_rho exp_res_ty - | do_ql - , not (isEmptyVarSet delta) -- Optimisation only - , Just exp_rho <- checkingExpType_maybe exp_res_ty - -- In checking mode only - = qlUnify delta app_res_rho exp_rho - | otherwise - = return () +-- It returns its second argument, but with any variables in Delta +-- substituted out, so no variables in Delta escape + +quickLookResultType delta app_res_rho (Check exp_rho) + = -- In checking mode only, do qlUnify with the expected result type + do { unless (isEmptyVarSet delta) $ -- Optimisation only + qlUnify delta app_res_rho exp_rho + ; return app_res_rho } + +quickLookResultType _ app_res_rho (Infer {}) + = zonkTcType app_res_rho + -- Zonk the result type, to ensure that we substitute out any + -- filled-in instantiation variable before calling + -- unifyExpectedType. In the Check case, this isn't necessary, + -- because unifyExpectedType just drops to tcUnify; but in the + -- Infer case a filled-in instantiation variable (filled in by + -- tcInstFun) might perhaps escape into the constraint + -- generator. The safe thing to do is to zonk any instantiation + -- variables away. See Note [Instantiation variables are short lived] --------------------- qlUnify :: Delta -> TcType -> TcType -> TcM () @@ -1080,8 +1119,7 @@ findNoQuantVars fun_ty args {- Note [tagToEnum#] ~~~~~~~~~~~~~~~~~~~~ Nasty check to ensure that tagToEnum# is applied to a type that is an -enumeration TyCon. Unification may refine the type later, but this -check won't see that, alas. It's crude, because it relies on our +enumeration TyCon. It's crude, because it relies on our knowing *now* that the type is ok, which in turn relies on the eager-unification part of the type checker pushing enough information here. In theory the Right Thing to do is to have a new form of @@ -1109,54 +1147,48 @@ isTagToEnum :: HsExpr GhcRn -> Bool isTagToEnum (HsVar _ (L _ fun_id)) = fun_id `hasKey` tagToEnumKey isTagToEnum _ = False -tcTagToEnum :: HsExpr GhcRn - -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] - -> TcRhoType -> ExpRhoType +tcTagToEnum :: HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] + -> TcRhoType -> TcM (HsExpr GhcTc) -- tagToEnum# :: forall a. Int# -> a -- See Note [tagToEnum#] Urgh! -tcTagToEnum expr fun fun_ctxt args app_res_ty res_ty - | null val_args - = failWithTc (text "tagToEnum# must appear applied to one argument") - - | otherwise - = do { res_ty <- readExpType res_ty - ; ty' <- zonkTcType res_ty +tcTagToEnum tc_fun fun_ctxt tc_args res_ty + | [val_arg] <- dropWhile (not . isHsValArg) tc_args + = do { res_ty <- zonkTcType res_ty -- Check that the type is algebraic - ; case tcSplitTyConApp_maybe ty' of { - Nothing -> do { addErrTc (mk_error ty' doc1) + ; case tcSplitTyConApp_maybe res_ty of { + Nothing -> do { addErrTc (mk_error res_ty doc1) ; vanilla_result } ; Just (tc, tc_args) -> do { -- Look through any type family ; fam_envs <- tcGetFamInstEnvs ; case tcLookupDataFamInst_maybe fam_envs tc tc_args of { - Nothing -> do { check_enumeration ty' tc + Nothing -> do { check_enumeration res_ty tc ; vanilla_result } ; Just (rep_tc, rep_args, coi) -> do { -- coi :: tc tc_args ~R rep_tc rep_args - check_enumeration ty' rep_tc + check_enumeration res_ty rep_tc ; let rep_ty = mkTyConApp rep_tc rep_args - fun' = mkHsWrap (WpTyApp rep_ty) fun - expr' = rebuildHsApps fun' fun_ctxt val_args + tc_fun' = mkHsWrap (WpTyApp rep_ty) tc_fun + tc_expr = rebuildHsApps tc_fun' fun_ctxt [val_arg] df_wrap = mkWpCastR (mkTcSymCo coi) - ; return (mkHsWrap df_wrap expr') }}}}} + ; return (mkHsWrap df_wrap tc_expr) }}}}} - where - val_args = dropWhile (not . isHsValArg) args + | otherwise + = failWithTc (text "tagToEnum# must appear applied to one value argument") - vanilla_result - = do { let expr' = rebuildHsApps fun fun_ctxt args - ; tcWrapResultMono expr expr' app_res_ty res_ty } + where + vanilla_result = return (rebuildHsApps tc_fun fun_ctxt tc_args) check_enumeration ty' tc | isEnumerationTyCon tc = return () | otherwise = addErrTc (mk_error ty' doc2) doc1 = vcat [ text "Specify the type by giving a type signature" - , text "e.g. (tagToEnum# x) :: Bool" ] + , text "e.g. (tagToEnum# x) :: Bool" ] doc2 = text "Result type must be an enumeration type" mk_error :: TcType -> SDoc -> SDoc @@ -1174,5 +1206,3 @@ tcTagToEnum expr fun fun_ctxt args app_res_ty res_ty tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann - - diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index faf5e0f2f2..5b57f397ce 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -16,9 +16,10 @@ -} module GHC.Tc.Gen.Head - ( HsExprArg(..), EValArg(..), TcPass(..), AppCtxt(..), appCtxtLoc + ( HsExprArg(..), EValArg(..), TcPass(..) + , AppCtxt(..), appCtxtLoc, insideExpansion , splitHsApps, rebuildHsApps - , addArgWrap, isHsValArg, insideExpansion + , addArgWrap, isHsValArg , countLeadingValArgs, isVisibleArg, pprHsExprArgTc , tcInferAppHead, tcInferAppHead_maybe @@ -204,6 +205,10 @@ appCtxtLoc :: AppCtxt -> SrcSpan appCtxtLoc (VAExpansion _ l) = l appCtxtLoc (VACall _ _ l) = l +insideExpansion :: AppCtxt -> Bool +insideExpansion (VAExpansion {}) = True +insideExpansion (VACall {}) = False + instance Outputable AppCtxt where ppr (VAExpansion e _) = text "VAExpansion" <+> ppr e ppr (VACall f n _) = text "VACall" <+> int n <+> ppr f @@ -317,12 +322,6 @@ isVisibleArg (EValArg {}) = True isVisibleArg (ETypeArg {}) = True isVisibleArg _ = False -insideExpansion :: [HsExprArg p] -> Bool -insideExpansion args = any is_expansion args - where - is_expansion (EWrap (EExpand {})) = True - is_expansion _ = False - instance OutputableBndrId (XPass p) => Outputable (HsExprArg p) where ppr (EValArg { eva_arg = arg }) = text "EValArg" <+> ppr arg ppr (EPrag _ p) = text "EPrag" <+> ppr p @@ -850,9 +849,10 @@ tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc) tcCheckId name res_ty = do { (expr, actual_res_ty) <- tcInferId name ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty]) - ; addFunResCtxt expr [] actual_res_ty res_ty $ - tcWrapResultO (OccurrenceOf name) (HsVar noExtField (noLoc name)) expr - actual_res_ty res_ty } + ; addFunResCtxt rn_fun [] actual_res_ty res_ty $ + tcWrapResultO (OccurrenceOf name) rn_fun expr actual_res_ty res_ty } + where + rn_fun = HsVar noExtField (noLoc name) ------------------------ tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType) @@ -1157,13 +1157,15 @@ naughtiness in both branches. c.f. TcTyClsBindings.mkAuxBinds. * * ********************************************************************* -} -addFunResCtxt :: HsExpr GhcTc -> [HsExprArg 'TcpTc] +addFunResCtxt :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcType -> ExpRhoType -> TcM a -> TcM a -- When we have a mis-match in the return type of a function -- try to give a helpful message about too many/few arguments -addFunResCtxt fun args fun_res_ty env_ty - = addLandmarkErrCtxtM (\env -> (env, ) <$> mk_msg) +-- But not in generated code, where we don't want +-- to mention internal (rebindable syntax) function names +addFunResCtxt fun args fun_res_ty env_ty thing_inside + = addLandmarkErrCtxtM (\env -> (env, ) <$> mk_msg) thing_inside -- NB: use a landmark error context, so that an empty context -- doesn't suppress some more useful context where diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs index b8df1fbae6..8474ca7007 100644 --- a/compiler/GHC/Tc/Solver/Interact.hs +++ b/compiler/GHC/Tc/Solver/Interact.hs @@ -465,11 +465,12 @@ both. (They probably started as [WD] and got split; this is relatively rare and it doesn't seem worth trying to put them back together again.) -} -solveOneFromTheOther :: CtEvidence -- Inert - -> CtEvidence -- WorkItem +solveOneFromTheOther :: CtEvidence -- Inert (Dict or Irred) + -> CtEvidence -- WorkItem (same predicate as inert) -> TcS InteractResult -- Precondition: -- * inert and work item represent evidence for the /same/ predicate +-- * Both are CDictCan or CIrredCan -- -- We can always solve one from the other: even if both are wanted, -- although we don't rewrite wanteds with wanteds, we can combine @@ -499,8 +500,8 @@ solveOneFromTheOther ev_i ev_w -- Inert is Given or Wanted = case ev_i of CtWanted { ctev_nosh = WOnly } - | WDeriv <- nosh_w -> return KeepWork - _ -> return KeepInert + | WDeriv <- nosh_w -> return KeepWork + _ -> return KeepInert -- Consider work item [WD] C ty1 ty2 -- inert item [W] C ty1 ty2 -- Then we must keep the work item. But if the @@ -511,7 +512,7 @@ solveOneFromTheOther ev_i ev_w -- From here on the work-item is Given | CtWanted { ctev_loc = loc_i } <- ev_i - , prohibitedSuperClassSolve (ctEvLoc ev_w) loc_i + , prohibitedSuperClassSolve loc_w loc_i = do { traceTcS "prohibitedClassSolve2" (ppr ev_i $$ ppr ev_w) ; return KeepInert } -- Just discard the un-usable Given -- This never actually happens because @@ -1439,49 +1440,107 @@ solving. ********************************************************************** -} -inertsCanDischarge :: InertCans -> CanEqLHS -> TcType -> CtFlavourRole +{- Note [Combining equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + Inert: g1 :: a ~ t + Work item: g2 :: a ~ t + +Then we can simply solve g2 from g1, thus g2 := g1. Easy! +But it's not so simple: + +* If t is a type variable, the equalties might be oriented differently: + e.g. (g1 :: a~b) and (g2 :: b~a) + So we look both ways round. Hence the SwapFlag result to + inertsCanDischarge. + +* We can only do g2 := g1 if g1 can discharge g2; that depends on + (a) the role and (b) the flavour. E.g. a representational equality + cannot discharge a nominal one; a Wanted cannot discharge a Given. + The predicate is eqCanDischargeFR. + +* If the inert is [W] and the work-item is [WD] we don't want to + forget the [D] part; hence the Bool result of inertsCanDischarge. + +* Visibility. Suppose S :: forall k. k -> Type, and consider unifying + S @Type (a::Type) ~ S @(Type->Type) (b::Type->Type) + From the first argument we get (Type ~ Type->Type); from the second + argument we get (a ~ b) which in turn gives (Type ~ Type->Type). + See typecheck/should_fail/T16204c. + + That first argument is invisible in the source program (aside from + visible type application), so we'd much prefer to get the error from + the second. We track visiblity in the uo_visible field of a TypeEqOrigin. + We use this to prioritise visible errors (see GHC.Tc.Errors.tryReporters, + the partition on isVisibleOrigin). + + So when combining two otherwise-identical equalites, we want to + keep the visible one, and discharge the invisible one. Hence the + call to strictly_more_visible. +-} + +inertsCanDischarge :: InertCans -> Ct -> Maybe ( CtEvidence -- The evidence for the inert , SwapFlag -- Whether we need mkSymCo , Bool) -- True <=> keep a [D] version -- of the [WD] constraint -inertsCanDischarge inerts lhs rhs fr +inertsCanDischarge inerts (CEqCan { cc_lhs = lhs_w, cc_rhs = rhs_w + , cc_ev = ev_w, cc_eq_rel = eq_rel }) | (ev_i : _) <- [ ev_i | CEqCan { cc_ev = ev_i, cc_rhs = rhs_i , cc_eq_rel = eq_rel } - <- findEq inerts lhs - , (ctEvFlavour ev_i, eq_rel) `eqCanDischargeFR` fr - , rhs_i `tcEqType` rhs ] + <- findEq inerts lhs_w + , rhs_i `tcEqType` rhs_w + , inert_beats_wanted ev_i eq_rel ] = -- Inert: a ~ ty -- Work item: a ~ ty Just (ev_i, NotSwapped, keep_deriv ev_i) - | Just rhs_lhs <- canEqLHS_maybe rhs + | Just rhs_lhs <- canEqLHS_maybe rhs_w , (ev_i : _) <- [ ev_i | CEqCan { cc_ev = ev_i, cc_rhs = rhs_i , cc_eq_rel = eq_rel } <- findEq inerts rhs_lhs - , (ctEvFlavour ev_i, eq_rel) `eqCanDischargeFR` fr - , rhs_i `tcEqType` canEqLHSType lhs ] + , rhs_i `tcEqType` canEqLHSType lhs_w + , inert_beats_wanted ev_i eq_rel ] = -- Inert: a ~ b -- Work item: b ~ a Just (ev_i, IsSwapped, keep_deriv ev_i) - | otherwise - = Nothing - where + loc_w = ctEvLoc ev_w + flav_w = ctEvFlavour ev_w + fr_w = (flav_w, eq_rel) + + inert_beats_wanted ev_i eq_rel + = -- eqCanDischargeFR: see second bullet of Note [Combining equalities] + -- strictly_more_visible: see last bullet of Note [Combining equalities] + fr_i`eqCanDischargeFR` fr_w + && not ((loc_w `strictly_more_visible` ctEvLoc ev_i) + && (fr_w `eqCanDischargeFR` fr_i)) + where + fr_i = (ctEvFlavour ev_i, eq_rel) + + -- See Note [Combining equalities], third bullet keep_deriv ev_i | Wanted WOnly <- ctEvFlavour ev_i -- inert is [W] - , (Wanted WDeriv, _) <- fr -- work item is [WD] + , Wanted WDeriv <- flav_w -- work item is [WD] = True -- Keep a derived version of the work item | otherwise = False -- Work item is fully discharged + -- See Note [Combining equalities], final bullet + strictly_more_visible loc1 loc2 + = not (isVisibleOrigin (ctLocOrigin loc2)) && + isVisibleOrigin (ctLocOrigin loc1) + +inertsCanDischarge _ _ = Nothing + + interactEq :: InertCans -> Ct -> TcS (StopOrContinue Ct) interactEq inerts workItem@(CEqCan { cc_lhs = lhs - , cc_rhs = rhs - , cc_ev = ev - , cc_eq_rel = eq_rel }) - | Just (ev_i, swapped, keep_deriv) - <- inertsCanDischarge inerts lhs rhs (ctEvFlavour ev, eq_rel) + , cc_rhs = rhs + , cc_ev = ev + , cc_eq_rel = eq_rel }) + | Just (ev_i, swapped, keep_deriv) <- inertsCanDischarge inerts workItem = do { setEvBindIfWanted ev $ evCoercion (maybeTcSymCo swapped $ tcDowngradeRole (eqRelRole eq_rel) diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs index 3862d842b0..29344b17d7 100644 --- a/compiler/GHC/Tc/Types/Constraint.hs +++ b/compiler/GHC/Tc/Types/Constraint.hs @@ -1559,10 +1559,9 @@ instance Outputable TcEvDest where instance Outputable CtEvidence where ppr ev = ppr (ctEvFlavour ev) - <+> pp_ev - <+> braces (ppr (ctl_depth (ctEvLoc ev))) <> dcolon - -- Show the sub-goal depth too - <+> ppr (ctEvPred ev) + <+> pp_ev <+> braces (ppr (ctl_depth (ctEvLoc ev))) + -- Show the sub-goal depth too + <> dcolon <+> ppr (ctEvPred ev) where pp_ev = case ev of CtGiven { ctev_evar = v } -> ppr v @@ -1860,7 +1859,7 @@ data CtLoc = CtLoc { ctl_origin :: CtOrigin mkKindLoc :: TcType -> TcType -- original *types* being compared -> CtLoc -> CtLoc mkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc) - (KindEqOrigin s1 (Just s2) (ctLocOrigin loc) + (KindEqOrigin s1 s2 (ctLocOrigin loc) (ctLocTypeOrKind_maybe loc)) -- | Take a CtLoc and moves it to the kind level diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs index b0d970bb37..648bf5ce12 100644 --- a/compiler/GHC/Tc/Types/Origin.hs +++ b/compiler/GHC/Tc/Types/Origin.hs @@ -361,7 +361,7 @@ data CtOrigin } | KindEqOrigin - TcType (Maybe TcType) -- A kind equality arising from unifying these two types + TcType TcType -- A kind equality arising from unifying these two types CtOrigin -- originally arising from this (Maybe TypeOrKind) -- the level of the eq this arises from @@ -559,16 +559,15 @@ pprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2) , hang (text "instance" <+> quotes (ppr pred2)) 2 (text "at" <+> ppr loc2) ]) -pprCtOrigin (KindEqOrigin t1 (Just t2) _ _) - = hang (ctoHerald <+> text "a kind equality arising from") - 2 (sep [ppr t1, char '~', ppr t2]) - pprCtOrigin AssocFamPatOrigin = text "when matching a family LHS with its class instance head" -pprCtOrigin (KindEqOrigin t1 Nothing _ _) - = hang (ctoHerald <+> text "a kind equality when matching") - 2 (ppr t1) +pprCtOrigin (TypeEqOrigin { uo_actual = t1, uo_expected = t2, uo_visible = vis }) + = text "a type equality" <> brackets (ppr vis) <+> sep [ppr t1, char '~', ppr t2] + +pprCtOrigin (KindEqOrigin t1 t2 _ _) + = hang (ctoHerald <+> text "a kind equality arising from") + 2 (sep [ppr t1, char '~', ppr t2]) pprCtOrigin (DerivOriginDC dc n _) = hang (ctoHerald <+> text "the" <+> speakNth n @@ -641,7 +640,6 @@ pprCtO DefaultOrigin = text "a 'default' declaration" pprCtO DoOrigin = text "a do statement" pprCtO MCompOrigin = text "a statement in a monad comprehension" pprCtO ProcOrigin = text "a proc expression" -pprCtO (TypeEqOrigin t1 t2 _ _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2] pprCtO AnnOrigin = text "an annotation" pprCtO (ExprHoleOrigin occ) = text "a use of" <+> quotes (ppr occ) pprCtO (TypeHoleOrigin occ) = text "a use of wildcard" <+> quotes (ppr occ) diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index ed9ee9cc44..1e82be0f0e 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -137,7 +137,6 @@ import GHC.Types.Basic ( TypeOrKind(..) ) import Control.Monad import GHC.Data.Maybe -import Control.Arrow ( second ) import qualified Data.Semigroup as Semi {- @@ -2516,13 +2515,11 @@ zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual = act ; (env2, exp') <- zonkTidyTcType env1 exp ; return ( env2, orig { uo_actual = act' , uo_expected = exp' }) } -zonkTidyOrigin env (KindEqOrigin ty1 m_ty2 orig t_or_k) - = do { (env1, ty1') <- zonkTidyTcType env ty1 - ; (env2, m_ty2') <- case m_ty2 of - Just ty2 -> second Just <$> zonkTidyTcType env1 ty2 - Nothing -> return (env1, Nothing) - ; (env3, orig') <- zonkTidyOrigin env2 orig - ; return (env3, KindEqOrigin ty1' m_ty2' orig' t_or_k) } +zonkTidyOrigin env (KindEqOrigin ty1 ty2 orig t_or_k) + = do { (env1, ty1') <- zonkTidyTcType env ty1 + ; (env2, ty2') <- zonkTidyTcType env1 ty2 + ; (env3, orig') <- zonkTidyOrigin env2 orig + ; return (env3, KindEqOrigin ty1' ty2' orig' t_or_k) } zonkTidyOrigin env (FunDepOrigin1 p1 o1 l1 p2 o2 l2) = do { (env1, p1') <- zonkTidyTcType env p1 ; (env2, p2') <- zonkTidyTcType env1 p2 diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs index 121ebfbe7e..eee4e1844c 100644 --- a/compiler/GHC/Tc/Utils/Unify.hs +++ b/compiler/GHC/Tc/Utils/Unify.hs @@ -22,7 +22,7 @@ module GHC.Tc.Utils.Unify ( buildImplicationFor, buildTvImplication, emitResidualTvConstraint, -- Various unifications - unifyType, unifyKind, + unifyType, unifyKind, unifyExpectedType, uType, promoteTcType, swapOverTyVars, canSolveByUnification, @@ -543,11 +543,18 @@ tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc -- It means we don't need to pass in a CtOrigin tcWrapResultMono rn_expr expr act_ty res_ty = ASSERT2( isRhoTy act_ty, ppr act_ty $$ ppr rn_expr ) - do { co <- case res_ty of - Infer inf_res -> fillInferResult act_ty inf_res - Check exp_ty -> unifyType (Just (ppr rn_expr)) act_ty exp_ty + do { co <- unifyExpectedType rn_expr act_ty res_ty ; return (mkHsWrapCo co expr) } +unifyExpectedType :: HsExpr GhcRn + -> TcRhoType -- Actual -- a rho-type not a sigma-type + -> ExpRhoType -- Expected + -> TcM TcCoercionN +unifyExpectedType rn_expr act_ty exp_ty + = case exp_ty of + Infer inf_res -> fillInferResult act_ty inf_res + Check exp_ty -> unifyType (Just (ppr rn_expr)) act_ty exp_ty + ------------------------ tcSubTypePat :: CtOrigin -> UserTypeCtxt -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper @@ -1249,7 +1256,7 @@ uType t_or_k origin orig_ty1 orig_ty2 = do { let ty1 = coercionType co1 ty2 = coercionType co2 ; kco <- uType KindLevel - (KindEqOrigin orig_ty1 (Just orig_ty2) origin + (KindEqOrigin orig_ty1 orig_ty2 origin (Just t_or_k)) ty1 ty2 ; return $ mkProofIrrelCo Nominal kco co1 co2 } @@ -1463,7 +1470,7 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 ; defer } ty1 = mkTyVarTy tv1 - kind_origin = KindEqOrigin ty1 (Just ty2) origin (Just t_or_k) + kind_origin = KindEqOrigin ty1 ty2 origin (Just t_or_k) defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 diff --git a/testsuite/tests/gadt/T3169.stderr b/testsuite/tests/gadt/T3169.stderr index 3a5fc99fb3..5770e03c70 100644 --- a/testsuite/tests/gadt/T3169.stderr +++ b/testsuite/tests/gadt/T3169.stderr @@ -1,20 +1,17 @@ -T3169.hs:13:13: error: +T3169.hs:13:22: error: • Couldn't match type ‘elt’ with ‘Map b elt’ - Expected: Maybe (Map b elt) - Actual: Maybe elt + Expected: Map a (Map b elt) + Actual: Map (a, b) elt ‘elt’ is a rigid type variable bound by the type signature for: lookup :: forall elt. (a, b) -> Map (a, b) elt -> Maybe elt at T3169.hs:12:3-8 - • In the expression: lookup a m :: Maybe (Map b elt) + • In the second argument of ‘lookup’, namely ‘m’ + In the expression: lookup a m :: Maybe (Map b elt) In the expression: case lookup a m :: Maybe (Map b elt) of { Just (m2 :: Map b elt) -> lookup b m2 :: Maybe elt } - In an equation for ‘lookup’: - lookup (a, b) (m :: Map (a, b) elt) - = case lookup a m :: Maybe (Map b elt) of { - Just (m2 :: Map b elt) -> lookup b m2 :: Maybe elt } • Relevant bindings include m :: Map (a, b) elt (bound at T3169.hs:12:17) b :: b (bound at T3169.hs:12:13) diff --git a/testsuite/tests/gadt/rw.stderr b/testsuite/tests/gadt/rw.stderr index fe6ba1edee..c4221368fd 100644 --- a/testsuite/tests/gadt/rw.stderr +++ b/testsuite/tests/gadt/rw.stderr @@ -13,17 +13,17 @@ rw.hs:14:47: error: v :: T a (bound at rw.hs:13:10) writeInt :: T a -> IORef a -> IO () (bound at rw.hs:13:1) -rw.hs:19:43: error: +rw.hs:19:51: error: • Couldn't match type ‘a’ with ‘Bool’ - Expected: a -> IO () - Actual: Bool -> IO () + Expected: a -> Bool + Actual: Bool -> Bool ‘a’ is a rigid type variable bound by the type signature for: readBool :: forall a. T a -> IORef a -> IO () at rw.hs:16:1-34 - • In the second argument of ‘(>>=)’, namely ‘(print . not)’ + • In the second argument of ‘(.)’, namely ‘not’ + In the second argument of ‘(>>=)’, namely ‘(print . not)’ In the expression: readIORef ref >>= (print . not) - In a case alternative: ~(Lb x) -> readIORef ref >>= (print . not) • Relevant bindings include ref :: IORef a (bound at rw.hs:17:12) v :: T a (bound at rw.hs:17:10) diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stderr b/testsuite/tests/ghci.debugger/scripts/T14628.stderr index fbce771874..0eb90fde1f 100644 --- a/testsuite/tests/ghci.debugger/scripts/T14628.stderr +++ b/testsuite/tests/ghci.debugger/scripts/T14628.stderr @@ -1,9 +1,9 @@ -<interactive>:4:7: error: +<interactive>:4:17: error: • Couldn't match type ‘m’ with ‘(,) a0’ - Expected: (a0, ((), Int)) - Actual: m ((), Int) + Expected: StateT Int ((,) a0) () + Actual: StateT Int m () ‘m’ is an interactive-debugger skolem - • In the second argument of ‘($)’, namely ‘runStateT _result 0’ + • In the first argument of ‘runStateT’, namely ‘_result’ + In the second argument of ‘($)’, namely ‘runStateT _result 0’ In the expression: snd $ runStateT _result 0 - In an equation for ‘it’: it = snd $ runStateT _result 0 diff --git a/testsuite/tests/ghci/scripts/T10508.stderr b/testsuite/tests/ghci/scripts/T10508.stderr index f7931e48e2..8cbcb2936d 100644 --- a/testsuite/tests/ghci/scripts/T10508.stderr +++ b/testsuite/tests/ghci/scripts/T10508.stderr @@ -1,13 +1,10 @@ -<interactive>:1:8: error: +<interactive>:1:15: error: • Couldn't match type: a0 -> a0 with: [Char] - Expected: IO Prelude.String - Actual: IO (a0 -> a0) - • In the expression: return id + Expected: Prelude.String + Actual: a0 -> a0 + • Probable cause: ‘id’ is applied to too few arguments + In the first argument of ‘return’, namely ‘id’ + In the expression: return id In the second argument of ‘(.)’, namely ‘(\ _ -> return id)’ - In the expression: - (.) - (GHC.GHCi.ghciStepIO :: IO Prelude.String -> IO Prelude.String) - (\ _ -> return id) :: - Prelude.String -> IO Prelude.String diff --git a/testsuite/tests/indexed-types/should_compile/T12538.stderr b/testsuite/tests/indexed-types/should_compile/T12538.stderr index 7a26b9c483..7de8f787af 100644 --- a/testsuite/tests/indexed-types/should_compile/T12538.stderr +++ b/testsuite/tests/indexed-types/should_compile/T12538.stderr @@ -3,12 +3,12 @@ T12538.hs:37:8: error: • Could not deduce: a' ~ Tagged Int a from the context: (TagImpl a a', b ~ DF a') bound by the instance declaration at T12538.hs:36:10-46 - Expected: a -> b - Actual: a -> DF (Tagged Int a) + Expected: Tagged Int a -> b + Actual: Tagged Int a -> DF (Tagged Int a) ‘a'’ is a rigid type variable bound by the instance declaration at T12538.hs:36:10-46 - • In the expression: DF . tag + • In the first argument of ‘(.)’, namely ‘DF’ + In the expression: DF . tag In an equation for ‘df’: df = DF . tag - In the instance declaration for ‘ToDF a b’ • Relevant bindings include df :: a -> b (bound at T12538.hs:37:3) diff --git a/testsuite/tests/indexed-types/should_fail/T15870.stderr b/testsuite/tests/indexed-types/should_fail/T15870.stderr index ce087941ea..7968dc3dda 100644 --- a/testsuite/tests/indexed-types/should_fail/T15870.stderr +++ b/testsuite/tests/indexed-types/should_fail/T15870.stderr @@ -1,6 +1,9 @@ T15870.hs:32:34: error: • Couldn't match kind ‘k’ with ‘*’ + When matching kinds + b :: * + a :: k Expected kind ‘Optic a’, but ‘g2’ has kind ‘Optic b’ ‘k’ is a rigid type variable bound by a family instance declaration diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr index 721267e75d..be58f59e05 100644 --- a/testsuite/tests/indexed-types/should_fail/T2544.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr @@ -1,13 +1,26 @@ -T2544.hs:19:12: error: +T2544.hs:19:18: error: + • Couldn't match type: IxMap i0 + with: IxMap l + Expected: IxMap l [Int] + Actual: IxMap i0 [Int] + NB: ‘IxMap’ is a non-injective type family + The type variable ‘i0’ is ambiguous + • In the first argument of ‘BiApp’, namely ‘empty’ + In the expression: BiApp empty empty + In an equation for ‘empty’: empty = BiApp empty empty + • Relevant bindings include + empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:19:4) + +T2544.hs:19:24: error: • Couldn't match type: IxMap i1 with: IxMap r - Expected: IxMap (l :|: r) [Int] - Actual: BiApp (IxMap i0) (IxMap i1) [Int] + Expected: IxMap r [Int] + Actual: IxMap i1 [Int] NB: ‘IxMap’ is a non-injective type family The type variable ‘i1’ is ambiguous - • In the expression: BiApp empty empty + • In the second argument of ‘BiApp’, namely ‘empty’ + In the expression: BiApp empty empty In an equation for ‘empty’: empty = BiApp empty empty - In the instance declaration for ‘Ix (l :|: r)’ • Relevant bindings include empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:19:4) diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr index 64fa851258..deaffc82dd 100644 --- a/testsuite/tests/indexed-types/should_fail/T2664.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr @@ -1,30 +1,22 @@ -T2664.hs:31:9: error: - • Could not deduce: Dual a ~ Dual b +T2664.hs:31:52: error: + • Could not deduce: b ~ a arising from a use of ‘newPChan’ from the context: ((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) bound by the type signature for: newPChan :: forall c. ((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) => IO (PChan (a :*: b), PChan c) at T2664.hs:23:5-12 - Expected: IO (PChan (a :*: b), PChan c) - Actual: IO (PChan (a :*: b), PChan (Dual b :+: Dual a)) - NB: ‘Dual’ is a non-injective type family - • In a stmt of a 'do' block: - return - (O $ takeMVar v, - E (pchoose Right v newPChan) (pchoose Left v newPChan)) + ‘b’ is a rigid type variable bound by + the instance declaration + at T2664.hs:22:10-52 + ‘a’ is a rigid type variable bound by + the instance declaration + at T2664.hs:22:10-52 + • In the third argument of ‘pchoose’, namely ‘newPChan’ + In the first argument of ‘E’, namely ‘(pchoose Right v newPChan)’ In the expression: - do v <- newEmptyMVar - return - (O $ takeMVar v, - E (pchoose Right v newPChan) (pchoose Left v newPChan)) - In an equation for ‘newPChan’: - newPChan - = do v <- newEmptyMVar - return - (O $ takeMVar v, - E (pchoose Right v newPChan) (pchoose Left v newPChan)) + E (pchoose Right v newPChan) (pchoose Left v newPChan) • Relevant bindings include v :: MVar (Either (PChan a) (PChan b)) (bound at T2664.hs:24:9) newPChan :: IO (PChan (a :*: b), PChan c) (bound at T2664.hs:23:5) diff --git a/testsuite/tests/indexed-types/should_fail/T4272.stderr b/testsuite/tests/indexed-types/should_fail/T4272.stderr index c921445d2e..69df514c0f 100644 --- a/testsuite/tests/indexed-types/should_fail/T4272.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4272.stderr @@ -1,16 +1,17 @@ -T4272.hs:15:19: error: - • Couldn't match expected type ‘TermFamily a a’ - with actual type ‘a’ +T4272.hs:15:26: error: + • Couldn't match type ‘a’ with ‘TermFamily a a’ + Expected: TermFamily a (TermFamily a a) + Actual: TermFamily a a ‘a’ is a rigid type variable bound by the type signature for: laws :: forall a b. TermLike a => TermFamily a a -> b at T4272.hs:14:1-53 - • In the second argument of ‘prune’, namely + • In the first argument of ‘terms’, namely + ‘(undefined :: TermFamily a a)’ + In the second argument of ‘prune’, namely ‘(terms (undefined :: TermFamily a a))’ In the expression: prune t (terms (undefined :: TermFamily a a)) - In an equation for ‘laws’: - laws t = prune t (terms (undefined :: TermFamily a a)) • Relevant bindings include t :: TermFamily a a (bound at T4272.hs:15:6) laws :: TermFamily a a -> b (bound at T4272.hs:15:1) diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr index 5dcce91edb..c7f230654e 100644 --- a/testsuite/tests/indexed-types/should_fail/T5439.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr @@ -3,7 +3,8 @@ T5439.hs:82:33: error: • Couldn't match expected type: Attempt (HElemOf rs) with actual type: Attempt (HHead (HDrop n0 l0)) -> Attempt (HElemOf l0) - • In the second argument of ‘($)’, namely + • Probable cause: ‘($)’ is applied to too few arguments + In the second argument of ‘($)’, namely ‘inj $ Failure (e :: SomeException)’ In a stmt of a 'do' block: c <- complete ev $ inj $ Failure (e :: SomeException) diff --git a/testsuite/tests/indexed-types/should_fail/T9662.stderr b/testsuite/tests/indexed-types/should_fail/T9662.stderr index 04acdc653d..e2f7597b93 100644 --- a/testsuite/tests/indexed-types/should_fail/T9662.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9662.stderr @@ -2,7 +2,7 @@ T9662.hs:49:8: error: • Couldn't match type ‘n’ with ‘Int’ Expected: Exp (((sh :. k) :. m) :. n) - -> Exp (((sh :. k) :. m) :. n) + -> Exp (((sh :. m) :. n) :. k) Actual: Exp (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int)) -> Exp diff --git a/testsuite/tests/partial-sigs/should_fail/Forall1Bad.stderr b/testsuite/tests/partial-sigs/should_fail/Forall1Bad.stderr index 26c895ef3c..4a2d167327 100644 --- a/testsuite/tests/partial-sigs/should_fail/Forall1Bad.stderr +++ b/testsuite/tests/partial-sigs/should_fail/Forall1Bad.stderr @@ -1,5 +1,6 @@ -Forall1Bad.hs:9:8: error: +Forall1Bad.hs:9:13: error: • Couldn't match expected type ‘Char’ with actual type ‘Bool’ - • In the expression: fall True + • In the first argument of ‘fall’, namely ‘True’ + In the expression: fall True In an equation for ‘test’: test = fall True diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr index e366651f7d..17ffbc1595 100644 --- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr +++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr @@ -22,14 +22,14 @@ NamedWildcardExplicitForall.hs:13:26: error: To use the inferred type, enable PartialTypeSignatures • In the type signature: baz :: forall _a. _a -> _b -> (_a, _b) -NamedWildcardExplicitForall.hs:14:16: error: - • Couldn't match expected type ‘Bool’ with actual type ‘_a’ +NamedWildcardExplicitForall.hs:14:12: error: + • Couldn't match expected type ‘_a’ with actual type ‘Bool’ ‘_a’ is a rigid type variable bound by the inferred type of baz :: _a -> Bool -> (_a, Bool) at NamedWildcardExplicitForall.hs:13:15-16 - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x + • In the expression: not x In the expression: (not x, not y) + In an equation for ‘baz’: baz x y = (not x, not y) • Relevant bindings include x :: _a (bound at NamedWildcardExplicitForall.hs:14:5) baz :: _a -> Bool -> (_a, Bool) diff --git a/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr b/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr index e4c368c6e1..a1a1295b12 100644 --- a/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr +++ b/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr @@ -1,9 +1,10 @@ -PatBind3.hs:6:12: error: +PatBind3.hs:6:17: error: • Couldn't match type ‘(Bool, w)’ with ‘Char’ - Expected: Maybe ((Bool, w) -> Char) - Actual: Maybe ((Bool, w) -> (Bool, w)) - • In the expression: Just id + Expected: (Bool, w) -> Char + Actual: (Bool, w) -> (Bool, w) + • In the first argument of ‘Just’, namely ‘id’ + In the expression: Just id In a pattern binding: Just foo = Just id • Relevant bindings include foo :: (Bool, w) -> Char (bound at PatBind3.hs:6:6) diff --git a/testsuite/tests/patsyn/should_fail/T15695.stderr b/testsuite/tests/patsyn/should_fail/T15695.stderr index 82398e15a7..9418f15a71 100644 --- a/testsuite/tests/patsyn/should_fail/T15695.stderr +++ b/testsuite/tests/patsyn/should_fail/T15695.stderr @@ -33,12 +33,13 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)] from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] (bound at T15695.hs:39:1) -T15695.hs:40:26: warning: [-Wdeferred-type-errors (in -Wdefault)] +T15695.hs:40:33: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type: a0 : as0 with: '[] - Expected: NS (NP NA) '[ '[ 'VO]] - Actual: NS (NP NA) ('[ 'VO] : a0 : as0) - • In the expression: There (Here undefined) + Expected: NS (NP NA) '[] + Actual: NS (NP NA) (a0 : as0) + • In the first argument of ‘There’, namely ‘(Here undefined)’ + In the expression: There (Here undefined) In an equation for ‘from'’: from' (ASSO (Right b)) = There (Here undefined) • Relevant bindings include diff --git a/testsuite/tests/th/T10945.stderr b/testsuite/tests/th/T10945.stderr index 1c7a0f238d..fe71a2f50c 100644 --- a/testsuite/tests/th/T10945.stderr +++ b/testsuite/tests/th/T10945.stderr @@ -1,10 +1,17 @@ -T10945.hs:7:4: error: +T10945.hs:7:11: error: • Couldn't match type: [Dec] with: Q [Dec] - Expected: Code Q DecsQ - Actual: Code Q [Dec] - • In the expression: + Expected: DecsQ + Actual: [Dec] + • In the first argument of ‘return’, namely + ‘[SigD + (mkName "m") + (ForallT + [PlainTV (mkName "a") SpecifiedSpec] [] + (AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a")))), + FunD (mkName "m") [Clause [...] (NormalB (VarE (mkName "x"))) []]]’ + In the expression: return [SigD (mkName "m") @@ -20,11 +27,3 @@ T10945.hs:7:4: error: [PlainTV (mkName "a") SpecifiedSpec] [] (AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a")))), FunD (mkName "m") [Clause [...] (NormalB (VarE (mkName "x"))) []]]) - In the expression: - $$(return - [SigD - (mkName "m") - (ForallT - [PlainTV (mkName "a") SpecifiedSpec] [] - (AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a")))), - FunD (mkName "m") [Clause ... (NormalB (VarE (mkName "x"))) []]]) diff --git a/testsuite/tests/typecheck/should_compile/FD2.stderr b/testsuite/tests/typecheck/should_compile/FD2.stderr index 323d10f06d..a5462aa94e 100644 --- a/testsuite/tests/typecheck/should_compile/FD2.stderr +++ b/testsuite/tests/typecheck/should_compile/FD2.stderr @@ -1,6 +1,6 @@ -FD2.hs:26:36: error: - • Couldn't match expected type ‘e’ with actual type ‘e1’ +FD2.hs:26:34: error: + • Couldn't match expected type ‘e1’ with actual type ‘e’ ‘e1’ is a rigid type variable bound by the type signature for: mf :: forall e1. Elem a e1 => e1 -> Maybe e1 -> Maybe e1 @@ -9,9 +9,9 @@ FD2.hs:26:36: error: the type signature for: foldr1 :: forall e. Elem a e => (e -> e -> e) -> a -> e at FD2.hs:21:13-47 - • In the first argument of ‘f’, namely ‘x’ - In the first argument of ‘Just’, namely ‘(f x y)’ + • In the first argument of ‘Just’, namely ‘(f x y)’ In the expression: Just (f x y) + In an equation for ‘mf’: mf x (Just y) = Just (f x y) • Relevant bindings include y :: e1 (bound at FD2.hs:26:23) x :: e1 (bound at FD2.hs:26:15) diff --git a/testsuite/tests/typecheck/should_compile/T15368.stderr b/testsuite/tests/typecheck/should_compile/T15368.stderr index 33b0407730..5760692c75 100644 --- a/testsuite/tests/typecheck/should_compile/T15368.stderr +++ b/testsuite/tests/typecheck/should_compile/T15368.stderr @@ -14,14 +14,15 @@ T15368.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] • Relevant bindings include trigger :: a -> b -> (F a b, F b a) (bound at T15368.hs:11:1) -T15368.hs:11:15: warning: [-Wdeferred-type-errors (in -Wdefault)] +T15368.hs:11:30: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type: F b0 a0 with: F b a - Expected: (F a b, F b a) - Actual: (F a b, F b0 a0) + Expected: (F a0 b0, F b a) + Actual: (F a0 b0, F b0 a0) NB: ‘F’ is a non-injective type family The type variables ‘b0’, ‘a0’ are ambiguous - • In the expression: _ `transitive` trigger _ _ + • In the second argument of ‘transitive’, namely ‘trigger _ _’ + In the expression: _ `transitive` trigger _ _ In an equation for ‘trigger’: trigger _ _ = _ `transitive` trigger _ _ • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_compile/T15370.stderr b/testsuite/tests/typecheck/should_compile/T15370.stderr index f359155dbd..798cfc9f8a 100644 --- a/testsuite/tests/typecheck/should_compile/T15370.stderr +++ b/testsuite/tests/typecheck/should_compile/T15370.stderr @@ -20,19 +20,15 @@ T15370.hs:20:13: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘S r’ with ‘()’ Expected: () Actual: S r - • In the expression: no + _ + • In the first argument of ‘(+)’, namely ‘no’ + In the expression: no + _ In a case alternative: Refl -> no + _ - In the expression: case mkRefl @x @y of { Refl -> no + _ } • Relevant bindings include no :: S r (bound at T15370.hs:18:7) right :: S r -> () (bound at T15370.hs:18:1) T15370.hs:20:18: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: S r - Where: ‘r’, ‘y’, ‘x’ are rigid type variables bound by - the type signature for: - right :: forall x y (r :: Either x y). S r -> () - at T15370.hs:(16,1)-(17,18) + • Found hole: _ :: () • In the second argument of ‘(+)’, namely ‘_’ In the expression: no + _ In a case alternative: Refl -> no + _ @@ -40,3 +36,8 @@ T15370.hs:20:18: warning: [-Wtyped-holes (in -Wdefault)] no :: S r (bound at T15370.hs:18:7) right :: S r -> () (bound at T15370.hs:18:1) Constraints include y ~ x (from T15370.hs:20:5-8) + Valid hole fits include + () :: () + mempty :: forall a. Monoid a => a + maxBound :: forall a. Bounded a => a + minBound :: forall a. Bounded a => a diff --git a/testsuite/tests/typecheck/should_compile/T2494.stderr b/testsuite/tests/typecheck/should_compile/T2494.stderr index 8e427c5ac8..d7c96aeeaa 100644 --- a/testsuite/tests/typecheck/should_compile/T2494.stderr +++ b/testsuite/tests/typecheck/should_compile/T2494.stderr @@ -21,7 +21,7 @@ T2494.hs:15:14: error: T2494.hs:15:30: error: • Couldn't match type ‘b’ with ‘a’ - Expected: Maybe (m b) -> Maybe (m a) + Expected: Maybe (m a) -> Maybe (m a) Actual: Maybe (m b) -> Maybe (m b) ‘b’ is a rigid type variable bound by the RULE "foo/foo" diff --git a/testsuite/tests/typecheck/should_fail/T12648.stderr b/testsuite/tests/typecheck/should_fail/T12648.stderr index f13b6c1cd0..6f12341c06 100644 --- a/testsuite/tests/typecheck/should_fail/T12648.stderr +++ b/testsuite/tests/typecheck/should_fail/T12648.stderr @@ -1,17 +1,13 @@ -T12648.hs:76:2: error: - • Couldn't match type ‘a’ with ‘()’ - Expected: m a - Actual: m () +T12648.hs:76:9: error: + • Couldn't match expected type ‘a’ with actual type ‘()’ ‘a’ is a rigid type variable bound by the type signature for: f :: forall (m :: * -> *) a. MonadBaseUnlift m IO => m a at T12648.hs:71:1-34 - • In a stmt of a 'do' block: return () + • In the first argument of ‘return’, namely ‘()’ + In a stmt of a 'do' block: return () In the expression: do _ <- askUnliftBase return () - In an equation for ‘f’: - f = do _ <- askUnliftBase - return () • Relevant bindings include f :: m a (bound at T12648.hs:72:1) diff --git a/testsuite/tests/typecheck/should_fail/T1899.stderr b/testsuite/tests/typecheck/should_fail/T1899.stderr index bd4aceed9e..ceb5f69c66 100644 --- a/testsuite/tests/typecheck/should_fail/T1899.stderr +++ b/testsuite/tests/typecheck/should_fail/T1899.stderr @@ -1,15 +1,15 @@ -T1899.hs:15:36: error: - • Couldn't match type ‘a’ with ‘Proposition a0’ - Expected: [Proposition a0] - Actual: [a] +T1899.hs:15:26: error: + • Couldn't match expected type ‘a’ + with actual type ‘Proposition a0’ ‘a’ is a rigid type variable bound by the type signature for: transRHS :: forall a. [a] -> Int -> Constraint a at T1899.hs:9:2-39 - • In the first argument of ‘Auxiliary’, namely ‘varSet’ - In the first argument of ‘Prop’, namely ‘(Auxiliary varSet)’ + • In the first argument of ‘Prop’, namely ‘(Auxiliary varSet)’ In the expression: Prop (Auxiliary varSet) + In the expression: + [Prop (Auxiliary varSet), Prop (Auxiliary varSet)] • Relevant bindings include varSet :: [a] (bound at T1899.hs:10:11) transRHS :: [a] -> Int -> Constraint a (bound at T1899.hs:10:2) diff --git a/testsuite/tests/typecheck/should_fail/T19364.hs b/testsuite/tests/typecheck/should_fail/T19364.hs new file mode 100644 index 0000000000..6b7259c6ee --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T19364.hs @@ -0,0 +1,12 @@ +module T19364 where + +type Foo = Bool +type Bar = String + +data Pair a b = Pair a b + +baz :: Pair Foo Bar +baz = Pair "yes" "no" + +-- The whole point about this test is the quality +-- of the error message in baz: see #19364 diff --git a/testsuite/tests/typecheck/should_fail/T19364.stderr b/testsuite/tests/typecheck/should_fail/T19364.stderr new file mode 100644 index 0000000000..ffd5ad2bf7 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T19364.stderr @@ -0,0 +1,8 @@ + +T19364.hs:9:12: error: + • Couldn't match type ‘[Char]’ with ‘Bool’ + Expected: Foo + Actual: String + • In the first argument of ‘Pair’, namely ‘"yes"’ + In the expression: Pair "yes" "no" + In an equation for ‘baz’: baz = Pair "yes" "no" diff --git a/testsuite/tests/typecheck/should_fail/T2688.stderr b/testsuite/tests/typecheck/should_fail/T2688.stderr index f7980d2734..748ec505f3 100644 --- a/testsuite/tests/typecheck/should_fail/T2688.stderr +++ b/testsuite/tests/typecheck/should_fail/T2688.stderr @@ -1,5 +1,5 @@ -T2688.hs:8:14: error: +T2688.hs:8:22: error: • Couldn't match expected type ‘v’ with actual type ‘s’ ‘s’ is a rigid type variable bound by the class declaration for ‘VectorSpace’ @@ -7,8 +7,9 @@ T2688.hs:8:14: error: ‘v’ is a rigid type variable bound by the class declaration for ‘VectorSpace’ at T2688.hs:5:19 - • In the expression: v *^ (1 / s) - In an equation for ‘^/’: v ^/ s = v *^ (1 / s) + • In the second argument of ‘(/)’, namely ‘s’ + In the second argument of ‘(*^)’, namely ‘(1 / s)’ + In the expression: v *^ (1 / s) • Relevant bindings include s :: s (bound at T2688.hs:8:10) v :: v (bound at T2688.hs:8:5) diff --git a/testsuite/tests/typecheck/should_fail/T3613.stderr b/testsuite/tests/typecheck/should_fail/T3613.stderr index 8183ff981e..cff3344597 100644 --- a/testsuite/tests/typecheck/should_fail/T3613.stderr +++ b/testsuite/tests/typecheck/should_fail/T3613.stderr @@ -1,12 +1,11 @@ T3613.hs:14:20: error: • Couldn't match type ‘IO’ with ‘Maybe’ - Expected: Maybe b - Actual: IO b - • In the first argument of ‘fooThen’, namely ‘(bar >> undefined)’ + Expected: Maybe () + Actual: IO () + • In the first argument of ‘(>>)’, namely ‘bar’ + In the first argument of ‘fooThen’, namely ‘(bar >> undefined)’ In the expression: fooThen (bar >> undefined) - In the expression: - let fooThen m = foo >> m in fooThen (bar >> undefined) T3613.hs:17:24: error: • Couldn't match type ‘IO’ with ‘Maybe’ diff --git a/testsuite/tests/typecheck/should_fail/T3950.stderr b/testsuite/tests/typecheck/should_fail/T3950.stderr index f71fd5d501..69ff276479 100644 --- a/testsuite/tests/typecheck/should_fail/T3950.stderr +++ b/testsuite/tests/typecheck/should_fail/T3950.stderr @@ -1,12 +1,13 @@ -T3950.hs:15:8: error: +T3950.hs:15:13: error: • Couldn't match kind ‘*’ with ‘* -> *’ When matching types w :: (* -> * -> *) -> * Sealed :: (* -> *) -> * - Expected: Maybe (w (Id p)) - Actual: Maybe (Sealed (Id p0 x0)) - • In the expression: Just rp' + Expected: w (Id p) + Actual: Sealed (Id p0 x0) + • In the first argument of ‘Just’, namely ‘rp'’ + In the expression: Just rp' In an equation for ‘rp’: rp _ = Just rp' diff --git a/testsuite/tests/typecheck/should_fail/T6018failclosed2.stderr b/testsuite/tests/typecheck/should_fail/T6018failclosed2.stderr index 3b203968f0..52d57c01e6 100644 --- a/testsuite/tests/typecheck/should_fail/T6018failclosed2.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018failclosed2.stderr @@ -1,7 +1,6 @@ -T6018failclosed2.hs:17:14: - Couldn't match expected type ‘Bar a0’ with actual type ‘Char’ - The type variable ‘a0’ is ambiguous - In the first argument of ‘bar’, namely ‘'c'’ - In the expression: bar 'c' - In an equation for ‘barapp’: barapp = bar 'c' +T6018failclosed2.hs:17:10: error: + • Couldn't match expected type ‘Char’ with actual type ‘Bar a0’ + The type variable ‘a0’ is ambiguous + • In the expression: bar 'c' + In an equation for ‘barapp’: barapp = bar 'c' diff --git a/testsuite/tests/typecheck/should_fail/T8450.stderr b/testsuite/tests/typecheck/should_fail/T8450.stderr index 9ac0d63643..8ba84a76f1 100644 --- a/testsuite/tests/typecheck/should_fail/T8450.stderr +++ b/testsuite/tests/typecheck/should_fail/T8450.stderr @@ -1,15 +1,11 @@ -T8450.hs:8:19: error: - • Couldn't match type ‘a’ with ‘Bool’ - Expected: Either Bool () - Actual: Either a () +T8450.hs:8:7: error: + • Couldn't match expected type ‘a’ with actual type ‘()’ ‘a’ is a rigid type variable bound by the type signature for: run :: forall a. a at T8450.hs:7:1-18 - • In the second argument of ‘($)’, namely - ‘(undefined :: Either a ())’ - In the expression: runEffect $ (undefined :: Either a ()) + • In the expression: runEffect $ (undefined :: Either a ()) In an equation for ‘run’: run = runEffect $ (undefined :: Either a ()) • Relevant bindings include run :: a (bound at T8450.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/T9260.stderr b/testsuite/tests/typecheck/should_fail/T9260.stderr index b3752e4279..2a6c0ac16c 100644 --- a/testsuite/tests/typecheck/should_fail/T9260.stderr +++ b/testsuite/tests/typecheck/should_fail/T9260.stderr @@ -1,7 +1,8 @@ -T9260.hs:12:8: error: - • Couldn't match type ‘2’ with ‘1’ - Expected: Fin 1 - Actual: Fin ((0 + 1) + 1) - • In the expression: Fsucc Fzero +T9260.hs:12:14: error: + • Couldn't match type ‘1’ with ‘0’ + Expected: Fin 0 + Actual: Fin (0 + 1) + • In the first argument of ‘Fsucc’, namely ‘Fzero’ + In the expression: Fsucc Fzero In an equation for ‘test’: test = Fsucc Fzero diff --git a/testsuite/tests/typecheck/should_fail/T9774.stderr b/testsuite/tests/typecheck/should_fail/T9774.stderr index da75c339b8..2381e3ce75 100644 --- a/testsuite/tests/typecheck/should_fail/T9774.stderr +++ b/testsuite/tests/typecheck/should_fail/T9774.stderr @@ -1,8 +1,8 @@ -T9774.hs:5:17: error: +T9774.hs:5:29: error: • Couldn't match type ‘Char’ with ‘[Char]’ Expected: String Actual: Char - • In the first argument of ‘putStrLn’, namely ‘(assert True 'a')’ + • In the second argument of ‘assert’, namely ‘'a'’ + In the first argument of ‘putStrLn’, namely ‘(assert True 'a')’ In the expression: putStrLn (assert True 'a') - In an equation for ‘foo’: foo = putStrLn (assert True 'a') diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 07eafc65b5..4768b19263 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -616,3 +616,4 @@ test('T12178a', normal, compile_fail, ['']) test('T18869', normal, compile_fail, ['']) test('T19142', normal, compile_fail, ['']) test('T19346', normal, compile_fail, ['-fprint-typechecker-elaboration']) +test('T19364', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail065.stderr b/testsuite/tests/typecheck/should_fail/tcfail065.stderr index 9be21918cb..81746cd200 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail065.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail065.stderr @@ -1,8 +1,6 @@ -tcfail065.hs:29:18: error: - • Couldn't match type ‘x1’ with ‘x’ - Expected: X x - Actual: X x1 +tcfail065.hs:29:20: error: + • Couldn't match expected type ‘x’ with actual type ‘x1’ ‘x1’ is a rigid type variable bound by the type signature for: setX :: forall x1. x1 -> X x -> X x @@ -10,9 +8,9 @@ tcfail065.hs:29:18: error: ‘x’ is a rigid type variable bound by the instance declaration at tcfail065.hs:28:10-19 - • In the expression: X x + • In the first argument of ‘X’, namely ‘x’ + In the expression: X x In an equation for ‘setX’: setX x (X _) = X x - In the instance declaration for ‘HasX (X x)’ • Relevant bindings include x :: x1 (bound at tcfail065.hs:29:8) setX :: x1 -> X x -> X x (bound at tcfail065.hs:29:3) diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr index c7b7630e04..7266e76823 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr @@ -22,10 +22,10 @@ tcfail068.hs:14:9: error: itgen :: (Int, Int) -> a -> IndTree s a (bound at tcfail068.hs:12:1) -tcfail068.hs:19:9: error: +tcfail068.hs:19:21: error: • Couldn't match type ‘s1’ with ‘s’ - Expected: GHC.ST.ST s1 (IndTree s a) - Actual: GHC.ST.ST s (IndTree s a) + Expected: STArray s1 (Int, Int) a + Actual: IndTree s a ‘s1’ is a rigid type variable bound by a type expected by the context: forall s1. GHC.ST.ST s1 (IndTree s a) @@ -36,18 +36,11 @@ tcfail068.hs:19:9: error: Constructed a => (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a at tcfail068.hs:16:1-75 - • In the first argument of ‘runST’, namely + • In the first argument of ‘readSTArray’, namely ‘arr’ + In the first argument of ‘(>>=)’, namely ‘readSTArray arr i’ + In the first argument of ‘runST’, namely ‘(readSTArray arr i >>= \ val -> writeSTArray arr i (f val) >> return arr)’ - In the expression: - runST - (readSTArray arr i - >>= \ val -> writeSTArray arr i (f val) >> return arr) - In an equation for ‘itiap’: - itiap i f arr - = runST - (readSTArray arr i - >>= \ val -> writeSTArray arr i (f val) >> return arr) • Relevant bindings include arr :: IndTree s a (bound at tcfail068.hs:17:11) itiap :: (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr index 84c9c8b0b6..0a7a386f9e 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr @@ -1,8 +1,8 @@ -tcfail103.hs:15:13: error: +tcfail103.hs:15:23: error: • Couldn't match type ‘s’ with ‘t’ - Expected: ST s Int - Actual: ST t Int + Expected: STRef s Int + Actual: STRef t Int ‘s’ is a rigid type variable bound by the type signature for: g :: forall s. ST s Int @@ -11,13 +11,9 @@ tcfail103.hs:15:13: error: the type signature for: f :: forall t. ST t Int at tcfail103.hs:10:1-12 - • In the expression: readSTRef v + • In the first argument of ‘readSTRef’, namely ‘v’ + In the expression: readSTRef v In an equation for ‘g’: g = readSTRef v - In the expression: - do v <- newSTRef 5 - let g :: ST s Int - g = readSTRef v - g • Relevant bindings include g :: ST s Int (bound at tcfail103.hs:15:9) v :: STRef t Int (bound at tcfail103.hs:12:5) diff --git a/testsuite/tests/typecheck/should_fail/tcfail131.stderr b/testsuite/tests/typecheck/should_fail/tcfail131.stderr index 04fa000204..25f3f427ed 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail131.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail131.stderr @@ -1,12 +1,11 @@ -tcfail131.hs:7:11: error: - • Couldn't match expected type ‘Integer’ with actual type ‘b’ +tcfail131.hs:7:9: error: + • Couldn't match expected type ‘b’ with actual type ‘Integer’ ‘b’ is a rigid type variable bound by the type signature for: g :: forall b. Num b => b -> b at tcfail131.hs:6:3-22 - • In the first argument of ‘f’, namely ‘x’ - In the expression: f x x + • In the expression: f x x In an equation for ‘g’: g x = f x x • Relevant bindings include x :: b (bound at tcfail131.hs:7:5) diff --git a/testsuite/tests/typecheck/should_fail/tcfail153.stderr b/testsuite/tests/typecheck/should_fail/tcfail153.stderr index 4faca8f037..0d38db4385 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail153.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail153.stderr @@ -1,12 +1,13 @@ -tcfail153.hs:6:9: error: - • Couldn't match expected type ‘Bool’ with actual type ‘a’ +tcfail153.hs:6:7: error: + • Couldn't match type ‘a’ with ‘Bool’ + Expected: [a] + Actual: [Bool] ‘a’ is a rigid type variable bound by the type signature for: f :: forall a. a -> [a] at tcfail153.hs:5:1-13 - • In the first argument of ‘g’, namely ‘x’ - In the expression: g x + • In the expression: g x In an equation for ‘f’: f x = g x diff --git a/testsuite/tests/typecheck/should_fail/tcfail179.stderr b/testsuite/tests/typecheck/should_fail/tcfail179.stderr index a0c124590f..963ab0ba78 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail179.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail179.stderr @@ -1,8 +1,6 @@ -tcfail179.hs:14:41: error: - • Couldn't match type ‘x’ with ‘s’ - Expected: x -> s - Actual: x -> x +tcfail179.hs:14:39: error: + • Couldn't match expected type ‘s’ with actual type ‘x’ ‘x’ is a rigid type variable bound by a pattern with constructor: T :: forall s x. (s -> (x -> s) -> (x, s, Int)) -> T s, @@ -12,11 +10,11 @@ tcfail179.hs:14:41: error: the type signature for: run :: forall s. T s -> Int at tcfail179.hs:12:1-17 - • In the second argument of ‘g’, namely ‘id’ + • In the first argument of ‘g’, namely ‘x’ In the expression: g x id In a pattern binding: (x, _, b) = g x id • Relevant bindings include - x :: s (bound at tcfail179.hs:14:26) + x :: x (bound at tcfail179.hs:14:26) g :: s -> (x -> s) -> (x, s, Int) (bound at tcfail179.hs:14:16) ts :: T s (bound at tcfail179.hs:13:5) run :: T s -> Int (bound at tcfail179.hs:13:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.stderr b/testsuite/tests/typecheck/should_fail/tcfail201.stderr index dd1385fc90..023772c775 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail201.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail201.stderr @@ -1,17 +1,15 @@ -tcfail201.hs:17:56: error: - • Couldn't match type ‘a’ with ‘HsDoc id0’ - Expected: c a - Actual: c (HsDoc id0) +tcfail201.hs:17:58: error: + • Couldn't match expected type ‘a’ with actual type ‘HsDoc id0’ ‘a’ is a rigid type variable bound by the type signature for: gfoldl' :: forall (c :: * -> *) a. (forall a1 b. c (a1 -> b) -> a1 -> c b) -> (forall g. g -> c g) -> a -> c a at tcfail201.hs:15:1-85 - • In the expression: z DocEmpty + • In the first argument of ‘z’, namely ‘DocEmpty’ + In the expression: z DocEmpty In a case alternative: DocEmpty -> z DocEmpty - In the expression: case hsDoc of { DocEmpty -> z DocEmpty } • Relevant bindings include hsDoc :: a (bound at tcfail201.hs:16:13) gfoldl' :: (forall a1 b. c (a1 -> b) -> a1 -> c b) diff --git a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr index c2ff69c9ef..a4b6cc0b74 100644 --- a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr +++ b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr @@ -1,50 +1,27 @@ -CaretDiagnostics1.hs:(5,3)-(7,16): error: +CaretDiagnostics1.hs:7:8-15: error: • Couldn't match expected type ‘IO a0’ with actual type ‘Int’ - • In a stmt of a 'do' block: + • In the second argument of ‘(+)’, namely ‘(3 :: Int)’ + In a stmt of a 'do' block: 10000000000000000000000000000000000000 + 2 + (3 :: Int) In the expression: do 10000000000000000000000000000000000000 + 2 + (3 :: Int) pure ("this is not an IO" + ()) - In an equation for ‘main’: - main - = do 10000000000000000000000000000000000000 + 2 + (3 :: Int) - pure ("this is not an IO" + ()) - where - _ = case id of { "γηξ" -> () '0' } | -5 | 10000000000000000000000000000000000000 + - | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^... +7 | (3 :: Int) + | ^^^^^^^^ -CaretDiagnostics1.hs:8:3-45: error: +CaretDiagnostics1.hs:8:9-27: error: • Couldn't match type ‘[Char]’ with ‘()’ - Expected: IO () - Actual: IO String - • In a stmt of a 'do' block: pure ("this is not an IO" + ()) - In the expression: - do 10000000000000000000000000000000000000 + 2 + (3 :: Int) - pure ("this is not an IO" + ()) - In an equation for ‘main’: - main - = do 10000000000000000000000000000000000000 + 2 + (3 :: Int) - pure ("this is not an IO" + ()) - where - _ = case id of { "γηξ" -> () '0' } - | -8 | pure ("this is not an IO" + ( )) - | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -CaretDiagnostics1.hs:8:31-44: error: - • Couldn't match type ‘()’ with ‘[Char]’ - Expected: String - Actual: () - • In the second argument of ‘(+)’, namely ‘()’ + Expected: () + Actual: String + • In the first argument of ‘(+)’, namely ‘"this is not an IO"’ In the first argument of ‘pure’, namely ‘("this is not an IO" + ())’ In a stmt of a 'do' block: pure ("this is not an IO" + ()) | 8 | pure ("this is not an IO" + ( )) - | ^^^^^^^^^^^^^^ + | ^^^^^^^^^^^^^^^^^^^ CaretDiagnostics1.hs:13:7-11: error: • Couldn't match type: a1 -> a1 |