diff options
417 files changed, 3790 insertions, 3304 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 14cfc22cc1..e795ba443c 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -745,8 +745,7 @@ toInteger_RDR = nameRdrName toIntegerName toRational_RDR = nameRdrName toRationalName fromIntegral_RDR = nameRdrName fromIntegralName -stringTy_RDR, fromString_RDR :: RdrName -stringTy_RDR = tcQual_RDR gHC_BASE (fsLit "String") +fromString_RDR :: RdrName fromString_RDR = nameRdrName fromStringName fromList_RDR, fromListN_RDR, toList_RDR :: RdrName @@ -1679,11 +1678,13 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey, eqTyConKey, heqTyConKey, - smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey :: Unique + smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey, + stringTyConKey :: Unique addrPrimTyConKey = mkPreludeTyConUnique 1 arrayPrimTyConKey = mkPreludeTyConUnique 3 boolTyConKey = mkPreludeTyConUnique 4 byteArrayPrimTyConKey = mkPreludeTyConUnique 5 +stringTyConKey = mkPreludeTyConUnique 6 charPrimTyConKey = mkPreludeTyConUnique 7 charTyConKey = mkPreludeTyConUnique 8 doublePrimTyConKey = mkPreludeTyConUnique 9 diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index 694d05869e..8513b24403 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -39,7 +39,7 @@ module GHC.Builtin.Types ( -- * Char charTyCon, charDataCon, charTyCon_RDR, - charTy, stringTy, charTyConName, + charTy, stringTy, charTyConName, stringTyCon_RDR, -- * Double doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, @@ -218,6 +218,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they , anyTyCon , boolTyCon , charTyCon + , stringTyCon , doubleTyCon , floatTyCon , intTyCon @@ -297,11 +298,12 @@ coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercib coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId -charTyConName, charDataConName, intTyConName, intDataConName :: Name -charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon -charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon -intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon -intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon +charTyConName, charDataConName, intTyConName, intDataConName, stringTyConName :: Name +charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon +charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon +stringTyConName = mkWiredInTyConName UserSyntax gHC_BASE (fsLit "String") stringTyConKey stringTyCon +intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon +intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon boolTyConName, falseDataConName, trueDataConName :: Name boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon @@ -503,13 +505,14 @@ vecElemDataConNames = zipWith3Lazy mk_special_dc_name mk_special_dc_name :: FastString -> Unique -> DataCon -> Name mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc -boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, +boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, stringTyCon_RDR, intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName boolTyCon_RDR = nameRdrName boolTyConName false_RDR = nameRdrName falseDataConName true_RDR = nameRdrName trueDataConName intTyCon_RDR = nameRdrName intTyConName charTyCon_RDR = nameRdrName charTyConName +stringTyCon_RDR = nameRdrName stringTyConName intDataCon_RDR = nameRdrName intDataConName listTyCon_RDR = nameRdrName listTyConName consDataCon_RDR = nameRdrName consDataConName @@ -1398,7 +1401,15 @@ charDataCon :: DataCon charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon stringTy :: Type -stringTy = mkListTy charTy -- convenience only +stringTy = mkTyConApp stringTyCon [] + +stringTyCon :: TyCon +-- We have this wired-in so that Haskell literal strings +-- get type String (in hsLitType), which in turn influences +-- inferred types and error messages +stringTyCon = buildSynTyCon stringTyConName + [] liftedTypeKind [] + (mkListTy charTy) intTy :: Type intTy = mkTyConTy intTyCon diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 9aa8ea5e2c..b5e7770ed3 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -262,6 +262,7 @@ tidyCoAxBndrsForUser :: TidyEnv -> [Var] -> (TidyEnv, [Var]) -- forall a _1 _2. F _1 [a] _2 = ... -- -- This is a rather disgusting function +-- See Note [Wildcard names] in GHC.Tc.Gen.HsType tidyCoAxBndrsForUser init_env tcvs = (tidy_env, reverse tidy_bndrs) where diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index f06ae70a4e..4c9f99a6a7 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -112,7 +112,7 @@ module GHC.Core.Type ( isCoercionTy_maybe, isForAllTy, isForAllTy_ty, isForAllTy_co, isPiTy, isTauTy, isFamFreeTy, - isCoVarType, + isCoVarType, isAtomicTy, isValidJoinPointType, tyConAppNeedsKindSig, @@ -812,7 +812,7 @@ mkAppTy ty1 ty2 = AppTy ty1 ty2 -- Here Id is partially applied in the type sig for Foo, -- but once the type synonyms are expanded all is well -- - -- Moreover in GHC.Tc.Types.tcInferApps we build up a type + -- Moreover in GHC.Tc.Types.tcInferTyApps we build up a type -- (T t1 t2 t3) one argument at a type, thus forming -- (T t1), (T t1 t2), etc @@ -1875,6 +1875,20 @@ isTauTy (ForAllTy {}) = False isTauTy (CastTy ty _) = isTauTy ty isTauTy (CoercionTy _) = False -- Not sure about this +isAtomicTy :: Type -> Bool +-- True if the type is just a single token, and can be printed compactly +-- Used when deciding how to lay out type error messages; see the +-- call in GHC.Tc.Errors +isAtomicTy (TyVarTy {}) = True +isAtomicTy (LitTy {}) = True +isAtomicTy (TyConApp _ []) = True + +isAtomicTy ty | isLiftedTypeKind ty = True + -- 'Type' prints compactly as * + -- See GHC.Iface.Type.ppr_kind_type + +isAtomicTy _ = False + {- %************************************************************************ %* * diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 6cc61246b9..4f14b1b931 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1434,7 +1434,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do ------------------ Code output ----------------------- rawcmms0 <- {-# SCC "cmmToRawCmm" #-} - lookupHook cmmToRawCmmHook + lookupHook (\x -> cmmToRawCmmHook x) (\dflg _ -> cmmToRawCmm dflg) dflags dflags (Just this_mod) cmms let dump a = do @@ -1506,7 +1506,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do unless (null cmmgroup) $ dumpIfSet_dyn dflags Opt_D_dump_cmm "Output Cmm" FormatCMM (ppr cmmgroup) - rawCmms <- lookupHook cmmToRawCmmHook + rawCmms <- lookupHook (\x -> cmmToRawCmmHook x) (\dflgs _ -> cmmToRawCmm dflgs) dflags dflags Nothing (Stream.yield cmmgroup) _ <- codeOutput dflags cmm_mod output_filename no_loc NoStubs [] [] rawCmms diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index ccc5a8d422..7b784e950b 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -738,8 +738,9 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars = sdocOption sdocPrintTypecheckerElaboration $ \case False -> pprLHsBinds val_binds True -> -- Show extra information (bug number: #10662) - hang (text "AbsBinds" <+> brackets (interpp'SP tyvars) - <+> brackets (interpp'SP dictvars)) + hang (text "AbsBinds" + <+> sep [ brackets (interpp'SP tyvars) + , brackets (interpp'SP dictvars) ]) 2 $ braces $ vcat [ text "Exports:" <+> brackets (sep (punctuate comma (map ppr exports))) @@ -751,7 +752,7 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars instance OutputableBndrId p => Outputable (ABExport (GhcPass p)) where ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags }) - = vcat [ ppr gbl <+> text "<=" <+> ppr lcl + = vcat [ sep [ ppr gbl, nest 2 (text "<=" <+> ppr lcl) ] , nest 2 (pprTcSpecPrags prags) , pprIfTc @p $ nest 2 (text "wrap:" <+> ppr wrap) ] diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs index 2bb4d11240..dd9ec15912 100644 --- a/compiler/GHC/Hs/Types.hs +++ b/compiler/GHC/Hs/Types.hs @@ -213,8 +213,8 @@ A wildcard in a type can be * An anonymous wildcard, written '_' In HsType this is represented by HsWildCardTy. - The renamer leaves it untouched, and it is later given fresh meta tyvars in - the typechecker. + The renamer leaves it untouched, and it is later given a fresh + meta tyvar in the typechecker. * A named wildcard, written '_a', '_foo', etc @@ -597,6 +597,7 @@ data HsTyVarBndr flag pass flag (Located (IdP pass)) -- See Note [Located RdrNames] in GHC.Hs.Expr + | KindedTyVar (XKindedTyVar pass) flag diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs index 7bd9506ca1..df1313aa1d 100644 --- a/compiler/GHC/HsToCore/Binds.hs +++ b/compiler/GHC/HsToCore/Binds.hs @@ -160,6 +160,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun matchWrapper (mkPrefixFunRhs (L loc (idName fun))) Nothing matches + ; core_wrap <- dsHsWrapper co_fn ; let body' = mkOptTickBox tick body rhs = core_wrap (mkLams args body') @@ -197,7 +198,11 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig }) - = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) (dsLHsBinds binds) + = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) $ + dsLHsBinds binds + -- addTyCsDs: push type constraints deeper + -- for inner pattern match check + -- See Check, Note [Type and Term Equality Propagation] ; ds_ev_binds <- dsTcEvBinds_s ev_binds diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs index f9de7c8282..ef56c35845 100644 --- a/compiler/GHC/HsToCore/PmCheck.hs +++ b/compiler/GHC/HsToCore/PmCheck.hs @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.HsToCore.PmCheck.Types import GHC.HsToCore.PmCheck.Oracle import GHC.HsToCore.PmCheck.Ppr -import GHC.Types.Basic (Origin, isGenerated) +import GHC.Types.Basic (Origin(..), isGenerated) import GHC.Core (CoreExpr, Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) import GHC.Driver.Session diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 80c4505c8e..e399a27af9 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -529,7 +529,7 @@ loadInterface doc_str mod from ; -- invoke plugins with *full* interface, not final_iface, to ensure -- that plugins have access to declarations, etc. - res <- withPlugins dflags interfaceLoadAction iface + res <- withPlugins dflags (\p -> interfaceLoadAction p) iface ; return (Succeeded res) }}}} diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs index 78d943bed8..eaee84119b 100644 --- a/compiler/GHC/Rename/Splice.hs +++ b/compiler/GHC/Rename/Splice.hs @@ -48,7 +48,7 @@ import GHC.Driver.Hooks import GHC.Builtin.Names.TH ( quoteExpName, quotePatName, quoteDecName, quoteTypeName , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, ) -import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckExpr ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckPolyExpr ) import {-# SOURCE #-} GHC.Tc.Gen.Splice ( runMetaD , runMetaE @@ -324,7 +324,7 @@ runRnSplice flavour run_meta ppr_res splice ; meta_exp_ty <- tcMetaTy meta_ty_name ; zonked_q_expr <- zonkTopLExpr =<< tcTopSpliceExpr Untyped - (tcCheckExpr the_expr meta_exp_ty) + (tcCheckPolyExpr the_expr meta_exp_ty) -- Run the expression ; mod_finalizers_ref <- newTcRef [] diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index e2a7f5f251..41bc8cd269 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -221,6 +221,7 @@ report_unsolved type_errors expr_holes , text "Wanted:" <+> ppr wanted ] ; warn_redundant <- woptM Opt_WarnRedundantConstraints + ; exp_syns <- goptM Opt_PrintExpandedSynonyms ; let err_ctxt = CEC { cec_encl = [] , cec_tidy = tidy_env , cec_defer_type_errors = type_errors @@ -234,6 +235,7 @@ report_unsolved type_errors expr_holes -- See #15539 and c.f. setting ic_status -- in GHC.Tc.Solver.setImplicationStatus , cec_warn_redundant = warn_redundant + , cec_expand_syns = exp_syns , cec_binds = binds_var } ; tc_lvl <- getTcLevel @@ -337,6 +339,7 @@ data ReportErrCtxt , cec_out_of_scope_holes :: HoleChoice -- Out of scope holes , cec_warn_redundant :: Bool -- True <=> -Wredundant-constraints + , cec_expand_syns :: Bool -- True <=> -fprint-expanded-synonyms , cec_suppress :: Bool -- True <=> More important errors have occurred, -- so create bindings if need be, but @@ -351,6 +354,7 @@ instance Outputable ReportErrCtxt where , cec_type_holes = th , cec_out_of_scope_holes = osh , cec_warn_redundant = wr + , cec_expand_syns = es , cec_suppress = sup }) = text "CEC" <+> braces (vcat [ text "cec_binds" <+> equals <+> ppr bvar @@ -359,6 +363,7 @@ instance Outputable ReportErrCtxt where , text "cec_type_holes" <+> equals <+> ppr th , text "cec_out_of_scope_holes" <+> equals <+> ppr osh , text "cec_warn_redundant" <+> equals <+> ppr wr + , text "cec_expand_syns" <+> equals <+> ppr es , text "cec_suppress" <+> equals <+> ppr sup ]) -- | Returns True <=> the ReportErrCtxt indicates that something is deferred @@ -403,7 +408,7 @@ previously suppressed. (e.g. partial-sigs/should_fail/T14584) -} reportImplic :: ReportErrCtxt -> Implication -> TcM () -reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_telescope = m_telescope +reportImplic ctxt implic@(Implic { ic_skols = tvs , ic_given = given , ic_wanted = wanted, ic_binds = evb , ic_status = status, ic_info = info @@ -417,10 +422,12 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_telescope = m_telescope | otherwise = do { traceTc "reportImplic" (ppr implic') + ; when bad_telescope $ reportBadTelescope ctxt tcl_env info tvs + -- Do /not/ use the tidied tvs because then are in the + -- wrong order, so tidying will rename things wrongly ; reportWanteds ctxt' tc_lvl wanted ; when (cec_warn_redundant ctxt) $ - warnRedundantConstraints ctxt' tcl_env info' dead_givens - ; when bad_telescope $ reportBadTelescope ctxt tcl_env m_telescope tvs } + warnRedundantConstraints ctxt' tcl_env info' dead_givens } where tcl_env = ic_env implic insoluble = isInsolubleStatus status @@ -492,8 +499,8 @@ warnRedundantConstraints ctxt env info ev_vars improving pred -- (transSuperClasses p) does not include p = any isImprovementPred (pred : transSuperClasses pred) -reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> Maybe SDoc -> [TcTyVar] -> TcM () -reportBadTelescope ctxt env (Just telescope) skols +reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcTyVar] -> TcM () +reportBadTelescope ctxt env (ForAllSkol _ telescope) skols = do { msg <- mkErrorReport ctxt env (important doc) ; reportError msg } where @@ -503,8 +510,8 @@ reportBadTelescope ctxt env (Just telescope) skols sorted_tvs = scopedSort skols -reportBadTelescope _ _ Nothing skols - = pprPanic "reportBadTelescope" (ppr skols) +reportBadTelescope _ _ skol_info skols + = pprPanic "reportBadTelescope" (ppr skol_info $$ ppr skols) {- Note [Redundant constraints in instance decls] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -752,8 +759,7 @@ mkGivenErrorReporter ctxt cts report = important inaccessible_msg `mappend` mk_relevant_bindings binds_msg - ; err <- mkEqErr_help dflags ctxt report ct' - Nothing ty1 ty2 + ; err <- mkEqErr_help dflags ctxt report ct' ty1 ty2 ; traceTc "mkGivenErrorReporter" (ppr ct) ; reportWarning (Reason Opt_WarnInaccessibleCode) err } @@ -1126,7 +1132,7 @@ mkIrredErr ctxt cts ; let orig = ctOrigin ct1 msg = couldNotDeduce (getUserGivens ctxt) (map ctPred cts, orig) ; mkErrorMsgFromCt ctxt ct1 $ - important msg `mappend` mk_relevant_bindings binds_msg } + msg `mappend` mk_relevant_bindings binds_msg } where (ct1:_) = cts @@ -1276,14 +1282,14 @@ mkIPErr ctxt cts preds = map ctPred cts givens = getUserGivens ctxt msg | null givens - = addArising orig $ + = important $ addArising orig $ sep [ text "Unbound implicit parameter" <> plural cts , nest 2 (pprParendTheta preds) ] | otherwise = couldNotDeduce givens (preds, orig) ; mkErrorMsgFromCt ctxt ct1 $ - important msg `mappend` mk_relevant_bindings binds_msg } + msg `mappend` mk_relevant_bindings binds_msg } where (ct1:_) = cts @@ -1356,56 +1362,17 @@ mkEqErr1 ctxt ct -- Wanted or derived; = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct ; rdr_env <- getGlobalRdrEnv ; fam_envs <- tcGetFamInstEnvs - ; exp_syns <- goptM Opt_PrintExpandedSynonyms - ; let (keep_going, is_oriented, wanted_msg) - = mk_wanted_extra (ctLoc ct) exp_syns - coercible_msg = case ctEqRel ct of + ; let coercible_msg = case ctEqRel ct of NomEq -> empty ReprEq -> mkCoercibleExplanation rdr_env fam_envs ty1 ty2 ; dflags <- getDynFlags - ; traceTc "mkEqErr1" (ppr ct $$ pprCtOrigin (ctOrigin ct) $$ ppr keep_going) - ; let report = mconcat [important wanted_msg, important coercible_msg, - mk_relevant_bindings binds_msg] - ; if keep_going - then mkEqErr_help dflags ctxt report ct is_oriented ty1 ty2 - else mkErrorMsgFromCt ctxt ct report } + ; traceTc "mkEqErr1" (ppr ct $$ pprCtOrigin (ctOrigin ct)) + ; let report = mconcat [ important coercible_msg + , mk_relevant_bindings binds_msg] + ; mkEqErr_help dflags ctxt report ct ty1 ty2 } where (ty1, ty2) = getEqPredTys (ctPred ct) - -- If the types in the error message are the same as the types - -- we are unifying, don't add the extra expected/actual message - mk_wanted_extra :: CtLoc -> Bool -> (Bool, Maybe SwapFlag, SDoc) - mk_wanted_extra loc expandSyns - = case ctLocOrigin loc of - orig@TypeEqOrigin {} -> mkExpectedActualMsg ty1 ty2 orig - t_or_k expandSyns - where - t_or_k = ctLocTypeOrKind_maybe loc - - KindEqOrigin cty1 mb_cty2 sub_o sub_t_or_k - -> (True, Nothing, msg1 $$ msg2) - where - sub_what = case sub_t_or_k of Just KindLevel -> text "kinds" - _ -> text "types" - msg1 = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions -> - case mb_cty2 of - Just cty2 - | printExplicitCoercions - || not (cty1 `pickyEqType` cty2) - -> hang (text "When matching" <+> sub_what) - 2 (vcat [ ppr cty1 <+> dcolon <+> - ppr (tcTypeKind cty1) - , ppr cty2 <+> dcolon <+> - ppr (tcTypeKind cty2) ]) - _ -> text "When matching the kind of" <+> quotes (ppr cty1) - msg2 = case sub_o of - TypeEqOrigin {} - | Just cty2 <- mb_cty2 -> - thdOf3 (mkExpectedActualMsg cty1 cty2 sub_o sub_t_or_k - expandSyns) - _ -> empty - _ -> (True, Nothing, empty) - -- | This function tries to reconstruct why a "Coercible ty1 ty2" constraint -- is left over. mkCoercibleExplanation :: GlobalRdrEnv -> FamInstEnvs @@ -1453,76 +1420,43 @@ mkCoercibleExplanation rdr_env fam_envs ty1 ty2 | otherwise = False -{- --- | Make a listing of role signatures for all the parameterised tycons --- used in the provided types - - --- SLPJ Jun 15: I could not convince myself that these hints were really --- useful. Maybe they are, but I think we need more work to make them --- actually helpful. -mkRoleSigs :: Type -> Type -> SDoc -mkRoleSigs ty1 ty2 - = ppUnless (null role_sigs) $ - hang (text "Relevant role signatures:") - 2 (vcat role_sigs) - where - tcs = nameEnvElts $ tyConsOfType ty1 `plusNameEnv` tyConsOfType ty2 - role_sigs = mapMaybe ppr_role_sig tcs - - ppr_role_sig tc - | null roles -- if there are no parameters, don't bother printing - = Nothing - | isBuiltInSyntax (tyConName tc) -- don't print roles for (->), etc. - = Nothing - | otherwise - = Just $ hsep $ [text "type role", ppr tc] ++ map ppr roles - where - roles = tyConRoles tc --} - mkEqErr_help :: DynFlags -> ReportErrCtxt -> Report -> Ct - -> Maybe SwapFlag -- Nothing <=> not sure -> TcType -> TcType -> TcM ErrMsg -mkEqErr_help dflags ctxt report ct oriented ty1 ty2 +mkEqErr_help dflags ctxt report ct ty1 ty2 | Just (tv1, _) <- tcGetCastedTyVar_maybe ty1 - = mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2 + = mkTyVarEqErr dflags ctxt report ct tv1 ty2 | Just (tv2, _) <- tcGetCastedTyVar_maybe ty2 - = mkTyVarEqErr dflags ctxt report ct swapped tv2 ty1 + = mkTyVarEqErr dflags ctxt report ct tv2 ty1 | otherwise - = reportEqErr ctxt report ct oriented ty1 ty2 - where - swapped = fmap flipSwap oriented + = reportEqErr ctxt report ct ty1 ty2 reportEqErr :: ReportErrCtxt -> Report -> Ct - -> Maybe SwapFlag -- Nothing <=> not sure -> TcType -> TcType -> TcM ErrMsg -reportEqErr ctxt report ct oriented ty1 ty2 +reportEqErr ctxt report ct ty1 ty2 = mkErrorMsgFromCt ctxt ct (mconcat [misMatch, report, eqInfo]) - where misMatch = important $ misMatchOrCND ctxt ct oriented ty1 ty2 - eqInfo = important $ mkEqInfoMsg ct ty1 ty2 + where + misMatch = misMatchOrCND False ctxt ct ty1 ty2 + eqInfo = mkEqInfoMsg ct ty1 ty2 mkTyVarEqErr, mkTyVarEqErr' :: DynFlags -> ReportErrCtxt -> Report -> Ct - -> Maybe SwapFlag -> TcTyVar -> TcType -> TcM ErrMsg + -> TcTyVar -> TcType -> TcM ErrMsg -- tv1 and ty2 are already tidied -mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2 +mkTyVarEqErr dflags ctxt report ct tv1 ty2 = do { traceTc "mkTyVarEqErr" (ppr ct $$ ppr tv1 $$ ppr ty2) - ; mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 } + ; mkTyVarEqErr' dflags ctxt report ct tv1 ty2 } -mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 - | not insoluble_occurs_check -- See Note [Occurs check wins] - , isUserSkolem ctxt tv1 -- ty2 won't be a meta-tyvar, or else the thing would - -- be oriented the other way round; - -- see GHC.Tc.Solver.Canonical.canEqTyVarTyVar +mkTyVarEqErr' dflags ctxt report ct tv1 ty2 + | isUserSkolem ctxt tv1 -- ty2 won't be a meta-tyvar; we would have + -- swapped in Solver.Canonical.canEqTyVarHomo || isTyVarTyVar tv1 && not (isTyVarTy ty2) || ctEqRel ct == ReprEq - -- the cases below don't really apply to ReprEq (except occurs check) + -- The cases below don't really apply to ReprEq (except occurs check) = mkErrorMsgFromCt ctxt ct $ mconcat - [ important $ misMatchOrCND ctxt ct oriented ty1 ty2 - , important $ extraTyVarEqInfo ctxt tv1 ty2 + [ headline_msg + , extraTyVarEqInfo ctxt tv1 ty2 , report ] @@ -1531,11 +1465,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 -- function; it's not insoluble (because in principle F could reduce) -- but we have certainly been unable to solve it -- See Note [Occurs check error] in GHC.Tc.Solver.Canonical - = do { let main_msg = addArising (ctOrigin ct) $ - hang (text "Occurs check: cannot construct the infinite" <+> what <> colon) - 2 (sep [ppr ty1, char '~', ppr ty2]) - - extra2 = important $ mkEqInfoMsg ct ty1 ty2 + = do { let extra2 = mkEqInfoMsg ct ty1 ty2 interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $ filter isTyVar $ @@ -1549,17 +1479,16 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 tyvar_binding tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv) ; mkErrorMsgFromCt ctxt ct $ - mconcat [important main_msg, extra2, extra3, report] } + mconcat [headline_msg, extra2, extra3, report] } | MTVU_Bad <- occ_check_expand = do { let msg = vcat [ text "Cannot instantiate unification variable" <+> quotes (ppr tv1) - , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) - , nest 2 (text "GHC doesn't yet support impredicative polymorphism") ] + , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ] -- Unlike the other reports, this discards the old 'report_important' -- instead of augmenting it. This is because the details are not likely -- to be helpful since this is just an unimplemented feature. - ; mkErrorMsgFromCt ctxt ct $ report { report_important = [msg] } } + ; mkErrorMsgFromCt ctxt ct $ mconcat [ headline_msg, important msg, report ] } -- If the immediately-enclosing implication has 'tv' a skolem, and -- we know by now its an InferSkol kind of skolem, then presumably @@ -1569,8 +1498,8 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 , Implic { ic_skols = skols } <- implic , tv1 `elem` skols = mkErrorMsgFromCt ctxt ct $ mconcat - [ important $ misMatchMsg ct oriented ty1 ty2 - , important $ extraTyVarEqInfo ctxt tv1 ty2 + [ misMatchMsg ctxt ct ty1 ty2 + , extraTyVarEqInfo ctxt tv1 ty2 , report ] @@ -1579,7 +1508,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 , Implic { ic_skols = skols, ic_info = skol_info } <- implic , let esc_skols = filter (`elemVarSet` (tyCoVarsOfType ty2)) skols , not (null esc_skols) - = do { let msg = important $ misMatchMsg ct oriented ty1 ty2 + = do { let msg = misMatchMsg ctxt ct ty1 ty2 esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols <+> pprQuotedList esc_skols , text "would escape" <+> @@ -1607,7 +1536,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 , Implic { ic_given = given, ic_tclvl = lvl, ic_info = skol_info } <- implic = ASSERT2( not (isTouchableMetaTyVar lvl tv1) , ppr tv1 $$ ppr lvl ) -- See Note [Error messages for untouchables] - do { let msg = important $ misMatchMsg ct oriented ty1 ty2 + do { let msg = misMatchMsg ctxt ct ty1 ty2 tclvl_extra = important $ nest 2 $ sep [ quotes (ppr tv1) <+> text "is untouchable" @@ -1615,33 +1544,38 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 , nest 2 $ text "bound by" <+> ppr skol_info , nest 2 $ text "at" <+> ppr (tcl_loc (ic_env implic)) ] - tv_extra = important $ extraTyVarEqInfo ctxt tv1 ty2 - add_sig = important $ suggestAddSig ctxt ty1 ty2 + tv_extra = extraTyVarEqInfo ctxt tv1 ty2 + add_sig = suggestAddSig ctxt ty1 ty2 ; mkErrorMsgFromCt ctxt ct $ mconcat [msg, tclvl_extra, tv_extra, add_sig, report] } | otherwise - = reportEqErr ctxt report ct oriented (mkTyVarTy tv1) ty2 + = reportEqErr ctxt report ct (mkTyVarTy tv1) ty2 -- This *can* happen (#6123, and test T2627b) -- Consider an ambiguous top-level constraint (a ~ F a) -- Not an occurs check, because F is a type function. where + headline_msg = misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2 + ty1 = mkTyVarTy tv1 occ_check_expand = occCheckForErrors dflags tv1 ty2 insoluble_occurs_check = isInsolubleOccursCheck (ctEqRel ct) tv1 ty2 - what = case ctLocTypeOrKind_maybe (ctLoc ct) of - Just KindLevel -> text "kind" - _ -> text "type" + what = text $ levelString $ + ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel -mkEqInfoMsg :: Ct -> TcType -> TcType -> SDoc +levelString :: TypeOrKind -> String +levelString TypeLevel = "type" +levelString KindLevel = "kind" + +mkEqInfoMsg :: Ct -> TcType -> TcType -> Report -- Report (a) ambiguity if either side is a type function application -- e.g. F a0 ~ Int -- (b) warning about injectivity if both sides are the same -- type function application F a ~ F b -- See Note [Non-injective type functions] mkEqInfoMsg ct ty1 ty2 - = tyfun_msg $$ ambig_msg + = important (tyfun_msg $$ ambig_msg) where mb_fun1 = isTyFun_maybe ty1 mb_fun2 = isTyFun_maybe ty2 @@ -1669,29 +1603,34 @@ isUserSkolem ctxt tv is_user_skol_info (InferSkol {}) = False is_user_skol_info _ = True -misMatchOrCND :: ReportErrCtxt -> Ct - -> Maybe SwapFlag -> TcType -> TcType -> SDoc +misMatchOrCND :: Bool -> ReportErrCtxt -> Ct + -> TcType -> TcType -> Report -- If oriented then ty1 is actual, ty2 is expected -misMatchOrCND ctxt ct oriented ty1 ty2 - | null givens || - (isRigidTy ty1 && isRigidTy ty2) || - isGivenCt ct - -- If the equality is unconditionally insoluble - -- or there is no context, don't report the context - = misMatchMsg ct oriented ty1 ty2 +misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2 + | insoluble_occurs_check -- See Note [Insoluble occurs check] + || (isRigidTy ty1 && isRigidTy ty2) + || isGivenCt ct + || null givens + = -- If the equality is unconditionally insoluble + -- or there is no context, don't report the context + misMatchMsg ctxt ct ty1 ty2 + | otherwise - = couldNotDeduce givens ([eq_pred], orig) + = mconcat [ couldNotDeduce givens ([eq_pred], orig) + , important $ mk_supplementary_ea_msg ctxt level ty1 ty2 orig ] where ev = ctEvidence ct eq_pred = ctEvPred ev orig = ctEvOrigin ev + level = ctLocTypeOrKind_maybe (ctEvLoc ev) `orElse` TypeLevel givens = [ given | given <- getUserGivens ctxt, not (ic_no_eqs given)] -- Keep only UserGivens that have some equalities. -- See Note [Suppress redundant givens during error reporting] -couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc +couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> Report couldNotDeduce givens (wanteds, orig) - = vcat [ addArising orig (text "Could not deduce:" <+> pprTheta wanteds) + = important $ + vcat [ addArising orig (text "Could not deduce:" <+> pprTheta wanteds) , vcat (pp_givens givens)] pp_givens :: [UserGiven] -> [SDoc] @@ -1763,11 +1702,11 @@ addition to superclasses (see Note [Remove redundant provided dicts] in GHC.Tc.TyCl.PatSyn). -} -extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc +extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> Report -- Add on extra info about skolem constants -- NB: The types themselves are already tidied extraTyVarEqInfo ctxt tv1 ty2 - = extraTyVarInfo ctxt tv1 $$ ty_extra ty2 + = important (extraTyVarInfo ctxt tv1 $$ ty_extra ty2) where ty_extra ty = case tcGetCastedTyVar_maybe ty of Just (tv, _) -> extraTyVarInfo ctxt tv @@ -1781,15 +1720,15 @@ extraTyVarInfo ctxt tv RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem" MetaTv {} -> empty -suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc +suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Report -- See Note [Suggest adding a type signature] suggestAddSig ctxt ty1 ty2 | null inferred_bndrs - = empty + = mempty | [bndr] <- inferred_bndrs - = text "Possible fix: add a type signature for" <+> quotes (ppr bndr) + = important $ text "Possible fix: add a type signature for" <+> quotes (ppr bndr) | otherwise - = text "Possible fix: add type signatures for some or all of" <+> (ppr inferred_bndrs) + = important $ text "Possible fix: add type signatures for some or all of" <+> (ppr inferred_bndrs) where inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2) get_inf ty | Just tv <- tcGetTyVar_maybe ty @@ -1800,47 +1739,55 @@ suggestAddSig ctxt ty1 ty2 = [] -------------------- -misMatchMsg :: Ct -> Maybe SwapFlag -> TcType -> TcType -> SDoc +misMatchMsg :: ReportErrCtxt -> Ct -> TcType -> TcType -> Report -- Types are already tidy -- If oriented then ty1 is actual, ty2 is expected -misMatchMsg ct oriented ty1 ty2 - | Just NotSwapped <- oriented - = misMatchMsg ct (Just IsSwapped) ty2 ty1 - - -- These next two cases are when we're about to report, e.g., that - -- 'LiftedRep doesn't match 'VoidRep. Much better just to say - -- lifted vs. unlifted - | isLiftedRuntimeRep ty1 - = lifted_vs_unlifted - - | isLiftedRuntimeRep ty2 - = lifted_vs_unlifted - - | otherwise -- So now we have Nothing or (Just IsSwapped) - -- For some reason we treat Nothing like IsSwapped - = addArising orig $ - pprWithExplicitKindsWhenMismatch ty1 ty2 (ctOrigin ct) $ +misMatchMsg ctxt ct ty1 ty2 + = important $ + addArising orig $ + pprWithExplicitKindsWhenMismatch ty1 ty2 orig $ + sep [ case orig of + TypeEqOrigin {} -> tk_eq_msg ctxt ct ty1 ty2 orig + KindEqOrigin {} -> tk_eq_msg ctxt ct ty1 ty2 orig + _ -> headline_eq_msg False ct ty1 ty2 + , sameOccExtra ty2 ty1 ] + where + orig = ctOrigin ct + +headline_eq_msg :: Bool -> Ct -> Type -> Type -> SDoc +-- Generates the main "Could't match 't1' against 't2' +-- headline message +headline_eq_msg add_ea ct ty1 ty2 + + | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) || + (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1) + = text "Couldn't match a lifted type with an unlifted type" + + | isAtomicTy ty1 || isAtomicTy ty2 + = -- Print with quotes sep [ text herald1 <+> quotes (ppr ty1) , nest padding $ - text herald2 <+> quotes (ppr ty2) - , sameOccExtra ty2 ty1 ] + text herald2 <+> quotes (ppr ty2) ] + + | otherwise + = -- Print with vertical layout + vcat [ text herald1 <> colon <+> ppr ty1 + , nest padding $ + text herald2 <> colon <+> ppr ty2 ] where herald1 = conc [ "Couldn't match" - , if is_repr then "representation of" else "" - , if is_oriented then "expected" else "" + , if is_repr then "representation of" else "" + , if add_ea then "expected" else "" , what ] herald2 = conc [ "with" - , if is_repr then "that of" else "" - , if is_oriented then ("actual " ++ what) else "" ] + , if is_repr then "that of" else "" + , if add_ea then ("actual " ++ what) else "" ] + padding = length herald1 - length herald2 is_repr = case ctEqRel ct of { ReprEq -> True; NomEq -> False } - is_oriented = isJust oriented - orig = ctOrigin ct - what = case ctLocTypeOrKind_maybe (ctLoc ct) of - Just KindLevel -> "kind" - _ -> "type" + what = levelString (ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel) conc :: [String] -> String conc = foldr1 add_space @@ -1850,114 +1797,49 @@ misMatchMsg ct oriented ty1 ty2 | null s2 = s1 | otherwise = s1 ++ (' ' : s2) - lifted_vs_unlifted - = addArising orig $ - text "Couldn't match a lifted type with an unlifted type" --- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a --- type mismatch occurs to due invisible kind arguments. --- --- This function first checks to see if the 'CtOrigin' argument is a --- 'TypeEqOrigin', and if so, uses the expected/actual types from that to --- check for a kind mismatch (as these types typically have more surrounding --- types and are likelier to be able to glean information about whether a --- mismatch occurred in an invisible argument position or not). If the --- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types --- themselves. -pprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin - -> SDoc -> SDoc -pprWithExplicitKindsWhenMismatch ty1 ty2 ct - = pprWithExplicitKindsWhen show_kinds - where - (act_ty, exp_ty) = case ct of - TypeEqOrigin { uo_actual = act - , uo_expected = exp } -> (act, exp) - _ -> (ty1, ty2) - show_kinds = tcEqTypeVis act_ty exp_ty - -- True when the visible bit of the types look the same, - -- so we want to show the kinds in the displayed type - -mkExpectedActualMsg :: Type -> Type -> CtOrigin -> Maybe TypeOrKind -> Bool - -> (Bool, Maybe SwapFlag, SDoc) --- NotSwapped means (actual, expected), IsSwapped is the reverse --- First return val is whether or not to print a herald above this msg -mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act +tk_eq_msg :: ReportErrCtxt + -> Ct -> Type -> Type -> CtOrigin -> SDoc +tk_eq_msg ctxt ct ty1 ty2 orig@(TypeEqOrigin { uo_actual = act , uo_expected = exp - , uo_thing = maybe_thing }) - m_level printExpanded - | KindLevel <- level, occurs_check_error = (True, Nothing, empty) - | isUnliftedTypeKind act, isLiftedTypeKind exp = (False, Nothing, msg2) - | isLiftedTypeKind act, isUnliftedTypeKind exp = (False, Nothing, msg3) - | tcIsLiftedTypeKind exp = (False, Nothing, msg4) - | Just msg <- num_args_msg = (False, Nothing, msg $$ msg1) - | KindLevel <- level, Just th <- maybe_thing = (False, Nothing, msg5 th) - | act `pickyEqType` ty1, exp `pickyEqType` ty2 = (True, Just NotSwapped, empty) - | exp `pickyEqType` ty1, act `pickyEqType` ty2 = (True, Just IsSwapped, empty) - | otherwise = (True, Nothing, msg1) - where - level = m_level `orElse` TypeLevel + , uo_thing = mb_thing }) + -- We can use the TypeEqOrigin to + -- improve the error message quite a lot + + | isUnliftedTypeKind act, isLiftedTypeKind exp + = sep [ text "Expecting a lifted type, but" + , thing_msg mb_thing (text "an") (text "unlifted") ] + + | isLiftedTypeKind act, isUnliftedTypeKind exp + = sep [ text "Expecting an unlifted type, but" + , thing_msg mb_thing (text "a") (text "lifted") ] + + | tcIsLiftedTypeKind exp + = maybe_num_args_msg $$ + sep [ text "Expected a type, but" + , case mb_thing of + Nothing -> text "found something with kind" + Just thing -> quotes thing <+> text "has kind" + , quotes (pprWithTYPE act) ] + + | Just nargs_msg <- num_args_msg + = nargs_msg $$ + mk_ea_msg ctxt (Just ct) level orig + + | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $ + ea_looks_same ty1 ty2 exp act + = mk_ea_msg ctxt (Just ct) level orig + + | otherwise -- The mismatched types are /inside/ exp and act + = vcat [ headline_eq_msg False ct ty1 ty2 + , mk_ea_msg ctxt Nothing level orig ] - occurs_check_error - | Just tv <- tcGetTyVar_maybe ty1 - , tv `elemVarSet` tyCoVarsOfType ty2 - = True - | Just tv <- tcGetTyVar_maybe ty2 - , tv `elemVarSet` tyCoVarsOfType ty1 - = True - | otherwise - = False - - sort = case level of - TypeLevel -> text "type" - KindLevel -> text "kind" - - msg1 = case level of - KindLevel - | Just th <- maybe_thing - -> msg5 th - - _ | not (act `pickyEqType` exp) - -> pprWithExplicitKindsWhenMismatch ty1 ty2 ct $ - vcat [ text "Expected" <+> sort <> colon <+> ppr exp - , text " Actual" <+> sort <> colon <+> ppr act - , if printExpanded then expandedTys else empty ] - - | otherwise - -> empty - - thing_msg = case maybe_thing of - Just thing -> \_ levity -> - quotes thing <+> text "is" <+> levity - Nothing -> \vowel levity -> - text "got a" <> - (if vowel then char 'n' else empty) <+> - levity <+> - text "type" - msg2 = sep [ text "Expecting a lifted type, but" - , thing_msg True (text "unlifted") ] - msg3 = sep [ text "Expecting an unlifted type, but" - , thing_msg False (text "lifted") ] - msg4 = maybe_num_args_msg $$ - sep [ text "Expected a type, but" - , maybe (text "found something with kind") - (\thing -> quotes thing <+> text "has kind") - maybe_thing - , quotes (pprWithTYPE act) ] - - msg5 th = pprWithExplicitKindsWhenMismatch ty1 ty2 ct $ - hang (text "Expected" <+> kind_desc <> comma) - 2 (text "but" <+> quotes th <+> text "has kind" <+> - quotes (ppr act)) - where - kind_desc | tcIsConstraintKind exp = text "a constraint" - - -- TYPE t0 - | Just arg <- kindRep_maybe exp - , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case - True -> text "kind" <+> quotes (ppr exp) - False -> text "a type" + where + ct_loc = ctLoc ct + level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel - | otherwise = text "kind" <+> quotes (ppr exp) + thing_msg (Just thing) _ levity = quotes thing <+> text "is" <+> levity + thing_msg Nothing an levity = text "got" <+> an <+> levity <+> text "type" num_args_msg = case level of KindLevel @@ -1970,7 +1852,7 @@ mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act case n_act - n_exp of n | n > 0 -- we don't know how many args there are, so don't -- recommend removing args that aren't - , Just thing <- maybe_thing + , Just thing <- mb_thing -> Just $ text "Expecting" <+> speakN (abs n) <+> more <+> quotes thing where @@ -1981,25 +1863,125 @@ mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act _ -> Nothing - maybe_num_args_msg = case num_args_msg of - Nothing -> empty - Just m -> m + maybe_num_args_msg = num_args_msg `orElse` empty count_args ty = count isVisibleBinder $ fst $ splitPiTys ty - expandedTys = - ppUnless (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) $ vcat - [ text "Type synonyms expanded:" - , text "Expected type:" <+> ppr expTy1 - , text " Actual type:" <+> ppr expTy2 - ] +tk_eq_msg ctxt ct ty1 ty2 + (KindEqOrigin cty1 mb_cty2 sub_o mb_sub_t_or_k) + = vcat [ headline_eq_msg False ct ty1 ty2 + , supplementary_msg ] + where + sub_t_or_k = mb_sub_t_or_k `orElse` TypeLevel + sub_whats = text (levelString sub_t_or_k) <> char 's' + -- "types" or "kinds" + + 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 <+> + 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) + +tk_eq_msg _ _ _ _ _ = panic "typeeq_mismatch_msg" + +ea_looks_same :: Type -> Type -> Type -> Type -> Bool +-- True if the faulting types (ty1, ty2) look the same as +-- the expected/actual types (exp, act). +-- If so, we don't want to redundantly report the latter +ea_looks_same ty1 ty2 exp act + = (act `looks_same` ty1 && exp `looks_same` ty2) || + (exp `looks_same` ty1 && act `looks_same` ty2) + where + looks_same t1 t2 = t1 `pickyEqType` t2 + || t1 `eqType` liftedTypeKind && t2 `eqType` liftedTypeKind + -- pickyEqType is sensitive to synonyms, so only replies True + -- when the types really look the same. However, + -- (TYPE 'LiftedRep) and Type both print the same way. + +mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind + -> Type -> Type -> CtOrigin -> SDoc +mk_supplementary_ea_msg ctxt level ty1 ty2 orig + | TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig + , not (ea_looks_same ty1 ty2 exp act) + = mk_ea_msg ctxt Nothing level orig + | otherwise + = empty + +mk_ea_msg :: ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc +-- Constructs a "Couldn't match" message +-- The (Maybe Ct) says whether this is the main top-level message (Just) +-- or a supplementary message (Nothing) +mk_ea_msg ctxt at_top level + (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing }) + | Just thing <- mb_thing + , KindLevel <- level + = hang (text "Expected" <+> kind_desc <> comma) + 2 (text "but" <+> quotes thing <+> text "has kind" <+> + quotes (ppr act)) + + | otherwise + = vcat [ case at_top of + Just ct -> headline_eq_msg True ct exp act + Nothing -> supplementary_ea_msg + , ppWhen expand_syns expandedTys ] + + where + supplementary_ea_msg = vcat [ text "Expected:" <+> ppr exp + , text " Actual:" <+> ppr act ] + + kind_desc | tcIsConstraintKind exp = text "a constraint" + | Just arg <- kindRep_maybe exp -- TYPE t0 + , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case + True -> text "kind" <+> quotes (ppr exp) + False -> text "a type" + | otherwise = text "kind" <+> quotes (ppr exp) + + expand_syns = cec_expand_syns ctxt + + expandedTys = ppUnless (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) $ vcat + [ text "Type synonyms expanded:" + , text "Expected type:" <+> ppr expTy1 + , text " Actual type:" <+> ppr expTy2 ] (expTy1, expTy2) = expandSynonymsToMatch exp act -mkExpectedActualMsg _ _ _ _ _ = panic "mkExpectedAcutalMsg" +mk_ea_msg _ _ _ _ = empty + +-- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a +-- type mismatch occurs to due invisible kind arguments. +-- +-- This function first checks to see if the 'CtOrigin' argument is a +-- 'TypeEqOrigin', and if so, uses the expected/actual types from that to +-- check for a kind mismatch (as these types typically have more surrounding +-- types and are likelier to be able to glean information about whether a +-- mismatch occurred in an invisible argument position or not). If the +-- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types +-- themselves. +pprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin + -> SDoc -> SDoc +pprWithExplicitKindsWhenMismatch ty1 ty2 ct + = pprWithExplicitKindsWhen show_kinds + where + (act_ty, exp_ty) = case ct of + TypeEqOrigin { uo_actual = act + , uo_expected = exp } -> (act, exp) + _ -> (ty1, ty2) + show_kinds = tcEqTypeVis act_ty exp_ty + -- True when the visible bit of the types look the same, + -- so we want to show the kinds in the displayed type + + -{- Note [Insoluble occurs check wins] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Insoluble occurs check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider [G] a ~ [a], [W] a ~ [a] (#13674). The Given is insoluble so we don't use it for rewriting. The Wanted is also insoluble, and we don't solve it from the Given. It's very confusing to say @@ -2009,7 +1991,8 @@ And indeed even thinking about the Givens is silly; [W] a ~ [a] is just as insoluble as Int ~ Bool. Conclusion: if there's an insoluble occurs check (isInsolubleOccursCheck) -then report it first. +then report it directly, not in the "cannot deduce X from Y" form. +This is done in misMatchOrCND (via the insoluble_occurs_check arg) (NB: there are potentially-soluble ones, like (a ~ F a b), and we don't want to be as draconian with them.) diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs index 0639e79073..7c0eaa7912 100644 --- a/compiler/GHC/Tc/Errors/Hole.hs +++ b/compiler/GHC/Tc/Errors/Hole.hs @@ -43,7 +43,7 @@ import Data.Graph ( graphFromEdges, topSort ) import GHC.Tc.Solver ( simpl_top, runTcSDeriveds ) -import GHC.Tc.Utils.Unify ( tcSubType_NC ) +import GHC.Tc.Utils.Unify ( tcSubTypeSigma ) import GHC.HsToCore.Docs ( extractDocs ) import qualified Data.Map as Map @@ -933,7 +933,7 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ -- imp is the innermost implication (imp:_) -> return (ic_tclvl imp) ; (wrap, wanted) <- setTcLevel innermost_lvl $ captureConstraints $ - tcSubType_NC ExprSigCtxt ty hole_ty + tcSubTypeSigma ExprSigCtxt ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted ; if isEmptyWC wanted && isEmptyBag th_relevant_cts diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs index ef60b3cea7..c21a885970 100644 --- a/compiler/GHC/Tc/Gen/Arrow.hs +++ b/compiler/GHC/Tc/Gen/Arrow.hs @@ -14,7 +14,8 @@ module GHC.Tc.Gen.Arrow ( tcProc ) where import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcLExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcCheckExpr ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckMonoExpr, tcInferRho, tcSyntaxOp + , tcCheckId, tcCheckPolyExpr ) import GHC.Hs import GHC.Tc.Gen.Match @@ -161,7 +162,7 @@ tc_cmd env in_cmd@(HsCmdLamCase x matches) (stk, res_ty) return (mkHsCmdWrap (mkWpCastN co) (HsCmdLamCase x matches')) tc_cmd env (HsCmdIf x NoSyntaxExprRn pred b1 b2) res_ty -- Ordinary 'if' - = do { pred' <- tcLExpr pred (mkCheckExpType boolTy) + = do { pred' <- tcCheckMonoExpr pred boolTy ; b1' <- tcCmd env b1 res_ty ; b2' <- tcCmd env b2 res_ty ; return (HsCmdIf x NoSyntaxExprTc pred' b1' b2') @@ -179,7 +180,7 @@ tc_cmd env (HsCmdIf x fun@(SyntaxExprRn {}) pred b1 b2) res_ty -- Rebindable syn ; (pred', fun') <- tcSyntaxOp IfOrigin fun (map synKnownType [pred_ty, r_ty, r_ty]) (mkCheckExpType r_ty) $ \ _ -> - tcLExpr pred (mkCheckExpType pred_ty) + tcCheckMonoExpr pred pred_ty ; b1' <- tcCmd env b1 res_ty ; b2' <- tcCmd env b2 res_ty @@ -206,9 +207,9 @@ tc_cmd env cmd@(HsCmdArrApp _ fun arg ho_app lr) (_, res_ty) = addErrCtxt (cmdCtxt cmd) $ do { arg_ty <- newOpenFlexiTyVarTy ; let fun_ty = mkCmdArrTy env arg_ty res_ty - ; fun' <- select_arrow_scope (tcLExpr fun (mkCheckExpType fun_ty)) + ; fun' <- select_arrow_scope (tcCheckMonoExpr fun fun_ty) - ; arg' <- tcLExpr arg (mkCheckExpType arg_ty) + ; arg' <- tcCheckMonoExpr arg arg_ty ; return (HsCmdArrApp fun_ty fun' arg' ho_app lr) } where @@ -233,7 +234,7 @@ tc_cmd env cmd@(HsCmdApp x fun arg) (cmd_stk, res_ty) = addErrCtxt (cmdCtxt cmd) $ do { arg_ty <- newOpenFlexiTyVarTy ; fun' <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty) - ; arg' <- tcLExpr arg (mkCheckExpType arg_ty) + ; arg' <- tcCheckMonoExpr arg arg_ty ; return (HsCmdApp x fun' arg') } ------------------------------------------- @@ -310,7 +311,7 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty) ; let e_ty = mkInfForAllTy alphaTyVar $ mkVisFunTys cmd_tys $ mkCmdArrTy env (mkPairTy alphaTy cmd_stk) res_ty - ; expr' <- tcCheckExpr expr e_ty + ; expr' <- tcCheckPolyExpr expr e_ty ; return (HsCmdArrForm x expr' f fixity cmd_args') } where diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs index 1870531f60..bd9d14e2d4 100644 --- a/compiler/GHC/Tc/Gen/Bind.hs +++ b/compiler/GHC/Tc/Gen/Bind.hs @@ -23,8 +23,9 @@ where import GHC.Prelude import {-# SOURCE #-} GHC.Tc.Gen.Match ( tcGRHSsPat, tcMatchesFun ) -import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcLExpr ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckMonoExpr ) import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind ) + import GHC.Core (Tickish (..)) import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC)) import GHC.Driver.Session @@ -354,7 +355,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside = do { ty <- newOpenFlexiTyVarTy ; let p = mkStrLitTy $ hsIPNameFS ip ; ip_id <- newDict ipClass [ p, ty ] - ; expr' <- tcLExpr expr (mkCheckExpType ty) + ; expr' <- tcCheckMonoExpr expr ty ; let d = toDict ipClass p ty `fmap` expr' ; return (ip_id, (IPBind noExtField (Right ip_id) d)) } tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind" @@ -389,22 +390,25 @@ tcValBinds top_lvl binds sigs thing_inside -- It's easier to do so now, once for all the SCCs together -- because a single signature f,g :: <type> -- might relate to more than one SCC - ; (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $ + (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $ tcTySigs sigs - -- Extend the envt right away with all the Ids - -- declared with complete type signatures - -- Do not extend the TcBinderStack; instead - -- we extend it on a per-rhs basis in tcExtendForRhs - ; tcExtendSigIds top_lvl poly_ids $ do - { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do - { thing <- thing_inside - -- See Note [Pattern synonym builders don't yield dependencies] - -- in GHC.Rename.Bind - ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns - ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ] - ; return (extra_binds, thing) } - ; return (binds' ++ extra_binds', thing) }} + -- Extend the envt right away with all the Ids + -- declared with complete type signatures + -- Do not extend the TcBinderStack; instead + -- we extend it on a per-rhs basis in tcExtendForRhs + -- See Note [Relevant bindings and the binder stack] + ; tcExtendSigIds top_lvl poly_ids $ + do { (binds', (extra_binds', thing)) + <- tcBindGroups top_lvl sig_fn prag_fn binds $ + do { thing <- thing_inside + -- See Note [Pattern synonym builders don't yield dependencies] + -- in GHC.Rename.Bind + ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns + ; let extra_binds = [ (NonRecursive, builder) + | builder <- patsyn_builders ] + ; return (extra_binds, thing) } + ; return (binds' ++ extra_binds', thing) }} where patsyns = getPatSynBinds binds prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds) @@ -686,50 +690,60 @@ tcPolyCheck prag_fn (CompleteSig { sig_bndr = poly_id , sig_ctxt = ctxt , sig_loc = sig_loc }) - (L loc (FunBind { fun_id = (L nm_loc name) - , fun_matches = matches })) - = setSrcSpan sig_loc $ - do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc) - ; (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id - -- See Note [Instantiate sig with fresh variables] + (L bind_loc (FunBind { fun_id = L nm_loc name + , fun_matches = matches })) + = do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc) ; mono_name <- newNameAt (nameOccName name) nm_loc - ; ev_vars <- newEvVars theta - ; let mono_id = mkLocalId mono_name tau - skol_info = SigSkol ctxt (idType poly_id) tv_prs - skol_tvs = map snd tv_prs - - ; (ev_binds, (co_fn, matches')) - <- checkConstraints skol_info skol_tvs ev_vars $ - tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $ - tcExtendNameTyVarEnv tv_prs $ - setSrcSpan loc $ - tcMatchesFun (L nm_loc mono_name) matches (mkCheckExpType tau) + ; (wrap_gen, (wrap_res, matches')) + <- setSrcSpan sig_loc $ -- Sets the binding location for the skolems + tcSkolemiseScoped ctxt (idType poly_id) $ \rho_ty -> + -- Unwraps multiple layers; e.g + -- f :: forall a. Eq a => forall b. Ord b => blah + -- NB: tcSkolemise makes fresh type variables + -- See Note [Instantiate sig with fresh variables] + + let mono_id = mkLocalId mono_name rho_ty in + tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $ + -- Why mono_id in the BinderStack? + -- See Note [Relevant bindings and the binder stack] + + setSrcSpan bind_loc $ + tcMatchesFun (L nm_loc mono_name) matches + (mkCheckExpType rho_ty) + + -- We make a funny AbsBinds, abstracting over nothing, + -- just so we haev somewhere to put the SpecPrags. + -- Otherwise we could just use the FunBind + -- Hence poly_id2 is just a clone of poly_id; + -- We re-use mono-name, but we could equally well use a fresh one ; let prag_sigs = lookupPragEnv prag_fn name - ; spec_prags <- tcSpecPrags poly_id prag_sigs + poly_id2 = mkLocalId mono_name (idType poly_id) + ; spec_prags <- tcSpecPrags poly_id prag_sigs ; poly_id <- addInlinePrags poly_id prag_sigs ; mod <- getModule - ; tick <- funBindTicks nm_loc mono_id mod prag_sigs - ; let bind' = FunBind { fun_id = L nm_loc mono_id + ; tick <- funBindTicks nm_loc poly_id mod prag_sigs + + ; let bind' = FunBind { fun_id = L nm_loc poly_id2 , fun_matches = matches' - , fun_ext = co_fn + , fun_ext = wrap_gen <.> wrap_res , fun_tick = tick } export = ABE { abe_ext = noExtField , abe_wrap = idHsWrapper , abe_poly = poly_id - , abe_mono = mono_id + , abe_mono = poly_id2 , abe_prags = SpecPrags spec_prags } - abs_bind = L loc $ + abs_bind = L bind_loc $ AbsBinds { abs_ext = noExtField - , abs_tvs = skol_tvs - , abs_ev_vars = ev_vars - , abs_ev_binds = [ev_binds] + , abs_tvs = [] + , abs_ev_vars = [] + , abs_ev_binds = [] , abs_exports = [export] - , abs_binds = unitBag (L loc bind') + , abs_binds = unitBag (L bind_loc bind') , abs_sig = True } ; return (unitBag abs_bind, [poly_id]) } @@ -862,7 +876,7 @@ mkExport prag_fn insoluble qtvs theta -- an ambiguous type and have AllowAmbiguousType -- e..g infer x :: forall a. F a -> Int else addErrCtxtM (mk_impedance_match_msg mono_info sel_poly_ty poly_ty) $ - tcSubType_NC sig_ctxt sel_poly_ty poly_ty + tcSubTypeSigma sig_ctxt sel_poly_ty poly_ty ; warn_missing_sigs <- woptM Opt_WarnMissingLocalSignatures ; when warn_missing_sigs $ @@ -943,8 +957,12 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs , sig_inst_theta = annotated_theta , sig_inst_skols = annotated_tvs })) = -- Choose quantifiers for a partial type signature - do { psig_qtvbndr_prs <- zonkTyVarTyVarPairs annotated_tvs - ; let psig_qtv_prs = mapSnd binderVar psig_qtvbndr_prs + do { let (psig_qtv_nms, psig_qtv_bndrs) = unzip annotated_tvs + ; psig_qtv_bndrs <- mapM zonkInvisTVBinder psig_qtv_bndrs + ; let psig_qtvs = map binderVar psig_qtv_bndrs + psig_qtv_set = mkVarSet psig_qtvs + psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs + -- Check whether the quantified variables of the -- partial signature have been unified together @@ -958,17 +976,14 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs ; mapM_ report_mono_sig_tv_err [ n | (n,tv) <- psig_qtv_prs , not (tv `elem` qtvs) ] - ; let psig_qtvbndrs = map snd psig_qtvbndr_prs - psig_qtvs = mkVarSet (map snd psig_qtv_prs) - ; annotated_theta <- zonkTcTypes annotated_theta - ; (free_tvs, my_theta) <- choose_psig_context psig_qtvs annotated_theta wcx + ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx - ; let keep_me = free_tvs `unionVarSet` psig_qtvs + ; let keep_me = free_tvs `unionVarSet` psig_qtv_set final_qtvs = [ mkTyVarBinder vis tv | tv <- qtvs -- Pulling from qtvs maintains original order , tv `elemVarSet` keep_me - , let vis = case lookupVarBndr tv psig_qtvbndrs of + , let vis = case lookupVarBndr tv psig_qtv_bndrs of Just spec -> spec Nothing -> InferredSpec ] @@ -1454,17 +1469,7 @@ tcExtendTyVarEnvFromSig sig_inst thing_inside thing_inside tcExtendIdBinderStackForRhs :: [MonoBindInfo] -> TcM a -> TcM a --- Extend the TcBinderStack for the RHS of the binding, with --- the monomorphic Id. That way, if we have, say --- f = \x -> blah --- and something goes wrong in 'blah', we get a "relevant binding" --- looking like f :: alpha -> beta --- This applies if 'f' has a type signature too: --- f :: forall a. [a] -> [a] --- f x = True --- We can't unify True with [a], and a relevant binding is f :: [a] -> [a] --- If we had the *polymorphic* version of f in the TcBinderStack, it --- would not be reported as relevant, because its type is closed +-- See Note [Relevant bindings and the binder stack] tcExtendIdBinderStackForRhs infos thing_inside = tcExtendBinderStack [ TcIdBndr mono_id NotTopLevel | MBI { mbi_mono_id = mono_id } <- infos ] @@ -1480,7 +1485,22 @@ getMonoBindInfo tc_binds get_info (TcPatBind infos _ _ _) rest = infos ++ rest -{- Note [Typechecking pattern bindings] +{- Note [Relevant bindings and the binder stack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When typecking a binding we extend the TcBinderStack for the RHS of +the binding, with the /monomorphic/ Id. That way, if we have, say + f = \x -> blah +and something goes wrong in 'blah', we get a "relevant binding" +looking like f :: alpha -> beta +This applies if 'f' has a type signature too: + f :: forall a. [a] -> [a] + f x = True +We can't unify True with [a], and a relevant binding is f :: [a] -> [a] +If we had the *polymorphic* version of f in the TcBinderStack, it +would not be reported as relevant, because its type is closed. +(See TcErrors.relevantBindings.) + +Note [Typechecking pattern bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Look at: - typecheck/should_compile/ExPat diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs index ab5e021653..9f31d7938a 100644 --- a/compiler/GHC/Tc/Gen/Default.hs +++ b/compiler/GHC/Tc/Gen/Default.hs @@ -70,8 +70,8 @@ tcDefaults decls@(L locn (DefaultDecl _ _) : _) tc_default_ty :: [Class] -> LHsType GhcRn -> TcM Type tc_default_ty deflt_clss hs_ty - = do { (ty, _kind) <- solveEqualities $ - tcLHsType hs_ty + = do { ty <- solveEqualities $ + tcInferLHsType hs_ty ; ty <- zonkTcTypeToType ty -- establish Type invariants ; checkValidType DefaultDeclCtxt ty diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 2d6b25df10..b4c3b6275c 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -13,20 +13,15 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} --- | Typecheck an expression module GHC.Tc.Gen.Expr - ( tcCheckExpr - , tcLExpr, tcLExprNC, tcExpr - , tcInferSigma - , tcInferRho, tcInferRhoNC - , tcSyntaxOp, tcSyntaxOpGen - , SyntaxOpType(..) - , synKnownType - , tcCheckId - , addAmbiguousNameErr - , getFixedTyVars - ) -where + ( tcCheckPolyExpr, + tcCheckMonoExpr, tcCheckMonoExprNC, tcMonoExpr, tcMonoExprNC, + tcInferSigma, tcInferRho, tcInferRhoNC, + tcExpr, + tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType, + tcCheckId, + addAmbiguousNameErr, + getFixedTyVars ) where #include "HsVersions.h" @@ -101,25 +96,35 @@ import qualified Data.Set as Set ************************************************************************ -} -tcCheckExpr, tcCheckExprNC + +tcCheckPolyExpr, tcCheckPolyExprNC :: LHsExpr GhcRn -- Expression to type check -> TcSigmaType -- Expected type (could be a polytype) -> TcM (LHsExpr GhcTc) -- Generalised expr with expected type --- tcCheckExpr is a convenient place (frequent but not too frequent) +-- tcCheckPolyExpr is a convenient place (frequent but not too frequent) -- place to add context information. -- The NC version does not do so, usually because the caller wants -- to do so himself. -tcCheckExpr expr res_ty +tcCheckPolyExpr expr res_ty = tcPolyExpr expr (mkCheckExpType res_ty) +tcCheckPolyExprNC expr res_ty = tcPolyExprNC expr (mkCheckExpType res_ty) + +-- These versions take an ExpType +tcPolyExpr, tcPolyExprNC + :: LHsExpr GhcRn -> ExpSigmaType + -> TcM (LHsExpr GhcTcId) + +tcPolyExpr expr res_ty = addExprCtxt expr $ - tcCheckExprNC expr res_ty + do { traceTc "tcPolyExpr" (ppr res_ty) + ; tcPolyExprNC expr res_ty } -tcCheckExprNC (L loc expr) res_ty +tcPolyExprNC (L loc expr) res_ty = setSrcSpan loc $ - do { traceTc "tcCheckExprNC" (ppr res_ty) - ; (wrap, expr') <- tcSkolemise GenSigCtxt res_ty $ \ _ res_ty -> - tcExpr expr (mkCheckExpType res_ty) + do { traceTc "tcPolyExprNC" (ppr res_ty) + ; (wrap, expr') <- tcSkolemiseET GenSigCtxt res_ty $ \ res_ty -> + tcExpr expr res_ty ; return $ L loc (mkHsWrap wrap expr') } --------------- @@ -134,6 +139,30 @@ tcInferSigma le@(L loc expr) ; return (L loc (applyHsArgs fun args), ty) } --------------- +tcCheckMonoExpr, tcCheckMonoExprNC + :: LHsExpr GhcRn -- Expression to type check + -> TcRhoType -- Expected type + -- Definitely no foralls at the top + -> TcM (LHsExpr GhcTcId) +tcCheckMonoExpr expr res_ty = tcMonoExpr expr (mkCheckExpType res_ty) +tcCheckMonoExprNC expr res_ty = tcMonoExprNC expr (mkCheckExpType res_ty) + +tcMonoExpr, tcMonoExprNC + :: LHsExpr GhcRn -- Expression to type check + -> ExpRhoType -- Expected type + -- Definitely no foralls at the top + -> TcM (LHsExpr GhcTcId) + +tcMonoExpr expr res_ty + = addExprCtxt expr $ + tcMonoExprNC expr res_ty + +tcMonoExprNC (L loc expr) res_ty + = setSrcSpan loc $ + do { expr' <- tcExpr expr res_ty + ; return (L loc expr') } + +--------------- tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) -- Infer a *rho*-type. The return type is always instantiated. tcInferRho le = addExprCtxt le (tcInferRhoNC le) @@ -144,15 +173,11 @@ tcInferRhoNC (L loc expr) ; return (L loc expr', rho) } -{- -************************************************************************ +{- ********************************************************************* * * tcExpr: the main expression typechecker * * -************************************************************************ - -NB: The res_ty is always deeply skolemised. --} +********************************************************************* -} tcLExpr, tcLExprNC :: LHsExpr GhcRn -- Expression to type check @@ -241,7 +266,7 @@ tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty (mkEmptyWildCardBndrs (L loc (HsTyLit noExtField (HsStrTy NoSourceText l)))) tcExpr (HsLam x match) res_ty - = do { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty + = do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty ; return (mkHsWrap wrap (HsLam x match')) } where match_ctxt = MC { mc_what = LambdaExpr, mc_body = tcBody } @@ -252,7 +277,7 @@ tcExpr (HsLam x match) res_ty text "has"] tcExpr e@(HsLamCase x matches) res_ty - = do { (matches', wrap) + = do { (wrap, matches') <- tcMatchLambda msg match_ctxt matches res_ty -- The laziness annotation is because we don't want to fail here -- if there are multiple arguments @@ -335,7 +360,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty ; let doc = text "The first argument of ($) takes" orig1 = lexprCtOrigin arg1 ; (wrap_arg1, [arg2_sigma], op_res_ty) <- - matchActualFunTys doc orig1 (Just (unLoc arg1)) 1 arg1_ty + matchActualFunTysRho doc orig1 (Just (unLoc arg1)) 1 arg1_ty -- We have (arg1 $ arg2) -- So: arg1_ty = arg2_ty -> op_res_ty @@ -351,7 +376,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty (tcTypeKind arg2_sigma) liftedTypeKind -- Ignore the evidence. arg2_sigma must have type * or #, -- because we know (arg2_sigma -> op_res_ty) is well-kinded - -- (because otherwise matchActualFunTys would fail) + -- (because otherwise matchActualFunTysRho would fail) -- So this 'unifyKind' will either succeed with Refl, or will -- produce an insoluble constraint * ~ #, which we'll report later. @@ -385,7 +410,8 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty ; (op', op_ty) <- tcInferRhoNC op ; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty) - <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty + <- matchActualFunTysRho (mk_op_msg op) fn_orig + (Just (unLoc op)) 2 op_ty -- You might think we should use tcInferApp here, but there is -- too much impedance-matching, because tcApp may return wrappers as -- well as type-checked arguments. @@ -405,12 +431,13 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty tcExpr expr@(SectionR x op arg2) res_ty = do { (op', op_ty) <- tcInferRhoNC op ; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty) - <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty - ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr) - (mkVisFunTy arg1_ty op_res_ty) res_ty + <- matchActualFunTysRho (mk_op_msg op) fn_orig + (Just (unLoc op)) 2 op_ty ; arg2' <- tcArg (unLoc op) arg2 arg2_ty 2 - ; return ( mkHsWrap wrap_res $ - SectionR x (mkLHsWrap wrap_fun op') arg2' ) } + ; let expr' = SectionR x (mkLHsWrap wrap_fun op') arg2' + act_res_ty = mkVisFunTy arg1_ty op_res_ty + ; tcWrapResultMono expr expr' act_res_ty res_ty } + where fn_orig = lexprCtOrigin op -- It's important to use the origin of 'op', so that call-stacks @@ -424,13 +451,12 @@ tcExpr expr@(SectionL x arg1 op) res_ty | otherwise = 2 ; (wrap_fn, (arg1_ty:arg_tys), op_res_ty) - <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) - n_reqd_args op_ty - ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr) - (mkVisFunTys arg_tys op_res_ty) res_ty + <- matchActualFunTysRho (mk_op_msg op) fn_orig + (Just (unLoc op)) n_reqd_args op_ty ; arg1' <- tcArg (unLoc op) arg1 arg1_ty 1 - ; return ( mkHsWrap wrap_res $ - SectionL x arg1' (mkLHsWrap wrap_fn op') ) } + ; let expr' = SectionL x arg1' (mkLHsWrap wrap_fn op') + act_res_ty = mkVisFunTys arg_tys op_res_ty + ; tcWrapResultMono expr expr' act_res_ty res_ty } where fn_orig = lexprCtOrigin op -- It's important to use the origin of 'op', so that call-stacks @@ -460,19 +486,19 @@ tcExpr expr@(ExplicitTuple x tup_args boxity) res_ty ; arg_tys <- case boxity of { Boxed -> newFlexiTyVarTys arity liftedTypeKind ; Unboxed -> replicateM arity newOpenFlexiTyVarTy } - ; let actual_res_ty - = mkVisFunTys [ty | (ty, (L _ (Missing _))) <- arg_tys `zip` tup_args] - (mkTupleTy1 boxity arg_tys) - -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make - - ; wrap <- tcSubTypeHR (Shouldn'tHappenOrigin "ExpTuple") - (Just expr) - actual_res_ty res_ty -- Handle tuple sections where ; tup_args1 <- tcTupArgs tup_args arg_tys - ; return $ mkHsWrap wrap (ExplicitTuple x tup_args1 boxity) } + ; let expr' = ExplicitTuple x tup_args1 boxity + act_res_ty = mkVisFunTys [ty | (ty, (L _ (Missing _))) + <- arg_tys `zip` tup_args] + (mkTupleTy1 boxity arg_tys) + -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make + + ; traceTc "ExplicitTuple" (ppr act_res_ty $$ ppr res_ty) + + ; tcWrapResultMono expr expr' act_res_ty res_ty } tcExpr (ExplicitSum _ alt arity expr) res_ty = do { let sum_tc = sumTyCon arity @@ -480,7 +506,7 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty ; (coi, arg_tys) <- matchExpectedTyConApp sum_tc res_ty ; -- Drop levity vars, we don't care about them here let arg_tys' = drop arity arg_tys - ; expr' <- tcCheckExpr expr (arg_tys' `getNth` (alt - 1)) + ; expr' <- tcCheckPolyExpr expr (arg_tys' `getNth` (alt - 1)) ; return $ mkHsWrapCo coi (ExplicitSum arg_tys' alt arity expr' ) } -- This will see the empty list only when -XOverloadedLists. @@ -502,7 +528,7 @@ tcExpr (ExplicitList _ witness exprs) res_ty ; return (exprs', elt_ty) } ; return $ ExplicitList elt_ty (Just fln') exprs' } - where tc_elt elt_ty expr = tcCheckExpr expr elt_ty + where tc_elt elt_ty expr = tcCheckPolyExpr expr elt_ty {- ************************************************************************ @@ -527,6 +553,13 @@ tcExpr (HsCase x scrut matches) res_ty -- -- But now, in the GADT world, we need to typecheck the scrutinee -- first, to get type info that may be refined in the case alternatives + + -- Typecheck the scrutinee. We use tcInferRho but tcInferSigma + -- would also be possible (tcMatchesCase accepts sigma-types) + -- Interesting litmus test: do these two behave the same? + -- case id of {..} + -- case (\v -> v) of {..} + -- This design choice is discussed in #17790 (scrut', scrut_ty) <- tcInferRho scrut ; traceTc "HsCase" (ppr scrut_ty) @@ -550,9 +583,9 @@ tcExpr (HsIf x fun@(SyntaxExprRn {}) pred b1 b2) res_ty = do { ((pred', b1', b2'), fun') <- tcSyntaxOp IfOrigin fun [SynAny, SynAny, SynAny] res_ty $ \ [pred_ty, b1_ty, b2_ty] -> - do { pred' <- tcCheckExpr pred pred_ty - ; b1' <- tcCheckExpr b1 b1_ty - ; b2' <- tcCheckExpr b2 b2_ty + do { pred' <- tcCheckPolyExpr pred pred_ty + ; b1' <- tcCheckPolyExpr b1 b1_ty + ; b2' <- tcCheckPolyExpr b2 b2_ty ; return (pred', b1', b2') } ; return (HsIf x fun' pred' b1' b2') } @@ -591,7 +624,7 @@ tcExpr (HsStatic fvs expr) res_ty addErrCtxt (hang (text "In the body of a static form:") 2 (ppr expr) ) $ - tcCheckExprNC expr expr_ty + tcCheckPolyExprNC expr expr_ty -- Check that the free variables of the static form are closed. -- It's OK to use nonDetEltsUniqSet here as the only side effects of @@ -637,25 +670,26 @@ tcExpr expr@(RecordCon { rcon_con_name = L loc con_name ; checkMissingFields con_like rbinds ; (con_expr, con_sigma) <- tcInferId con_name - ; (con_wrap, con_tau) <- - topInstantiate (OccurrenceOf con_name) con_sigma + ; (con_wrap, con_tau) <- topInstantiate orig con_sigma -- a shallow instantiation should really be enough for -- a data constructor. ; let arity = conLikeArity con_like Right (arg_tys, actual_res_ty) = tcSplitFunTysN arity con_tau - ; case conLikeWrapId_maybe con_like of - Nothing -> nonBidirectionalErr (conLikeName con_like) - Just con_id -> do { - res_wrap <- tcSubTypeHR (Shouldn'tHappenOrigin "RecordCon") - (Just expr) actual_res_ty res_ty - ; rbinds' <- tcRecordBinds con_like arg_tys rbinds - ; return $ - mkHsWrap res_wrap $ - RecordCon { rcon_ext = RecordConTc - { rcon_con_like = con_like - , rcon_con_expr = mkHsWrap con_wrap con_expr } - , rcon_con_name = L loc con_id - , rcon_flds = rbinds' } } } + ; case conLikeWrapId_maybe con_like of { + Nothing -> nonBidirectionalErr (conLikeName con_like) ; + Just con_id -> + + do { rbinds' <- tcRecordBinds con_like arg_tys rbinds + ; let rcon_tc = RecordConTc + { rcon_con_like = con_like + , rcon_con_expr = mkHsWrap con_wrap con_expr } + expr' = RecordCon { rcon_ext = rcon_tc + , rcon_con_name = L loc con_id + , rcon_flds = rbinds' } + + ; tcWrapResultMono expr expr' actual_res_ty res_ty } } } + where + orig = OccurrenceOf con_name {- Note [Type of a record update] @@ -906,8 +940,6 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty scrut_ty = TcType.substTy scrut_subst con1_res_ty con1_arg_tys' = map (TcType.substTy result_subst) con1_arg_tys - ; wrap_res <- tcSubTypeHR (exprCtOrigin expr) - (Just expr) rec_res_ty res_ty ; co_scrut <- unifyType (Just (unLoc record_expr)) record_rho scrut_ty -- NB: normal unification is OK here (as opposed to subsumption), -- because for this to work out, both record_rho and scrut_ty have @@ -937,16 +969,16 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty ; req_wrap <- instCallConstraints RecordUpdOrigin req_theta' -- Phew! - ; return $ - mkHsWrap wrap_res $ - RecordUpd { rupd_expr - = mkLHsWrap fam_co (mkLHsWrapCo co_scrut record_expr') - , rupd_flds = rbinds' - , rupd_ext = RecordUpdTc - { rupd_cons = relevant_cons - , rupd_in_tys = scrut_inst_tys - , rupd_out_tys = result_inst_tys - , rupd_wrap = req_wrap }} } + ; let upd_tc = RecordUpdTc { rupd_cons = relevant_cons + , rupd_in_tys = scrut_inst_tys + , rupd_out_tys = result_inst_tys + , rupd_wrap = req_wrap } + expr' = RecordUpd { rupd_expr = mkLHsWrap fam_co $ + mkLHsWrapCo co_scrut record_expr' + , rupd_flds = rbinds' + , rupd_ext = upd_tc } + + ; tcWrapResult expr expr' rec_res_ty res_ty } tcExpr e@(HsRecFld _ f) res_ty = tcCheckRecSelId e f res_ty @@ -1038,7 +1070,7 @@ tcArithSeq :: Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> ExpRhoType tcArithSeq witness seq@(From expr) res_ty = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty - ; expr' <- tcCheckExpr expr elt_ty + ; expr' <- tcCheckPolyExpr expr elt_ty ; enum_from <- newMethodFromName (ArithSeqOrigin seq) enumFromName [elt_ty] ; return $ mkHsWrap wrap $ @@ -1046,8 +1078,8 @@ tcArithSeq witness seq@(From expr) res_ty tcArithSeq witness seq@(FromThen expr1 expr2) res_ty = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty - ; expr1' <- tcCheckExpr expr1 elt_ty - ; expr2' <- tcCheckExpr expr2 elt_ty + ; expr1' <- tcCheckPolyExpr expr1 elt_ty + ; expr2' <- tcCheckPolyExpr expr2 elt_ty ; enum_from_then <- newMethodFromName (ArithSeqOrigin seq) enumFromThenName [elt_ty] ; return $ mkHsWrap wrap $ @@ -1055,8 +1087,8 @@ tcArithSeq witness seq@(FromThen expr1 expr2) res_ty tcArithSeq witness seq@(FromTo expr1 expr2) res_ty = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty - ; expr1' <- tcCheckExpr expr1 elt_ty - ; expr2' <- tcCheckExpr expr2 elt_ty + ; expr1' <- tcCheckPolyExpr expr1 elt_ty + ; expr2' <- tcCheckPolyExpr expr2 elt_ty ; enum_from_to <- newMethodFromName (ArithSeqOrigin seq) enumFromToName [elt_ty] ; return $ mkHsWrap wrap $ @@ -1064,9 +1096,9 @@ tcArithSeq witness seq@(FromTo expr1 expr2) res_ty tcArithSeq witness seq@(FromThenTo expr1 expr2 expr3) res_ty = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty - ; expr1' <- tcCheckExpr expr1 elt_ty - ; expr2' <- tcCheckExpr expr2 elt_ty - ; expr3' <- tcCheckExpr expr3 elt_ty + ; expr1' <- tcCheckPolyExpr expr1 elt_ty + ; expr2' <- tcCheckPolyExpr expr2 elt_ty + ; expr3' <- tcCheckPolyExpr expr3 elt_ty ; eft <- newMethodFromName (ArithSeqOrigin seq) enumFromThenToName [elt_ty] ; return $ mkHsWrap wrap $ @@ -1251,13 +1283,11 @@ tcInferApp expr Nothing -> thing_inside -- Don't set the location twice Just loc -> setSrcSpan loc thing_inside ---------------------- tcInferApp_finish :: HsExpr GhcRn -- Renamed function -> HsExpr GhcTc -> TcSigmaType -- Function and its type -> [LHsExprArgIn] -- Arguments -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcSigmaType) - tcInferApp_finish rn_fun tc_fun fun_sigma rn_args = do { (tc_args, actual_res_ty) <- tcArgs rn_fun fun_sigma rn_args ; return (tc_fun, tc_args, actual_res_ty) } @@ -1364,9 +1394,9 @@ tcArgs fun orig_fun_ty orig_args _ -> ty_app_err upsilon_ty hs_ty_arg } go n so_far fun_ty (HsEValArg loc arg : args) - = do { (wrap, [arg_ty], res_ty) - <- matchActualFunTysPart herald fun_orig (Just fun) - n_val_args so_far 1 fun_ty + = do { (wrap, arg_ty, res_ty) + <- matchActualFunTySigma herald fun_orig (Just fun) + (n_val_args, so_far) fun_ty ; arg' <- tcArg fun arg arg_ty n ; (args', inner_res_ty) <- go (n+1) (arg_ty:so_far) res_ty args ; return ( addArgWrap wrap $ HsEValArg loc arg' : args' @@ -1465,13 +1495,12 @@ tcArg :: HsExpr GhcRn -- The function (for error messages) -> Int -- # of argument -> TcM (LHsExpr GhcTc) -- Resulting argument tcArg fun arg ty arg_no - = addErrCtxt (funAppCtxt fun arg arg_no) $ - do { traceTc "tcArg {" $ - vcat [ text "arg #" <> ppr arg_no <+> dcolon <+> ppr ty - , text "arg:" <+> ppr arg ] - ; arg' <- tcCheckExprNC arg ty - ; traceTc "tcArg }" empty - ; return arg' } + = addErrCtxt (funAppCtxt fun arg arg_no) $ + do { traceTc "tcArg" $ + vcat [ ppr arg_no <+> text "of" <+> ppr fun + , text "arg type:" <+> ppr ty + , text "arg:" <+> ppr arg ] + ; tcCheckPolyExprNC arg ty } ---------------- tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc] @@ -1479,7 +1508,7 @@ tcTupArgs args tys = ASSERT( equalLength args tys ) mapM go (args `zip` tys) where go (L l (Missing {}), arg_ty) = return (L l (Missing arg_ty)) - go (L l (Present x expr), arg_ty) = do { expr' <- tcCheckExpr expr arg_ty + go (L l (Present x expr), arg_ty) = do { expr' <- tcCheckPolyExpr expr arg_ty ; return (L l (Present x expr')) } --------------------------- @@ -1536,7 +1565,7 @@ tcSynArgE :: CtOrigin -- ^ returns a wrapper :: (type of right shape) "->" (type passed in) tcSynArgE orig sigma_ty syn_ty thing_inside = do { (skol_wrap, (result, ty_wrapper)) - <- tcSkolemise GenSigCtxt sigma_ty $ \ _ rho_ty -> + <- tcSkolemise GenSigCtxt sigma_ty $ \ rho_ty -> go rho_ty syn_ty ; return (result, skol_wrap <.> ty_wrapper) } where @@ -1554,11 +1583,11 @@ tcSynArgE orig sigma_ty syn_ty thing_inside ; return (result, mkWpCastN list_co) } go rho_ty (SynFun arg_shape res_shape) - = do { ( ( ( (result, arg_ty, res_ty) - , res_wrapper ) -- :: res_ty_out "->" res_ty - , arg_wrapper1, [], arg_wrapper2 ) -- :: arg_ty "->" arg_ty_out - , match_wrapper ) -- :: (arg_ty -> res_ty) "->" rho_ty - <- matchExpectedFunTys herald 1 (mkCheckExpType rho_ty) $ + = do { ( match_wrapper -- :: (arg_ty -> res_ty) "->" rho_ty + , ( ( (result, arg_ty, res_ty) + , res_wrapper ) -- :: res_ty_out "->" res_ty + , arg_wrapper1, [], arg_wrapper2 ) ) -- :: arg_ty "->" arg_ty_out + <- matchExpectedFunTys herald GenSigCtxt 1 (mkCheckExpType rho_ty) $ \ [arg_ty] res_ty -> do { arg_tc_ty <- expTypeToType arg_ty ; res_tc_ty <- expTypeToType res_ty @@ -1604,7 +1633,8 @@ tcSynArgA :: CtOrigin -- and a wrapper to be applied to the overall expression tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside = do { (match_wrapper, arg_tys, res_ty) - <- matchActualFunTys herald orig Nothing (length arg_shapes) sigma_ty + <- matchActualFunTysRho herald orig Nothing + (length arg_shapes) sigma_ty -- match_wrapper :: sigma_ty "->" (arg_tys -> res_ty) ; ((result, res_wrapper), arg_wrappers) <- tc_syn_args_e arg_tys arg_shapes $ \ arg_results -> @@ -1634,7 +1664,7 @@ tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside = do { result <- thing_inside [res_ty] ; return (result, idHsWrapper) } tc_syn_arg res_ty SynRho thing_inside - = do { (inst_wrap, rho_ty) <- deeplyInstantiate orig res_ty + = do { (inst_wrap, rho_ty) <- topInstantiate orig res_ty -- inst_wrap :: res_ty "->" rho_ty ; result <- thing_inside [rho_ty] ; return (result, inst_wrap) } @@ -1648,7 +1678,7 @@ tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside tc_syn_arg _ (SynFun {}) _ = pprPanic "tcSynArgA hits a SynFun" (ppr orig) tc_syn_arg res_ty (SynType the_ty) thing_inside - = do { wrap <- tcSubTypeO orig GenSigCtxt res_ty the_ty + = do { wrap <- tcSubType orig GenSigCtxt res_ty the_ty ; result <- thing_inside [] ; return (result, wrap) } @@ -1687,22 +1717,10 @@ in the other order, the extra signature in f2 is reqd. tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint - do { (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id - ; given <- newEvVars theta - ; traceTc "tcExprSig: CompleteSig" $ - vcat [ text "poly_id:" <+> ppr poly_id <+> dcolon <+> ppr (idType poly_id) - , text "tv_prs:" <+> ppr tv_prs ] - - ; let skol_info = SigSkol ExprSigCtxt (idType poly_id) tv_prs - skol_tvs = map snd tv_prs - ; (ev_binds, expr') <- checkConstraints skol_info skol_tvs given $ - tcExtendNameTyVarEnv tv_prs $ - tcCheckExprNC expr tau - - ; let poly_wrap = mkWpTyLams skol_tvs - <.> mkWpLams given - <.> mkWpLet ev_binds - ; return (mkLHsWrap poly_wrap expr', idType poly_id) } + do { let poly_ty = idType poly_id + ; (wrap, expr') <- tcSkolemiseScoped ExprSigCtxt poly_ty $ \rho_ty -> + tcCheckMonoExprNC expr rho_ty + ; return (mkLHsWrap wrap expr', poly_ty) } tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint @@ -1711,7 +1729,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) do { sig_inst <- tcInstSig sig ; expr' <- tcExtendNameTyVarEnv (mapSnd binderVar $ sig_inst_skols sig_inst) $ tcExtendNameTyVarEnv (sig_inst_wcs sig_inst) $ - tcCheckExprNC expr (sig_inst_tau sig_inst) + tcCheckPolyExprNC expr (sig_inst_tau sig_inst) ; return (expr', sig_inst) } -- See Note [Partial expression signatures] ; let tau = sig_inst_tau sig_inst @@ -1735,7 +1753,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) then return idHsWrapper -- Fast path; also avoids complaint when we infer -- an ambiguous type and have AllowAmbiguousType -- e..g infer x :: forall a. F a -> Int - else tcSubType_NC ExprSigCtxt inferred_sigma my_sigma + else tcSubTypeSigma ExprSigCtxt inferred_sigma my_sigma ; traceTc "tcExpSig" (ppr qtvs $$ ppr givens $$ ppr inferred_sigma $$ ppr my_sigma) ; let poly_wrap = wrap @@ -2476,7 +2494,7 @@ tcRecordField :: ConLike -> Assoc Name Type tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs | Just field_ty <- assocMaybe flds_w_tys sel_name = addErrCtxt (fieldCtxt field_lbl) $ - do { rhs' <- tcCheckExprNC rhs field_ty + do { rhs' <- tcCheckPolyExprNC rhs field_ty ; let field_id = mkUserLocal (nameOccName sel_name) (nameUnique sel_name) field_ty loc @@ -2584,7 +2602,7 @@ addFunResCtxt has_args fun fun_res_ty env_ty -- function types] (_, _, fun_tau) = tcSplitNestedSigmaTys fun_res' -- No need to call tcSplitNestedSigmaTys here, since env_ty is - -- an ExpRhoTy, i.e., it's already deeply instantiated. + -- an ExpRhoTy, i.e., it's already instantiated. (_, _, env_tau) = tcSplitSigmaTy env' (args_fun, res_fun) = tcSplitFunTys fun_tau (args_env, res_env) = tcSplitFunTys env_tau diff --git a/compiler/GHC/Tc/Gen/Expr.hs-boot b/compiler/GHC/Tc/Gen/Expr.hs-boot index d9138a4d7e..1f26ef242a 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs-boot +++ b/compiler/GHC/Tc/Gen/Expr.hs-boot @@ -6,16 +6,26 @@ import GHC.Tc.Types ( TcM ) import GHC.Tc.Types.Origin ( CtOrigin ) import GHC.Hs.Extension ( GhcRn, GhcTcId ) -tcCheckExpr :: LHsExpr GhcRn -> TcSigmaType -> TcM (LHsExpr GhcTcId) - -tcLExpr, tcLExprNC - :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTcId) -tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId) - -tcInferRho, tcInferRhoNC - :: LHsExpr GhcRn-> TcM (LHsExpr GhcTcId, TcRhoType) - -tcInferSigma :: LHsExpr GhcRn-> TcM (LHsExpr GhcTcId, TcSigmaType) +tcCheckPolyExpr :: + LHsExpr GhcRn + -> TcSigmaType + -> TcM (LHsExpr GhcTcId) + +tcMonoExpr, tcMonoExprNC :: + LHsExpr GhcRn + -> ExpRhoType + -> TcM (LHsExpr GhcTcId) +tcCheckMonoExpr, tcCheckMonoExprNC :: + LHsExpr GhcRn + -> TcRhoType + -> TcM (LHsExpr GhcTcId) + +tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId) + +tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcSigmaType) + +tcInferRho, tcInferRhoNC :: + LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcRhoType) tcSyntaxOp :: CtOrigin -> SyntaxExprRn diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs index 8163e6820d..06febcef33 100644 --- a/compiler/GHC/Tc/Gen/Foreign.hs +++ b/compiler/GHC/Tc/Gen/Foreign.hs @@ -388,7 +388,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe = addErrCtxt (foreignDeclCtxt fo) $ do sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty - rhs <- tcCheckExpr (nlHsVar nm) sig_ty + rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 328ed43d65..2c2345724f 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -31,8 +31,8 @@ module GHC.Tc.Gen.HsType ( bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol, ContextKind(..), - -- Type checking type and class decls - bindTyClTyVars, + -- Type checking type and class decls, and instances thereof + bindTyClTyVars, tcFamTyPats, etaExpandAlgTyCon, tcbVisibilities, -- tyvars @@ -46,13 +46,11 @@ module GHC.Tc.Gen.HsType ( tcNamedWildCardBinders, tcHsLiftedType, tcHsOpenType, tcHsLiftedTypeNC, tcHsOpenTypeNC, - tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType, - tcHsMbContext, tcHsContext, tcLHsPredType, tcInferApps, + tcInferLHsType, tcInferLHsTypeUnsaturated, tcCheckLHsType, + tcHsMbContext, tcHsContext, tcLHsPredType, failIfEmitsConstraints, solveEqualities, -- useful re-export - typeLevelMode, kindLevelMode, - kindGeneralizeAll, kindGeneralizeSome, kindGeneralizeNone, -- Sort-checking kinds @@ -115,6 +113,7 @@ import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.Bag( unitBag ) import Data.List ( find ) import Control.Monad @@ -159,6 +158,91 @@ checking until step (3). Check types AND do validity checking * * ************************************************************************ + +Note [Keeping implicitly quantified variables in order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When the user implicitly quantifies over variables (say, in a type +signature), we need to come up with some ordering on these variables. +This is done by bumping the TcLevel, bringing the tyvars into scope, +and then type-checking the thing_inside. The constraints are all +wrapped in an implication, which is then solved. Finally, we can +zonk all the binders and then order them with scopedSort. + +It's critical to solve before zonking and ordering in order to uncover +any unifications. You might worry that this eager solving could cause +trouble elsewhere. I don't think it will. Because it will solve only +in an increased TcLevel, it can't unify anything that was mentioned +elsewhere. Additionally, we require that the order of implicitly +quantified variables is manifest by the scope of these variables, so +we're not going to learn more information later that will help order +these variables. + +Note [Recipe for checking a signature] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Checking a user-written signature requires several steps: + + 1. Generate constraints. + 2. Solve constraints. + 3. Promote tyvars and/or kind-generalize. + 4. Zonk. + 5. Check validity. + +There may be some surprises in here: + +Step 2 is necessary for two reasons: most signatures also bring +implicitly quantified variables into scope, and solving is necessary +to get these in the right order (see Note [Keeping implicitly +quantified variables in order]). Additionally, solving is necessary in +order to kind-generalize correctly: otherwise, we do not know which +metavariables are left unsolved. + +Step 3 is done by a call to candidateQTyVarsOfType, followed by a call to +kindGeneralize{All,Some,None}. Here, we have to deal with the fact that +metatyvars generated in the type may have a bumped TcLevel, because explicit +foralls raise the TcLevel. To avoid these variables from ever being visible in +the surrounding context, we must obey the following dictum: + + Every metavariable in a type must either be + (A) generalized, or + (B) promoted, or See Note [Promotion in signatures] + (C) a cause to error See Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType + +The kindGeneralize functions do not require pre-zonking; they zonk as they +go. + +If you are actually doing kind-generalization, you need to bump the level +before generating constraints, as we will only generalize variables with +a TcLevel higher than the ambient one. + +After promoting/generalizing, we need to zonk again because both +promoting and generalizing fill in metavariables. + +Note [Promotion in signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If an unsolved metavariable in a signature is not generalized +(because we're not generalizing the construct -- e.g., pattern +sig -- or because the metavars are constrained -- see kindGeneralizeSome) +we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] +in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing +and the reinstantiating with a fresh metavariable at the current level. +So in some sense, we generalize *all* variables, but then re-instantiate +some of them. + +Here is an example of why we must promote: + foo (x :: forall a. a -> Proxy b) = ... + +In the pattern signature, `b` is unbound, and will thus be brought into +scope. We do not know its kind: it will be assigned kappa[2]. Note that +kappa is at TcLevel 2, because it is invented under a forall. (A priori, +the kind kappa might depend on `a`, so kappa rightly has a higher TcLevel +than the surrounding context.) This kappa cannot be solved for while checking +the pattern signature (which is not kind-generalized). When we are checking +the *body* of foo, though, we need to unify the type of x with the argument +type of bar. At this point, the ambient TcLevel is 1, and spotting a +matavariable with level 2 would violate the (WantedTvInv) invariant of +Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, +we promote the metavariable to level 1. This is all done in kindGeneralizeNone. + -} funsSigCtxt :: [Located Name] -> UserTypeCtxt @@ -213,19 +297,21 @@ kcClassSigType skol_info names (HsIB { hsib_ext = sig_vars <- pushTcLevelM $ solveLocalEqualitiesX "kcClassSigType" $ bindImplicitTKBndrs_Skol sig_vars $ - tc_lhs_type typeLevelMode hs_ty liftedTypeKind + tcLHsType hs_ty liftedTypeKind - ; emitResidualTvConstraint skol_info Nothing spec_tkvs - tc_lvl wanted } + ; emitResidualTvConstraint skol_info spec_tkvs tc_lvl wanted } tcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM Type -- Does not do validity checking tcClassSigType skol_info names sig_ty = addSigCtxt (funsSigCtxt names) (hsSigType sig_ty) $ - snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + do { (implic, ty) <- tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + ; emitImplication implic + ; return ty } -- Do not zonk-to-Type, nor perform a validity check -- We are in a knot with the class and associated types -- Zonking and validity checking is done by tcClassDecl + -- -- No need to fail here if the type has an error: -- If we're in the kind-checking phase, the solveEqualities -- in kcTyClGroup catches the error @@ -247,46 +333,36 @@ tcHsSigType ctxt sig_ty do { traceTc "tcHsSigType {" (ppr sig_ty) -- Generalise here: see Note [Kind generalisation] - ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty - (expectedKindInCtxt ctxt) - ; ty <- zonkTcType ty + ; (implic, ty) <- tc_hs_sig_type skol_info sig_ty (expectedKindInCtxt ctxt) - ; when insol failM - -- See Note [Fail fast if there are insoluble kind equalities] in GHC.Tc.Solver + -- Spit out the implication (and perhaps fail fast) + -- See Note [Failure in local type signatures] in GHC.Tc.Solver + ; emitFlatConstraints (mkImplicWC (unitBag implic)) + ; ty <- zonkTcType ty ; checkValidType ctxt ty ; traceTc "end tcHsSigType }" (ppr ty) ; return ty } where skol_info = SigTypeSkol ctxt --- Does validity checking and zonking. -tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) -tcStandaloneKindSig (L _ kisig) = case kisig of - StandaloneKindSig _ (L _ name) ksig -> - let ctxt = StandaloneKindSigCtxt name in - addSigCtxt ctxt (hsSigType ksig) $ - do { kind <- tcTopLHsType kindLevelMode ksig (expectedKindInCtxt ctxt) - ; checkValidType ctxt kind - ; return (name, kind) } - tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM (Bool, TcType) + -> ContextKind -> TcM (Implication, TcType) -- Kind-checks/desugars an 'LHsSigType', -- solve equalities, -- and then kind-generalizes. -- This will never emit constraints, as it uses solveEqualities internally. -- No validity checking or zonking --- Returns also a Bool indicating whether the type induced an insoluble constraint; --- True <=> constraint is insoluble +-- Returns also an implication for the unsolved constraints tc_hs_sig_type skol_info hs_sig_type ctxt_kind | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type = do { (tc_lvl, (wanted, (spec_tkvs, ty))) <- pushTcLevelM $ solveLocalEqualitiesX "tc_hs_sig_type" $ + -- See Note [Failure in local type signatures] bindImplicitTKBndrs_Skol sig_vars $ do { kind <- newExpectedKind ctxt_kind - ; tc_lhs_type typeLevelMode hs_ty kind } + ; tcLHsType hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- should be in the global tyvars, and therefore won't be quantified @@ -301,18 +377,67 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind ; let should_gen = not . (`elemVarSet` constrained) ; kvs <- kindGeneralizeSome should_gen ty1 - ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs) - tc_lvl wanted - ; return (insolubleWC wanted, mkInfForAllTys kvs ty1) } + -- Build an implication for any as-yet-unsolved kind equalities + -- See Note [Skolem escape in type signatures] + ; implic <- buildTvImplication skol_info (kvs ++ spec_tkvs) tc_lvl wanted + + ; return (implic, mkInfForAllTys kvs ty1) } + +{- Note [Skolem escape in type signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +tcHsSigType is tricky. Consider (T11142) + foo :: forall b. (forall k (a :: k). SameKind a b) -> () +This is ill-kinded becuase of a nested skolem-escape. + +That will show up as an un-solvable constraint in the implication +returned by buildTvImplication in tc_hs_sig_type. See Note [Skolem +escape prevention] in GHC.Tc.Utils.TcType for why it is unsolvable +(the unification variable for b's kind is untouchable). + +Then, in GHC.Tc.Solver.emitFlatConstraints (called from tcHsSigType) +we'll try to float out the constraint, be unable to do so, and fail. +See GHC.Tc.Solver Note [Failure in local type signatures] for more +detail on this. + +The separation between tcHsSigType and tc_hs_sig_type is because +tcClassSigType wants to use the latter, but *not* fail fast, because +there are skolems from the class decl which are in scope; but it's fine +not to because tcClassDecl1 has a solveEqualities wrapped around all +the tcClassSigType calls. + +That's why tcHsSigType does emitFlatConstraints (which fails fast) but +tcClassSigType just does emitImplication (which does not). Ugh. + +c.f. see also Note [Skolem escape and forall-types]. The difference +is that we don't need to simplify at a forall type, only at the +top level of a signature. +-} + +-- Does validity checking and zonking. +tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) +tcStandaloneKindSig (L _ kisig) = case kisig of + StandaloneKindSig _ (L _ name) ksig -> + let ctxt = StandaloneKindSigCtxt name in + addSigCtxt ctxt (hsSigType ksig) $ + do { let mode = mkMode KindLevel + ; kind <- tc_top_lhs_type mode ksig (expectedKindInCtxt ctxt) + ; checkValidType ctxt kind + ; return (name, kind) } + -tcTopLHsType :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type +tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type +tcTopLHsType hs_ty ctxt_kind + = tc_top_lhs_type (mkMode TypeLevel) hs_ty ctxt_kind + +tc_top_lhs_type :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type -- tcTopLHsType is used for kind-checking top-level HsType where -- we want to fully solve /all/ equalities, and report errors -- Does zonking, but not validity checking because it's used -- for things (like deriving and instances) that aren't -- ordinary types -tcTopLHsType mode hs_sig_type ctxt_kind +-- Used for both types and kinds +tc_top_lhs_type mode hs_sig_type ctxt_kind | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type = do { traceTc "tcTopLHsType {" (ppr hs_ty) ; (spec_tkvs, ty) @@ -340,7 +465,7 @@ tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind]) tcHsDeriv hs_ty = do { ty <- checkNoErrs $ -- Avoid redundant error report -- with "illegal deriving", below - tcTopLHsType typeLevelMode hs_ty AnyKind + tcTopLHsType hs_ty AnyKind ; let (tvs, pred) = splitForAllTys ty (kind_args, _) = splitFunTys (tcTypeKind pred) ; case getClassPredTys_maybe pred of @@ -369,7 +494,7 @@ tcDerivStrategy mb_lds tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy tc_deriv_strategy NewtypeStrategy = boring_case NewtypeStrategy tc_deriv_strategy (ViaStrategy ty) = do - ty' <- checkNoErrs $ tcTopLHsType typeLevelMode ty AnyKind + ty' <- checkNoErrs $ tcTopLHsType ty AnyKind let (via_tvs, via_pred) = splitForAllTys ty' pure (ViaStrategy via_pred, via_tvs) @@ -387,7 +512,7 @@ tcHsClsInstType user_ctxt hs_inst_ty -- eagerly avoids follow-on errors when checkValidInstance -- sees an unsolved coercion hole inst_ty <- checkNoErrs $ - tcTopLHsType typeLevelMode hs_inst_ty (TheKind constraintKind) + tcTopLHsType hs_inst_ty (TheKind constraintKind) ; checkValidInstance user_ctxt hs_inst_ty inst_ty ; return inst_ty } @@ -397,14 +522,15 @@ tcHsTypeApp :: LHsWcType GhcRn -> Kind -> TcM Type -- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType tcHsTypeApp wc_ty kind | HsWC { hswc_ext = sig_wcs, hswc_body = hs_ty } <- wc_ty - = do { ty <- solveLocalEqualities "tcHsTypeApp" $ + = do { mode <- mkHoleMode TypeLevel HM_VTA + -- HM_VTA: See Note [Wildcards in visible type application] + ; ty <- addTypeCtxt hs_ty $ + solveLocalEqualities "tcHsTypeApp" $ -- We are looking at a user-written type, very like a -- signature so we want to solve its equalities right now - unsetWOptM Opt_WarnPartialTypeSignatures $ - setXOptM LangExt.PartialTypeSignatures $ - -- See Note [Wildcards in visible type application] tcNamedWildCardBinders sig_wcs $ \ _ -> - tcCheckLHsType hs_ty (TheKind kind) + tc_lhs_type mode hs_ty kind + -- We do not kind-generalize type applications: we just -- instantiate with exactly what the user says. -- See Note [No generalization in type application] @@ -448,6 +574,31 @@ There is also the possibility of mentioning a wildcard -} +tcFamTyPats :: TyCon + -> HsTyPats GhcRn -- Patterns + -> TcM (TcType, TcKind) -- (lhs_type, lhs_kind) +-- Check the LHS of a type/data family instance +-- e.g. type instance F ty1 .. tyn = ... +-- Used for both type and data families +tcFamTyPats fam_tc hs_pats + = do { traceTc "tcFamTyPats {" $ + vcat [ ppr fam_tc, text "arity:" <+> ppr fam_arity ] + + ; mode <- mkHoleMode TypeLevel HM_FamPat + -- HM_FamPat: See Note [Wildcards in family instances] in + -- GHC.Rename.Module + ; let fun_ty = mkTyConApp fam_tc [] + ; (fam_app, res_kind) <- tcInferTyApps mode lhs_fun fun_ty hs_pats + + ; traceTc "End tcFamTyPats }" $ + vcat [ ppr fam_tc, text "res_kind:" <+> ppr res_kind ] + + ; return (fam_app, res_kind) } + where + fam_name = tyConName fam_tc + fam_arity = tyConArity fam_tc + lhs_fun = noLoc (HsTyVar noExtField NotPromoted (noLoc fam_name)) + {- ************************************************************************ * * @@ -465,38 +616,38 @@ tcHsOpenType ty = addTypeCtxt ty $ tcHsOpenTypeNC ty tcHsLiftedType ty = addTypeCtxt ty $ tcHsLiftedTypeNC ty tcHsOpenTypeNC ty = do { ek <- newOpenTypeKind - ; tc_lhs_type typeLevelMode ty ek } -tcHsLiftedTypeNC ty = tc_lhs_type typeLevelMode ty liftedTypeKind + ; tcLHsType ty ek } +tcHsLiftedTypeNC ty = tcLHsType ty liftedTypeKind -- Like tcHsType, but takes an expected kind tcCheckLHsType :: LHsType GhcRn -> ContextKind -> TcM TcType tcCheckLHsType hs_ty exp_kind = addTypeCtxt hs_ty $ do { ek <- newExpectedKind exp_kind - ; tc_lhs_type typeLevelMode hs_ty ek } + ; tcLHsType hs_ty ek } -tcLHsType :: LHsType GhcRn -> TcM (TcType, TcKind) +tcInferLHsType :: LHsType GhcRn -> TcM TcType -- Called from outside: set the context -tcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty) - --- Like tcLHsType, but use it in a context where type synonyms and type families --- do not need to be saturated, like in a GHCi :kind call -tcLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind) -tcLHsTypeUnsaturated hs_ty - | Just (hs_fun_ty, hs_args) <- splitHsAppTys (unLoc hs_ty) +tcInferLHsType hs_ty = addTypeCtxt hs_ty $ - do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty - ; tcInferApps_nosat mode hs_fun_ty fun_ty hs_args } - -- Notice the 'nosat'; do not instantiate trailing - -- invisible arguments of a type family. - -- See Note [Dealing with :kind] + do { (ty, _kind) <- tc_infer_lhs_type (mkMode TypeLevel) hs_ty + ; return ty } - | otherwise +-- Used to check the argument of GHCi :kind +-- Allow and report wildcards, e.g. :kind T _ +-- Do not saturate family applications: see Note [Dealing with :kind] +tcInferLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind) +tcInferLHsTypeUnsaturated hs_ty = addTypeCtxt hs_ty $ - tc_infer_lhs_type mode hs_ty - - where - mode = typeLevelMode + do { mode <- mkHoleMode TypeLevel HM_Sig -- Allow and report holes + ; case splitHsAppTys (unLoc hs_ty) of + Just (hs_fun_ty, hs_args) + -> do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty + ; tcInferTyApps_nosat mode hs_fun_ty fun_ty hs_args } + -- Notice the 'nosat'; do not instantiate trailing + -- invisible arguments of a type family. + -- See Note [Dealing with :kind] + Nothing -> tc_infer_lhs_type mode hs_ty } {- Note [Dealing with :kind] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -507,7 +658,7 @@ Consider this GHCi command We will only get the 'forall' if we /refrain/ from saturating those invisible binders. But generally we /do/ saturate those invisible -binders (see tcInferApps), and we want to do so for nested application +binders (see tcInferTyApps), and we want to do so for nested application even in GHCi. Consider for example (#16287) ghci> type family F :: k ghci> data T :: (forall k. k) -> Type @@ -515,7 +666,7 @@ even in GHCi. Consider for example (#16287) We want to reject this. It's just at the very top level that we want to switch off saturation. -So tcLHsTypeUnsaturated does a little special case for top level +So tcInferLHsTypeUnsaturated does a little special case for top level applications. Actually the common case is a bare variable, as above. @@ -538,21 +689,46 @@ concern things that the renamer can't handle. -- grow, at least to include the distinction between patterns and -- not-patterns. -- --- To find out where the mode is used, search for 'mode_level' -data TcTyMode = TcTyMode { mode_level :: TypeOrKind } - -typeLevelMode :: TcTyMode -typeLevelMode = TcTyMode { mode_level = TypeLevel } - -kindLevelMode :: TcTyMode -kindLevelMode = TcTyMode { mode_level = KindLevel } +-- To find out where the mode is used, search for 'mode_tyki' +-- +-- This data type is purely local, not exported from this module +data TcTyMode + = TcTyMode { mode_tyki :: TypeOrKind + + -- See Note [Levels for wildcards] + -- Nothing <=> no wildcards expected + , mode_holes :: Maybe (TcLevel, HoleMode) + } + +-- HoleMode says how to treat the occurrences +-- of anonymous wildcards; see tcAnonWildCardOcc +data HoleMode = HM_Sig -- Partial type signatures: f :: _ -> Int + | HM_FamPat -- Family instances: F _ Int = Bool + | HM_VTA -- Visible type and kind application: + -- f @(Maybe _) + -- Maybe @(_ -> _) + +mkMode :: TypeOrKind -> TcTyMode +mkMode tyki = TcTyMode { mode_tyki = tyki, mode_holes = Nothing } + +mkHoleMode :: TypeOrKind -> HoleMode -> TcM TcTyMode +mkHoleMode tyki hm + = do { lvl <- getTcLevel + ; return (TcTyMode { mode_tyki = tyki + , mode_holes = Just (lvl,hm) }) } --- switch to kind level kindLevel :: TcTyMode -> TcTyMode -kindLevel mode = mode { mode_level = KindLevel } +kindLevel mode = mode { mode_tyki = KindLevel } + +instance Outputable HoleMode where + ppr HM_Sig = text "HM_Sig" + ppr HM_FamPat = text "HM_FamPat" + ppr HM_VTA = text "HM_VTA" instance Outputable TcTyMode where - ppr = ppr . mode_level + ppr (TcTyMode { mode_tyki = tyki, mode_holes = hm }) + = text "TcTyMode" <+> braces (sep [ ppr tyki <> comma + , ppr hm ]) {- Note [Bidirectional type checking] @@ -627,11 +803,12 @@ tc_infer_hs_type mode (HsParTy _ t) tc_infer_hs_type mode ty | Just (hs_fun_ty, hs_args) <- splitHsAppTys ty - = do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty - ; tcInferApps mode hs_fun_ty fun_ty hs_args } + = do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty + ; tcInferTyApps mode hs_fun_ty fun_ty hs_args } tc_infer_hs_type mode (HsKindSig _ ty sig) - = do { sig' <- tcLHsKindSig KindSigCtxt sig + = do { let mode' = mode { mode_tyki = KindLevel } + ; sig' <- tc_lhs_kind_sig mode' KindSigCtxt sig -- We must typecheck the kind signature, and solve all -- its equalities etc; from this point on we may do -- things like instantiate its foralls, so it needs @@ -665,6 +842,10 @@ tc_infer_hs_type mode other_ty ; return (ty', kv) } ------------------------------------------ +tcLHsType :: LHsType GhcRn -> TcKind -> TcM TcType +tcLHsType hs_ty exp_kind + = tc_lhs_type (mkMode TypeLevel) hs_ty exp_kind + tc_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType tc_lhs_type mode (L span ty) exp_kind = setSrcSpan span $ @@ -718,18 +899,25 @@ tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind tc_hs_type mode forall@(HsForAllTy { hst_fvf = fvf, hst_bndrs = hs_tvs , hst_body = ty }) exp_kind = do { (tclvl, wanted, (inv_tv_bndrs, ty')) - <- pushLevelAndCaptureConstraints $ - bindExplicitTKBndrs_Skol hs_tvs $ + <- pushLevelAndCaptureConstraints $ + bindExplicitTKBndrs_Skol_M mode hs_tvs $ + -- The _M variant passes on the mode from the type, to + -- any wildards in kind signatures on the forall'd variables + -- e.g. f :: _ -> Int -> forall (a :: _). blah tc_lhs_type mode ty exp_kind - -- Do not kind-generalise here! See Note [Kind generalisation] - -- Why exp_kind? See Note [Body kind of HsForAllTy] - ; let skol_info = ForAllSkol (ppr forall) - m_telescope = Just (sep (map ppr hs_tvs)) + -- Why exp_kind? See Note [Body kind of HsForAllTy] - ; tv_bndrs <- mapM construct_bndr inv_tv_bndrs + -- Do not kind-generalise here! See Note [Kind generalisation] - ; emitResidualTvConstraint skol_info m_telescope (binderVars tv_bndrs) tclvl wanted + ; let skol_info = ForAllSkol (ppr forall) (sep (map ppr hs_tvs)) + skol_tvs = binderVars inv_tv_bndrs + ; implic <- buildTvImplication skol_info skol_tvs tclvl wanted + ; emitImplication implic + -- /Always/ emit this implication even if wanted is empty + -- We need the implication so that we check for a bad telescope + -- See Note [Skolem escape and forall-types] + ; tv_bndrs <- mapM construct_bndr inv_tv_bndrs ; return (mkForAllTys tv_bndrs ty') } where construct_bndr :: TcInvisTVBinder -> TcM TcTyVarBinder @@ -846,7 +1034,7 @@ tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind --------- Constraint types tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind - = do { MASSERT( isTypeLevel (mode_level mode) ) + = do { MASSERT( isTypeLevel (mode_tyki mode) ) ; ty' <- tc_lhs_type mode ty liftedTypeKind ; let n' = mkStrLitTy $ hsIPNameFS n ; ipClass <- tcLookupClass ipClassName @@ -875,7 +1063,7 @@ tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type _ wc@(HsWildCardTy _) ek = tcAnonWildCardOcc wc ek +tc_hs_type mode ty@(HsWildCardTy _) ek = tcAnonWildCardOcc mode ty ek {- Note [Variable Specificity and Forall Visibility] @@ -903,7 +1091,7 @@ Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep. ------------------------------------------ tc_fun_type :: TcTyMode -> LHsType GhcRn -> LHsType GhcRn -> TcKind -> TcM TcType -tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of +tc_fun_type mode ty1 ty2 exp_kind = case mode_tyki mode of TypeLevel -> do { arg_k <- newOpenTypeKind ; res_k <- newOpenTypeKind @@ -917,46 +1105,10 @@ tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2') liftedTypeKind exp_kind } ---------------------------- -tcAnonWildCardOcc :: HsType GhcRn -> Kind -> TcM TcType -tcAnonWildCardOcc wc exp_kind - = do { wc_tv <- newWildTyVar -- The wildcard's kind will be an un-filled-in meta tyvar - - ; part_tysig <- xoptM LangExt.PartialTypeSignatures - ; warning <- woptM Opt_WarnPartialTypeSignatures - - ; unless (part_tysig && not warning) $ - emitAnonTypeHole wc_tv - -- Why the 'unless' guard? - -- See Note [Wildcards in visible kind application] - - ; checkExpectedKind wc (mkTyVarTy wc_tv) - (tyVarKind wc_tv) exp_kind } - -{- Note [Wildcards in visible kind application] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There are cases where users might want to pass in a wildcard as a visible kind -argument, for instance: - -data T :: forall k1 k2. k1 → k2 → Type where - MkT :: T a b -x :: T @_ @Nat False n -x = MkT - -So we should allow '@_' without emitting any hole constraints, and -regardless of whether PartialTypeSignatures is enabled or not. But how would -the typechecker know which '_' is being used in VKA and which is not when it -calls emitNamedTypeHole in tcHsPartialSigType on all HsWildCardBndrs? -The solution then is to neither rename nor include unnamed wildcards in HsWildCardBndrs, -but instead give every anonymous wildcard a fresh wild tyvar in tcAnonWildCardOcc. -And whenever we see a '@', we automatically turn on PartialTypeSignatures and -turn off hole constraint warnings, and do not call emitAnonTypeHole -under these conditions. -See related Note [Wildcards in visible type application] here and -Note [The wildcard story for types] in GHC.Hs.Types +{- Note [Skolem escape and forall-types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See also Note [Checking telescopes]. -Note [Skolem escape and forall-types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: forall a. (forall kb (b :: kb). Proxy '[a, b]) -> () @@ -970,11 +1122,19 @@ unification variable, because it would be untouchable inside this inner implication. That's what the pushLevelAndCaptureConstraints, plus subsequent -emitResidualTvConstraint is all about, when kind-checking +buildTvImplication/emitImplication is all about, when kind-checking HsForAllTy. -Note that we don't need to /simplify/ the constraints here -because we aren't generalising. We just capture them. +Note that + +* We don't need to /simplify/ the constraints here + because we aren't generalising. We just capture them. + +* We can't use emitResidualTvConstraint, because that has a fast-path + for empty constraints. We can't take that fast path here, because + we must do the bad-telescope check even if there are no inner wanted + constraints. See Note [Checking telescopes] in + GHC.Tc.Types.Constraint. Lacking this check led to #16247. -} {- ********************************************************************* @@ -1117,14 +1277,14 @@ splitHsAppTys hs_ty go f as = (f, as) --------------------------- -tcInferAppHead :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind) +tcInferTyAppHead :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind) -- Version of tc_infer_lhs_type specialised for the head of an -- application. In particular, for a HsTyVar (which includes type --- constructors, it does not zoom off into tcInferApps and family +-- constructors, it does not zoom off into tcInferTyApps and family -- saturation -tcInferAppHead mode (L _ (HsTyVar _ _ (L _ tv))) +tcInferTyAppHead mode (L _ (HsTyVar _ _ (L _ tv))) = tcTyVar mode tv -tcInferAppHead mode ty +tcInferTyAppHead mode ty = tc_infer_lhs_type mode ty --------------------------- @@ -1135,24 +1295,24 @@ tcInferAppHead mode ty -- These kinds should be used to instantiate invisible kind variables; -- they come from an enclosing class for an associated type/data family. -- --- tcInferApps also arranges to saturate any trailing invisible arguments +-- tcInferTyApps also arranges to saturate any trailing invisible arguments -- of a type-family application, which is usually the right thing to do --- tcInferApps_nosat does not do this saturation; it is used only +-- tcInferTyApps_nosat does not do this saturation; it is used only -- by ":kind" in GHCi -tcInferApps, tcInferApps_nosat +tcInferTyApps, tcInferTyApps_nosat :: TcTyMode -> LHsType GhcRn -- ^ Function (for printing only) -> TcType -- ^ Function -> [LHsTypeArg GhcRn] -- ^ Args -> TcM (TcType, TcKind) -- ^ (f args, args, result kind) -tcInferApps mode hs_ty fun hs_args - = do { (f_args, res_k) <- tcInferApps_nosat mode hs_ty fun hs_args +tcInferTyApps mode hs_ty fun hs_args + = do { (f_args, res_k) <- tcInferTyApps_nosat mode hs_ty fun hs_args ; saturateFamApp f_args res_k } -tcInferApps_nosat mode orig_hs_ty fun orig_hs_args - = do { traceTc "tcInferApps {" (ppr orig_hs_ty $$ ppr orig_hs_args) +tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args + = do { traceTc "tcInferTyApps {" (ppr orig_hs_ty $$ ppr orig_hs_args) ; (f_args, res_k) <- go_init 1 fun orig_hs_args - ; traceTc "tcInferApps }" (ppr f_args <+> dcolon <+> ppr res_k) + ; traceTc "tcInferTyApps }" (ppr f_args <+> dcolon <+> ppr res_k) ; return (f_args, res_k) } where @@ -1205,21 +1365,18 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args Anon InvisArg _ -> instantiate ki_binder inner_ki Named (Bndr _ Specified) -> -- Visible kind application - do { traceTc "tcInferApps (vis kind app)" + do { traceTc "tcInferTyApps (vis kind app)" (vcat [ ppr ki_binder, ppr hs_ki_arg , ppr (tyBinderType ki_binder) , ppr subst ]) ; let exp_kind = substTy subst $ tyBinderType ki_binder - + ; arg_mode <- mkHoleMode KindLevel HM_VTA + -- HM_VKA: see Note [Wildcards in visible kind application] ; ki_arg <- addErrCtxt (funAppCtxt orig_hs_ty hs_ki_arg n) $ - unsetWOptM Opt_WarnPartialTypeSignatures $ - setXOptM LangExt.PartialTypeSignatures $ - -- Urgh! see Note [Wildcards in visible kind application] - -- ToDo: must kill this ridiculous messing with DynFlags - tc_lhs_type (kindLevel mode) hs_ki_arg exp_kind + tc_lhs_type arg_mode hs_ki_arg exp_kind - ; traceTc "tcInferApps (vis kind app)" (ppr exp_kind) + ; traceTc "tcInferTyApps (vis kind app)" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder ki_arg ; go (n+1) fun' subst' inner_ki hs_args } @@ -1241,7 +1398,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args -- "normal" case | otherwise - -> do { traceTc "tcInferApps (vis normal app)" + -> do { traceTc "tcInferTyApps (vis normal app)" (vcat [ ppr ki_binder , ppr arg , ppr (tyBinderType ki_binder) @@ -1249,7 +1406,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args ; let exp_kind = substTy subst $ tyBinderType ki_binder ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ tc_lhs_type mode arg exp_kind - ; traceTc "tcInferApps (vis normal app) 2" (ppr exp_kind) + ; traceTc "tcInferTyApps (vis normal app) 2" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder arg' ; go (n+1) fun' subst' inner_ki args } @@ -1263,7 +1420,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args -- This zonk is essential, to expose the fruits -- of matchExpectedFunKind to the 'go' loop - ; traceTc "tcInferApps (no binder)" $ + ; traceTc "tcInferTyApps (no binder)" $ vcat [ ppr fun <+> dcolon <+> ppr fun_ki , ppr arrows_needed , ppr co @@ -1272,7 +1429,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args -- Use go_init to establish go's INVARIANT where instantiate ki_binder inner_ki - = do { traceTc "tcInferApps (need to instantiate)" + = do { traceTc "tcInferTyApps (need to instantiate)" (vcat [ ppr ki_binder, ppr subst]) ; (subst', arg') <- tcInstInvisibleTyBinder subst ki_binder ; go n (mkAppTy fun arg') subst' inner_ki all_args } @@ -1375,7 +1532,7 @@ The way in which tcTypeKind can crash is in applications if 'a' is a type variable whose kind doesn't have enough arrows or foralls. (The crash is in piResultTys.) -The loop in tcInferApps has to be very careful to maintain the (PKTI). +The loop in tcInferTyApps has to be very careful to maintain the (PKTI). For example, suppose kappa is a unification variable We have already unified kappa := Type @@ -1387,7 +1544,7 @@ If we call tcTypeKind on that, we'll crash, because the (un-zonked) kind of 'a' is just kappa, not an arrow kind. So we must zonk first. So the type inference engine is very careful when building applications. -This happens in tcInferApps. Suppose we are kind-checking the type (a Int), +This happens in tcInferTyApps. Suppose we are kind-checking the type (a Int), where (a :: kappa). Then in tcInferApps we'll run out of binders on a's kind, so we'll call matchExpectedFunKind, and unify kappa := kappa1 -> kappa2, with evidence co :: kappa ~ (kappa1 ~ kappa2) @@ -1530,10 +1687,10 @@ tcHsMbContext Nothing = return [] tcHsMbContext (Just cxt) = tcHsContext cxt tcHsContext :: LHsContext GhcRn -> TcM [PredType] -tcHsContext = tc_hs_context typeLevelMode +tcHsContext cxt = tc_hs_context (mkMode TypeLevel) cxt tcLHsPredType :: LHsType GhcRn -> TcM PredType -tcLHsPredType = tc_lhs_pred typeLevelMode +tcLHsPredType pred = tc_lhs_pred (mkMode TypeLevel) pred tc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType] tc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt) @@ -1553,7 +1710,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ATcTyCon tc_tc -> do { -- See Note [GADT kind self-reference] - unless (isTypeLevel (mode_level mode)) + unless (isTypeLevel (mode_tyki mode)) (promotionErr name TyConPE) ; check_tc tc_tc ; return (mkTyConTy tc_tc, tyConKind tc_tc) } @@ -1584,7 +1741,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon where check_tc :: TyCon -> TcM () check_tc tc = do { data_kinds <- xoptM LangExt.DataKinds - ; unless (isTypeLevel (mode_level mode) || + ; unless (isTypeLevel (mode_tyki mode) || data_kinds || isKindTyCon tc) $ promotionErr name NoDataKindsTC } @@ -1731,8 +1888,6 @@ in the e2 example, we'll desugar the type, zonking the kind unification variables as we go. When we encounter the unconstrained kappa, we want to default it to '*', not to (Any *). -Help functions for type applications -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -} addTypeCtxt :: LHsType GhcRn -> TcM a -> TcM a @@ -1744,98 +1899,12 @@ addTypeCtxt (L _ ty) thing where doc = text "In the type" <+> quotes (ppr ty) -{- -************************************************************************ + +{- ********************************************************************* * * Type-variable binders -%* * -%************************************************************************ - -Note [Keeping implicitly quantified variables in order] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When the user implicitly quantifies over variables (say, in a type -signature), we need to come up with some ordering on these variables. -This is done by bumping the TcLevel, bringing the tyvars into scope, -and then type-checking the thing_inside. The constraints are all -wrapped in an implication, which is then solved. Finally, we can -zonk all the binders and then order them with scopedSort. - -It's critical to solve before zonking and ordering in order to uncover -any unifications. You might worry that this eager solving could cause -trouble elsewhere. I don't think it will. Because it will solve only -in an increased TcLevel, it can't unify anything that was mentioned -elsewhere. Additionally, we require that the order of implicitly -quantified variables is manifest by the scope of these variables, so -we're not going to learn more information later that will help order -these variables. - -Note [Recipe for checking a signature] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Checking a user-written signature requires several steps: - - 1. Generate constraints. - 2. Solve constraints. - 3. Promote tyvars and/or kind-generalize. - 4. Zonk. - 5. Check validity. - -There may be some surprises in here: - -Step 2 is necessary for two reasons: most signatures also bring -implicitly quantified variables into scope, and solving is necessary -to get these in the right order (see Note [Keeping implicitly -quantified variables in order]). Additionally, solving is necessary in -order to kind-generalize correctly: otherwise, we do not know which -metavariables are left unsolved. - -Step 3 is done by a call to candidateQTyVarsOfType, followed by a call to -kindGeneralize{All,Some,None}. Here, we have to deal with the fact that -metatyvars generated in the type may have a bumped TcLevel, because explicit -foralls raise the TcLevel. To avoid these variables from ever being visible in -the surrounding context, we must obey the following dictum: - - Every metavariable in a type must either be - (A) generalized, or - (B) promoted, or See Note [Promotion in signatures] - (C) a cause to error See Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType - -The kindGeneralize functions do not require pre-zonking; they zonk as they -go. - -If you are actually doing kind-generalization, you need to bump the level -before generating constraints, as we will only generalize variables with -a TcLevel higher than the ambient one. - -After promoting/generalizing, we need to zonk again because both -promoting and generalizing fill in metavariables. - -Note [Promotion in signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If an unsolved metavariable in a signature is not generalized -(because we're not generalizing the construct -- e.g., pattern -sig -- or because the metavars are constrained -- see kindGeneralizeSome) -we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables] -in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing -and the reinstantiating with a fresh metavariable at the current level. -So in some sense, we generalize *all* variables, but then re-instantiate -some of them. - -Here is an example of why we must promote: - foo (x :: forall a. a -> Proxy b) = ... - -In the pattern signature, `b` is unbound, and will thus be brought into -scope. We do not know its kind: it will be assigned kappa[2]. Note that -kappa is at TcLevel 2, because it is invented under a forall. (A priori, -the kind kappa might depend on `a`, so kappa rightly has a higher TcLevel -than the surrounding context.) This kappa cannot be solved for while checking -the pattern signature (which is not kind-generalized). When we are checking -the *body* of foo, though, we need to unify the type of x with the argument -type of bar. At this point, the ambient TcLevel is 1, and spotting a -matavariable with level 2 would violate the (WantedTvInv) invariant of -Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing, -we promote the metavariable to level 1. This is all done in kindGeneralizeNone. - --} +* * +********************************************************************* -} tcNamedWildCardBinders :: [Name] -> ([(Name, TcTyVar)] -> TcM a) @@ -1844,22 +1913,119 @@ tcNamedWildCardBinders :: [Name] -- plain wildcards _ are anonymous and dealt with by HsWildCardTy -- Soe Note [The wildcard story for types] in GHC.Hs.Types tcNamedWildCardBinders wc_names thing_inside - = do { wcs <- mapM (const newWildTyVar) wc_names + = do { wcs <- mapM newNamedWildTyVar wc_names ; let wc_prs = wc_names `zip` wcs ; tcExtendNameTyVarEnv wc_prs $ thing_inside wc_prs } -newWildTyVar :: TcM TcTyVar +newNamedWildTyVar :: Name -> TcM TcTyVar -- ^ New unification variable '_' for a wildcard -newWildTyVar +newNamedWildTyVar _name -- Currently ignoring the "_x" wildcard name used in the type = do { kind <- newMetaKindVar - ; uniq <- newUnique ; details <- newMetaDetails TauTv - ; let name = mkSysTvName uniq (fsLit "_") - tyvar = mkTcTyVar name kind details + ; wc_name <- newMetaTyVarName (fsLit "w") -- See Note [Wildcard names] + ; let tyvar = mkTcTyVar wc_name kind details ; traceTc "newWildTyVar" (ppr tyvar) ; return tyvar } +--------------------------- +tcAnonWildCardOcc :: TcTyMode -> HsType GhcRn -> Kind -> TcM TcType +tcAnonWildCardOcc (TcTyMode { mode_holes = Just (hole_lvl, hole_mode) }) + ty exp_kind + -- hole_lvl: see Note [Checking partial type signatures] + -- esp the bullet on nested forall types + = do { kv_details <- newTauTvDetailsAtLevel hole_lvl + ; kv_name <- newMetaTyVarName (fsLit "k") + ; wc_details <- newTauTvDetailsAtLevel hole_lvl + ; wc_name <- newMetaTyVarName (fsLit wc_nm) + ; let kv = mkTcTyVar kv_name liftedTypeKind kv_details + wc_kind = mkTyVarTy kv + wc_tv = mkTcTyVar wc_name wc_kind wc_details + + ; traceTc "tcAnonWildCardOcc" (ppr hole_lvl <+> ppr emit_holes) + ; when emit_holes $ + emitAnonTypeHole wc_tv + -- Why the 'when' guard? + -- See Note [Wildcards in visible kind application] + + -- You might think that this would always just unify + -- wc_kind with exp_kind, so we could avoid even creating kv + -- But the level numbers might not allow that unification, + -- so we have to do it properly (T14140a) + ; checkExpectedKind ty (mkTyVarTy wc_tv) wc_kind exp_kind } + where + -- See Note [Wildcard names] + wc_nm = case hole_mode of + HM_Sig -> "w" + HM_FamPat -> "_" + HM_VTA -> "w" + + emit_holes = case hole_mode of + HM_Sig -> True + HM_FamPat -> False + HM_VTA -> False + +tcAnonWildCardOcc mode ty _ +-- mode_holes is Nothing. Should not happen, because renamer +-- should already have rejected holes in unexpected places + = pprPanic "tcWildCardOcc" (ppr mode $$ ppr ty) + +{- Note [Wildcard names] +~~~~~~~~~~~~~~~~~~~~~~~~ +So we hackily use the mode_holes flag to control the name used +for wildcards: + +* For proper holes (whether in a visible type application (VTA) or no), + we rename the '_' to 'w'. This is so that we see variables like 'w0' + or 'w1' in error messages, a vast improvement upon '_0' and '_1'. For + example, we prefer + Found type wildcard ‘_’ standing for ‘w0’ + over + Found type wildcard ‘_’ standing for ‘_1’ + + Even in the VTA case, where we do not emit an error to be printed, we + want to do the renaming, as the variables may appear in other, + non-wildcard error messages. + +* However, holes in the left-hand sides of type families ("type + patterns") stand for type variables which we do not care to name -- + much like the use of an underscore in an ordinary term-level + pattern. When we spot these, we neither wish to generate an error + message nor to rename the variable. We don't rename the variable so + that we can pretty-print a type family LHS as, e.g., + F _ Int _ = ... + and not + F w1 Int w2 = ... + + See also Note [Wildcards in family instances] in + GHC.Rename.Module. The choice of HM_FamPat is made in + tcFamTyPats. There is also some unsavory magic, relying on that + underscore, in GHC.Core.Coercion.tidyCoAxBndrsForUser. + +Note [Wildcards in visible kind application] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are cases where users might want to pass in a wildcard as a visible kind +argument, for instance: + +data T :: forall k1 k2. k1 → k2 → Type where + MkT :: T a b +x :: T @_ @Nat False n +x = MkT + +So we should allow '@_' without emitting any hole constraints, and +regardless of whether PartialTypeSignatures is enabled or not. But how +would the typechecker know which '_' is being used in VKA and which is +not when it calls emitNamedTypeHole in +tcHsPartialSigType on all HsWildCardBndrs? The solution is to neither +rename nor include unnamed wildcards in HsWildCardBndrs, but instead +give every anonymous wildcard a fresh wild tyvar in tcAnonWildCardOcc. + +And whenever we see a '@', we set mode_holes to HM_VKA, so that +we do not call emitAnonTypeHole in tcAnonWildCardOcc. +See related Note [Wildcards in visible type application] here and +Note [The wildcard story for types] in GHC.Hs.Types +-} + {- ********************************************************************* * * Kind inference for type declarations @@ -2703,8 +2869,17 @@ bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv -> TcM a -> TcM ([VarBndr TyVar flag], a) -bindExplicitTKBndrs_Skol = bindExplicitTKBndrsX (tcHsTyVarBndr newSkolemTyVar) -bindExplicitTKBndrs_Tv = bindExplicitTKBndrsX (tcHsTyVarBndr cloneTyVarTyVar) +bindExplicitTKBndrs_Skol_M, bindExplicitTKBndrs_Tv_M + :: (OutputableBndrFlag flag) + => TcTyMode + -> [LHsTyVarBndr flag GhcRn] + -> TcM a + -> TcM ([VarBndr TyVar flag], a) + +bindExplicitTKBndrs_Skol = bindExplicitTKBndrsX (tcHsTyVarBndr (mkMode KindLevel) newSkolemTyVar) +bindExplicitTKBndrs_Skol_M mode = bindExplicitTKBndrsX (tcHsTyVarBndr (kindLevel mode) newSkolemTyVar) +bindExplicitTKBndrs_Tv = bindExplicitTKBndrsX (tcHsTyVarBndr (mkMode KindLevel) cloneTyVarTyVar) +bindExplicitTKBndrs_Tv_M mode = bindExplicitTKBndrsX (tcHsTyVarBndr (kindLevel mode) cloneTyVarTyVar) -- newSkolemTyVar: see Note [Non-cloning for tyvar binders] -- cloneTyVarTyVar: see Note [Cloning for tyvar binders] @@ -2752,13 +2927,13 @@ bindExplicitTKBndrsX tc_tv hs_tvs thing_inside ; return ((Bndr tv (hsTyVarBndrFlag hs_tv)):tvs, res) } ----------------- -tcHsTyVarBndr :: (Name -> Kind -> TcM TyVar) +tcHsTyVarBndr :: TcTyMode -> (Name -> Kind -> TcM TyVar) -> HsTyVarBndr flag GhcRn -> TcM TcTyVar -tcHsTyVarBndr new_tv (UserTyVar _ _ (L _ tv_nm)) +tcHsTyVarBndr _ new_tv (UserTyVar _ _ (L _ tv_nm)) = do { kind <- newMetaKindVar ; new_tv tv_nm kind } -tcHsTyVarBndr new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind) - = do { kind <- tcLHsKindSig (TyVarBndrKindCtxt tv_nm) lhs_kind +tcHsTyVarBndr mode new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind) + = do { kind <- tc_lhs_kind_sig mode (TyVarBndrKindCtxt tv_nm) lhs_kind ; new_tv tv_nm kind } ----------------- @@ -2861,15 +3036,14 @@ kindGeneralizeSome should_gen kind_or_type ; let (to_promote, dvs') = partitionCandidates dvs (not . should_gen) - ; (_, promoted) <- promoteTyVarSet (dVarSetToVarSet to_promote) + ; _ <- promoteTyVarSet to_promote ; qkvs <- quantifyTyVars dvs' ; traceTc "kindGeneralizeSome }" $ vcat [ text "Kind or type:" <+> ppr kind_or_type , text "dvs:" <+> ppr dvs , text "dvs':" <+> ppr dvs' - , text "to_promote:" <+> pprTyVars (dVarSetElems to_promote) - , text "promoted:" <+> pprTyVars (nonDetEltsUniqSet promoted) + , text "to_promote:" <+> ppr to_promote , text "qkvs:" <+> pprTyVars qkvs ] ; return qkvs } @@ -3046,6 +3220,7 @@ data DataSort checkDataKindSig :: DataSort -> Kind -> TcM () checkDataKindSig data_sort kind = do dflags <- getDynFlags + traceTc "checkDataKindSig" (ppr kind) checkTc (is_TYPE_or_Type dflags || is_kind_var) (err_msg dflags) where pp_dec :: SDoc @@ -3211,19 +3386,20 @@ tcHsPartialSigType ctxt sig_ty , hsib_body = hs_ty } <- ib_ty , (explicit_hs_tvs, L _ hs_ctxt, hs_tau) <- splitLHsSigmaTyInvis hs_ty = addSigCtxt ctxt hs_ty $ - do { (implicit_tvs, (explicit_tvbndrs, (wcs, wcx, theta, tau))) + do { mode <- mkHoleMode TypeLevel HM_Sig + ; (implicit_tvs, (explicit_tvbndrs, (wcs, wcx, theta, tau))) <- solveLocalEqualities "tcHsPartialSigType" $ - -- This solveLocalEqualiltes fails fast if there are - -- insoluble equalities. See GHC.Tc.Solver - -- Note [Fail fast if there are insoluble kind equalities] + -- See Note [Failure in local type signatures] tcNamedWildCardBinders sig_wcs $ \ wcs -> - bindImplicitTKBndrs_Tv implicit_hs_tvs $ - bindExplicitTKBndrs_Tv explicit_hs_tvs $ + bindImplicitTKBndrs_Tv implicit_hs_tvs $ + bindExplicitTKBndrs_Tv_M mode explicit_hs_tvs $ do { -- Instantiate the type-class context; but if there -- is an extra-constraints wildcard, just discard it here - (theta, wcx) <- tcPartialContext hs_ctxt + (theta, wcx) <- tcPartialContext mode hs_ctxt - ; tau <- tcHsOpenType hs_tau + ; ek <- newOpenTypeKind + ; tau <- addTypeCtxt hs_tau $ + tc_lhs_type mode hs_tau ek ; return (wcs, wcx, theta, tau) } @@ -3241,10 +3417,12 @@ tcHsPartialSigType ctxt sig_ty ; mapM_ emitNamedTypeHole wcs -- Zonk, so that any nested foralls can "see" their occurrences - -- See Note [Checking partial type signatures], in - -- the bullet on Nested foralls. - ; theta <- mapM zonkTcType theta - ; tau <- zonkTcType tau + -- See Note [Checking partial type signatures], and in particular + -- Note [Levels for wildcards] + ; implicit_tvbndrs <- mapM zonkInvisTVBinder implicit_tvbndrs + ; explicit_tvbndrs <- mapM zonkInvisTVBinder explicit_tvbndrs + ; theta <- mapM zonkTcType theta + ; tau <- zonkTcType tau -- We return a proper (Name,InvisTVBinder) environment, to be sure that -- we bring the right name into scope in the function body. @@ -3259,16 +3437,16 @@ tcHsPartialSigType ctxt sig_ty ; traceTc "tcHsPartialSigType" (ppr tv_prs) ; return (wcs, wcx, tv_prs, theta, tau) } -tcPartialContext :: HsContext GhcRn -> TcM (TcThetaType, Maybe TcType) -tcPartialContext hs_theta +tcPartialContext :: TcTyMode -> HsContext GhcRn -> TcM (TcThetaType, Maybe TcType) +tcPartialContext mode hs_theta | Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta - , L wc_loc wc@(HsWildCardTy _) <- ignoreParens hs_ctxt_last + , L wc_loc ty@(HsWildCardTy _) <- ignoreParens hs_ctxt_last = do { wc_tv_ty <- setSrcSpan wc_loc $ - tcAnonWildCardOcc wc constraintKind - ; theta <- mapM tcLHsPredType hs_theta1 + tcAnonWildCardOcc mode ty constraintKind + ; theta <- mapM (tc_lhs_pred mode) hs_theta1 ; return (theta, Just wc_tv_ty) } | otherwise - = do { theta <- mapM tcLHsPredType hs_theta + = do { theta <- mapM (tc_lhs_pred mode) hs_theta ; return (theta, Nothing) } {- Note [Checking partial type signatures] @@ -3312,29 +3490,48 @@ we do the following g x = True It's really as if we'd written two distinct signatures. -* Nested foralls. Consider - f :: forall b. (forall a. a -> _) -> b - We do /not/ allow the "_" to be instantiated to 'a'; but we do - (as before) allow it to be instantiated to the (top level) 'b'. - Why not? Because suppose - f x = (x True, x 'c') - We must instantiate that (forall a. a -> _) when typechecking - f's body, so we must know precisely where all the a's are; they - must not be hidden under (filled-in) unification variables! - - We achieve this in the usual way: we push a level at a forall, - so now the unification variable for the "_" can't unify with - 'a'. - -* Just as for ordinary signatures, we must zonk the type after - kind-checking it, to ensure that all the nested forall binders can - see their occurrenceds +* Nested foralls. See Note [Levels for wildcards] + +* Just as for ordinary signatures, we must solve local equalities and + zonk the type after kind-checking it, to ensure that all the nested + forall binders can "see" their occurrenceds Just as for ordinary signatures, this zonk also gets any Refl casts out of the way of instantiation. Example: #18008 had foo :: (forall a. (Show a => blah) |> Refl) -> _ and that Refl cast messed things up. See #18062. +Note [Levels for wildcards] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f :: forall b. (forall a. a -> _) -> b +We do /not/ allow the "_" to be instantiated to 'a'; although we do +(as before) allow it to be instantiated to the (top level) 'b'. +Why not? Suppose + f x = (x True, x 'c') + +During typecking the RHS we must instantiate that (forall a. a -> _), +so we must know /precisely/ where all the a's are; they must not be +hidden under (possibly-not-yet-filled-in) unification variables! + +We achieve this as follows: + +- For /named/ wildcards such sas + g :: forall b. (forall la. a -> _x) -> b + there is no problem: we create them at the outer level (ie the + ambient level of teh signature itself), and push the level when we + go inside a forall. So now the unification variable for the "_x" + can't unify with skolem 'a'. + +- For /anonymous/ wildcards, such as 'f' above, we carry the ambient + level of the signature to the hole in the TcLevel part of the + mode_holes field of TcTyMode. Then, in tcAnonWildCardOcc we us that + level (and /not/ the level ambient at the occurrence of "_") to + create the unification variable for the wildcard. That is the sole + purpose of the TcLevel in the mode_holes field: to transport the + ambient level of the signature down to the anonymous wildcard + occurrences. + Note [Extra-constraint holes in partial type signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -3399,14 +3596,16 @@ tcHsPatSigType ctxt , hsps_body = hs_ty }) = addSigCtxt ctxt hs_ty $ do { sig_tkv_prs <- mapM new_implicit_tv sig_ns + ; mode <- mkHoleMode TypeLevel HM_Sig ; (wcs, sig_ty) - <- solveLocalEqualities "tcHsPatSigType" $ - -- Always solve local equalities if possible, - -- else casts get in the way of deep skolemisation - -- (#16033) + <- addTypeCtxt hs_ty $ + solveLocalEqualities "tcHsPatSigType" $ + -- See Note [Failure in local type signatures] + -- and c.f #16033 tcNamedWildCardBinders sig_wcs $ \ wcs -> tcExtendNameTyVarEnv sig_tkv_prs $ - do { sig_ty <- tcHsOpenType hs_ty + do { ek <- newOpenTypeKind + ; sig_ty <- tc_lhs_type mode hs_ty ek ; return (wcs, sig_ty) } ; mapM_ emitNamedTypeHole wcs @@ -3509,10 +3708,15 @@ It does sort checking and desugaring at the same time, in one single pass. tcLHsKindSig :: UserTypeCtxt -> LHsKind GhcRn -> TcM Kind tcLHsKindSig ctxt hs_kind + = tc_lhs_kind_sig (mkMode KindLevel) ctxt hs_kind + +tc_lhs_kind_sig :: TcTyMode -> UserTypeCtxt -> LHsKind GhcRn -> TcM Kind +tc_lhs_kind_sig mode ctxt hs_kind -- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType -- Result is zonked - = do { kind <- solveLocalEqualities "tcLHsKindSig" $ - tc_lhs_kind kindLevelMode hs_kind + = do { kind <- addErrCtxt (text "In the kind" <+> quotes (ppr hs_kind)) $ + solveLocalEqualities "tcLHsKindSig" $ + tc_lhs_type mode hs_kind liftedTypeKind ; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind) -- No generalization: ; kindGeneralizeNone kind @@ -3528,11 +3732,6 @@ tcLHsKindSig ctxt hs_kind ; traceTc "tcLHsKindSig2" (ppr kind) ; return kind } -tc_lhs_kind :: TcTyMode -> LHsKind GhcRn -> TcM Kind -tc_lhs_kind mode k - = addErrCtxt (text "In the kind" <+> quotes (ppr k)) $ - tc_lhs_type (kindLevel mode) k liftedTypeKind - promotionErr :: Name -> PromotionErr -> TcM a promotionErr name err = failWithTc (hang (pprPECategory err <+> quotes (ppr name) <+> text "cannot be used here") diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index 350be10236..b9eaad4adb 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -36,9 +36,10 @@ where import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRhoNC, tcInferRho - , tcCheckId, tcLExpr, tcLExprNC, tcExpr - , tcCheckExpr ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC + , tcMonoExpr, tcMonoExprNC, tcExpr + , tcCheckMonoExpr, tcCheckMonoExprNC + , tcCheckPolyExpr, tcCheckId ) import GHC.Types.Basic (LexicalFixity(..)) import GHC.Hs @@ -79,17 +80,11 @@ import Control.Arrow ( second ) @FunMonoBind@. The second argument is the name of the function, which is used in error messages. It checks that all the equations have the same number of arguments before using @tcMatches@ to do the work. - -Note [Polymorphic expected type for tcMatchesFun] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -tcMatchesFun may be given a *sigma* (polymorphic) type -so it must be prepared to use tcSkolemise to skolemise it. -See Note [sig_tau may be polymorphic] in GHC.Tc.Gen.Pat. -} tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn) - -> ExpSigmaType -- Expected type of function + -> ExpRhoType -- Expected type of function -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId)) -- Returns type of body tcMatchesFun fn@(L _ fun_name) matches exp_ty @@ -102,20 +97,17 @@ tcMatchesFun fn@(L _ fun_name) matches exp_ty traceTc "tcMatchesFun" (ppr fun_name $$ ppr exp_ty) ; checkArgs fun_name matches - ; (wrap_gen, (wrap_fun, group)) - <- tcSkolemiseET (FunSigCtxt fun_name True) exp_ty $ \ exp_rho -> - -- Note [Polymorphic expected type for tcMatchesFun] - do { (matches', wrap_fun) - <- matchExpectedFunTys herald arity exp_rho $ - \ pat_tys rhs_ty -> - tcMatches match_ctxt pat_tys rhs_ty matches - ; return (wrap_fun, matches') } - ; return (wrap_gen <.> wrap_fun, group) } + ; matchExpectedFunTys herald ctxt arity exp_ty $ \ pat_tys rhs_ty -> + -- NB: exp_type may be polymorphic, but + -- matchExpectedFunTys can cope with that + tcMatches match_ctxt pat_tys rhs_ty matches } where - arity = matchGroupArity matches + arity = matchGroupArity matches herald = text "The equation(s) for" <+> quotes (ppr fun_name) <+> text "have" - what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness } + ctxt = GenSigCtxt -- Was: FunSigCtxt fun_name True + -- But that's wrong for f :: Int -> forall a. blah + what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness } match_ctxt = MC { mc_what = what, mc_body = tcBody } strictness | [L _ match] <- unLoc $ mg_alts matches @@ -144,10 +136,10 @@ tcMatchesCase ctxt scrut_ty matches res_ty tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify -> TcMatchCtxt HsExpr -> MatchGroup GhcRn (LHsExpr GhcRn) - -> ExpRhoType -- deeply skolemised - -> TcM (MatchGroup GhcTcId (LHsExpr GhcTcId), HsWrapper) + -> ExpRhoType + -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId)) tcMatchLambda herald match_ctxt match res_ty - = matchExpectedFunTys herald n_pats res_ty $ \ pat_tys rhs_ty -> + = matchExpectedFunTys herald GenSigCtxt n_pats res_ty $ \ pat_tys rhs_ty -> tcMatches match_ctxt pat_tys rhs_ty match where n_pats | isEmptyMatchGroup match = 1 -- must be lambda-case @@ -332,7 +324,7 @@ tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt) tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTcId) tcBody body res_ty = do { traceTc "tcBody" (ppr res_ty) - ; tcLExpr body res_ty + ; tcMonoExpr body res_ty } {- @@ -412,7 +404,7 @@ tcStmtsAndThen ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside tcGuardStmt :: TcExprStmtChecker tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside - = do { guard' <- tcLExpr guard (mkCheckExpType boolTy) + = do { guard' <- tcCheckMonoExpr guard boolTy ; thing <- thing_inside res_ty ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } @@ -445,21 +437,21 @@ tcLcStmt :: TyCon -- The list type constructor ([]) -> TcExprStmtChecker tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside - = do { body' <- tcLExprNC body elt_ty + = do { body' <- tcMonoExprNC body elt_ty ; thing <- thing_inside (panic "tcLcStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } -- A generator, pat <- rhs tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside = do { pat_ty <- newFlexiTyVarTy liftedTypeKind - ; rhs' <- tcLExpr rhs (mkCheckExpType $ mkTyConApp m_tc [pat_ty]) + ; rhs' <- tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty]) ; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $ thing_inside elt_ty ; return (mkTcBindStmt pat' rhs', thing) } -- A boolean guard tcLcStmt _ _ (BodyStmt _ rhs _ _) elt_ty thing_inside - = do { rhs' <- tcLExpr rhs (mkCheckExpType boolTy) + = do { rhs' <- tcCheckMonoExpr rhs boolTy ; thing <- thing_inside elt_ty ; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) } @@ -517,7 +509,7 @@ tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts by_arrow $ poly_arg_ty `mkVisFunTy` poly_res_ty - ; using' <- tcCheckExpr using using_poly_ty + ; using' <- tcCheckPolyExpr using using_poly_ty ; let final_using = fmap (mkHsWrap (WpTyApp tup_ty)) using' -- 'stmts' returns a result of type (m1_ty tuple_ty), @@ -559,7 +551,7 @@ tcMcStmt _ (LastStmt x body noret return_op) res_ty thing_inside = do { (body', return_op') <- tcSyntaxOp MCompOrigin return_op [SynRho] res_ty $ \ [a_ty] -> - tcLExprNC body (mkCheckExpType a_ty) + tcCheckMonoExprNC body a_ty ; thing <- thing_inside (panic "tcMcStmt: thing_inside") ; return (LastStmt x body' noret return_op', thing) } @@ -575,7 +567,7 @@ tcMcStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside <- tcSyntaxOp MCompOrigin (xbsrn_bindOp xbsrn) [SynRho, SynFun SynAny SynRho] res_ty $ \ [rhs_ty, pat_ty, new_res_ty] -> - do { rhs' <- tcLExprNC rhs (mkCheckExpType rhs_ty) + do { rhs' <- tcCheckMonoExprNC rhs rhs_ty ; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $ thing_inside (mkCheckExpType new_res_ty) ; return (rhs', pat', thing, new_res_ty) } @@ -607,7 +599,7 @@ tcMcStmt _ (BodyStmt _ rhs then_op guard_op) res_ty thing_inside <- tcSyntaxOp MCompOrigin guard_op [SynAny] (mkCheckExpType rhs_ty) $ \ [test_ty] -> - tcLExpr rhs (mkCheckExpType test_ty) + tcCheckMonoExpr rhs test_ty ; thing <- thing_inside (mkCheckExpType new_res_ty) ; return (thing, rhs', rhs_ty, guard_op') } ; return (BodyStmt rhs_ty rhs' then_op' guard_op', thing) } @@ -667,8 +659,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap (mkCheckExpType using_arg_ty) $ \res_ty' -> do { by' <- case by of Nothing -> return Nothing - Just e -> do { e' <- tcLExpr e - (mkCheckExpType by_e_ty) + Just e -> do { e' <- tcCheckMonoExpr e by_e_ty ; return (Just e') } -- Find the Ids (and hence types) of all old binders @@ -693,7 +684,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap --------------- Typecheck the 'fmap' function ------------- ; fmap_op' <- case form of ThenForm -> return noExpr - _ -> fmap unLoc . tcCheckExpr (noLoc fmap_op) $ + _ -> fmap unLoc . tcCheckPolyExpr (noLoc fmap_op) $ mkInfForAllTy alphaTyVar $ mkInfForAllTy betaTyVar $ (alphaTy `mkVisFunTy` betaTy) @@ -703,7 +694,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap --------------- Typecheck the 'using' function ------------- -- using :: ((a,b,c)->t) -> m1 (a,b,c) -> m2 (n (a,b,c)) - ; using' <- tcCheckExpr using using_poly_ty + ; using' <- tcCheckPolyExpr using using_poly_ty ; let final_using = fmap (mkHsWrap (WpTyApp tup_ty)) using' --------------- Building the bindersMap ---------------- @@ -765,7 +756,7 @@ tcMcStmt ctxt (ParStmt _ bndr_stmts_s mzip_op bind_op) res_ty thing_inside (m_ty `mkAppTy` betaTy) `mkVisFunTy` (m_ty `mkAppTy` mkBoxedTupleTy [alphaTy, betaTy]) - ; mzip_op' <- unLoc `fmap` tcCheckExpr (noLoc mzip_op) mzip_ty + ; mzip_op' <- unLoc `fmap` tcCheckPolyExpr (noLoc mzip_op) mzip_ty -- type dummies since we don't know all binder types yet ; id_tys_s <- (mapM . mapM) (const (newFlexiTyVarTy liftedTypeKind)) @@ -827,7 +818,7 @@ tcMcStmt _ stmt _ _ tcDoStmt :: TcExprStmtChecker tcDoStmt _ (LastStmt x body noret _) res_ty thing_inside - = do { body' <- tcLExprNC body res_ty + = do { body' <- tcMonoExprNC body res_ty ; thing <- thing_inside (panic "tcDoStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } @@ -840,7 +831,7 @@ tcDoStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside ((rhs', pat', new_res_ty, thing), bind_op') <- tcSyntaxOp DoOrigin (xbsrn_bindOp xbsrn) [SynRho, SynFun SynAny SynRho] res_ty $ \ [rhs_ty, pat_ty, new_res_ty] -> - do { rhs' <- tcLExprNC rhs (mkCheckExpType rhs_ty) + do { rhs' <- tcCheckMonoExprNC rhs rhs_ty ; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $ thing_inside (mkCheckExpType new_res_ty) ; return (rhs', pat', new_res_ty, thing) } @@ -873,7 +864,7 @@ tcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside ; ((rhs', rhs_ty, thing), then_op') <- tcSyntaxOp DoOrigin then_op [SynRho, SynRho] res_ty $ \ [rhs_ty, new_res_ty] -> - do { rhs' <- tcLExprNC rhs (mkCheckExpType rhs_ty) + do { rhs' <- tcCheckMonoExprNC rhs rhs_ty ; thing <- thing_inside (mkCheckExpType new_res_ty) ; return (rhs', rhs_ty, thing) } ; return (BodyStmt rhs_ty rhs' then_op' noSyntaxExpr, thing) } @@ -1043,7 +1034,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside }, pat_ty, exp_ty) = setSrcSpan (combineSrcSpans (getLoc pat) (getLoc rhs)) $ addErrCtxt (pprStmtInCtxt ctxt (mkRnBindStmt pat rhs)) $ - do { rhs' <- tcLExprNC rhs (mkCheckExpType exp_ty) + do { rhs' <- tcCheckMonoExprNC rhs exp_ty ; (pat', _) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $ return () ; fail_op' <- fmap join . forM fail_op $ \fail -> diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index 58f64f84ae..21b5165d5b 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -30,7 +30,7 @@ where import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferSigma ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferRho ) import GHC.Hs import GHC.Tc.Utils.Zonk @@ -406,16 +406,13 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of -- An exotic example: -- pair :: forall a. a -> forall b. b -> (a,b) -- f (pair True -> x) = ...here (x :: forall b. b -> (Bool,b)) - -- - -- TEMPORARY: pending simple subsumption, use tcInferSigma - -- When removing this, remove it from Expr.hs-boot too - ; (expr',expr_ty) <- tcInferSigma expr + ; (expr',expr_ty) <- tcInferRho expr -- Expression must be a function ; let expr_orig = lexprCtOrigin expr herald = text "A view pattern expression expects" ; (expr_wrap1, [inf_arg_ty], inf_res_ty) - <- matchActualFunTys herald expr_orig (Just (unLoc expr)) 1 expr_ty + <- matchActualFunTysRho herald expr_orig (Just (unLoc expr)) 1 expr_ty -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_ty) -- Check that overall pattern is more polymorphic than arg type diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs index c788f15437..63377c74d5 100644 --- a/compiler/GHC/Tc/Gen/Rule.hs +++ b/compiler/GHC/Tc/Gen/Rule.hs @@ -199,7 +199,7 @@ generateRuleConstraints ty_bndrs tm_bndrs lhs rhs do { -- See Note [Solve order for RULES] ((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs) ; (rhs', rhs_wanted) <- captureConstraints $ - tcLExpr rhs (mkCheckExpType rule_ty) + tcCheckMonoExpr rhs rule_ty ; let all_lhs_wanted = bndr_wanted `andWC` lhs_wanted ; return (id_bndrs, lhs', all_lhs_wanted, rhs', rhs_wanted, rule_ty) } } diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs index fb313d9297..2ac2823fb5 100644 --- a/compiler/GHC/Tc/Gen/Sig.hs +++ b/compiler/GHC/Tc/Gen/Sig.hs @@ -635,6 +635,7 @@ to connect the two, something like This wrapper is put in the TcSpecPrag, in the ABExport record of the AbsBinds. + f :: (Eq a, Ix b) => a -> b -> Bool {-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-} f = <poly_rhs> @@ -674,12 +675,13 @@ delicate, but works. Some wrinkles -1. We don't use full-on tcSubType, because that does co and contra - variance and that in turn will generate too complex a LHS for the - RULE. So we use a single invocation of skolemise / - topInstantiate in tcSpecWrapper. (Actually I think that even - the "deeply" stuff may be too much, because it introduces lambdas, - though I think it can be made to work without too much trouble.) +1. In tcSpecWrapper, rather than calling tcSubType, we directly call + skolemise/instantiate. That is mainly because of wrinkle (2). + + Historical note: in the past, tcSubType did co/contra stuff, which + could generate too complex a LHS for the RULE, which was another + reason for not using tcSubType. But that reason has gone away + with simple subsumption (#17775). 2. We need to take care with type families (#5821). Consider type instance F Int = Bool @@ -775,7 +777,7 @@ tcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper -- See Note [Handling SPECIALISE pragmas], wrinkle 1 tcSpecWrapper ctxt poly_ty spec_ty = do { (sk_wrap, inst_wrap) - <- tcSkolemise ctxt spec_ty $ \ _ spec_tau -> + <- tcSkolemise ctxt spec_ty $ \ spec_tau -> do { (inst_wrap, tau) <- topInstantiate orig poly_ty ; _ <- unifyType Nothing spec_tau tau -- Deliberately ignore the evidence diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index aa792ee6b7..766704166d 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -288,7 +288,7 @@ tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) = do { meta_ty <- tcMetaTy meta_ty_name -- Expected type of splice, e.g. m Exp ; let expected_type = mkAppTy m_var meta_ty - ; expr' <- tcCheckExpr expr expected_type + ; expr' <- tcCheckPolyExpr expr expected_type ; return (PendingTcSplice splice_name expr') } where meta_ty_name = case flavour of @@ -618,7 +618,7 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var q@(QuoteWrapper _ m_var)) spl ; meta_exp_ty <- tcTExpTy m_var res_ty ; expr' <- setStage pop_stage $ setConstraintVar lie_var $ - tcLExpr expr (mkCheckExpType meta_exp_ty) + tcCheckMonoExpr expr meta_exp_ty ; untypeq <- tcLookupId unTypeQName ; let expr'' = mkHsApp (mkLHsWrap (applyQuoteWrapper q) @@ -647,7 +647,7 @@ tcTopSplice expr res_ty -- Top level splices must still be of type Q (TExp a) ; meta_exp_ty <- tcTExpTy q_type res_ty ; q_expr <- tcTopSpliceExpr Typed $ - tcLExpr expr (mkCheckExpType meta_exp_ty) + tcCheckMonoExpr expr meta_exp_ty ; lcl_env <- getLclEnv ; let delayed_splice = DelayedSplice lcl_env expr res_ty q_expr @@ -684,7 +684,7 @@ runTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr) captureConstraints $ addErrCtxt (spliceResultDoc zonked_q_expr) $ do { (exp3, _fvs) <- rnLExpr expr2 - ; tcLExpr exp3 (mkCheckExpType zonked_ty)} + ; tcCheckMonoExpr exp3 zonked_ty } ; ev <- simplifyTop wcs ; return $ unLoc (mkHsDictLet (EvBinds ev) res) } @@ -717,7 +717,7 @@ tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc) -- Note that set the level to Splice, regardless of the original level, -- before typechecking the expression. For example: -- f x = $( ...$(g 3) ... ) --- The recursive call to tcCheckExpr will simply expand the +-- The recursive call to tcCheckPolyExpr will simply expand the -- inner escape before dealing with the outer one tcTopSpliceExpr isTypedSplice tc_action @@ -1438,7 +1438,7 @@ reifyInstances th_nm th_tys <- pushTcLevelM_ $ solveEqualities $ -- Avoid error cascade if there are unsolved bindImplicitTKBndrs_Skol tv_names $ - fst <$> tcLHsType rn_ty + tcInferLHsType rn_ty ; ty <- zonkTcTypeToType ty -- Substitute out the meta type variables -- In particular, the type might have kind diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 94402c0989..dab7bc499e 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -1781,11 +1781,11 @@ check_main dflags tcg_env explicit_mod_hdr export_ies ; res_ty <- newFlexiTyVarTy liftedTypeKind ; let io_ty = mkTyConApp ioTyCon [res_ty] skol_info = SigSkol (FunSigCtxt main_name False) io_ty [] + main_expr_rn = L loc (HsVar noExtField (L loc main_name)) ; (ev_binds, main_expr) <- checkConstraints skol_info [] [] $ addErrCtxt mainCtxt $ - tcLExpr (L loc (HsVar noExtField (L loc main_name))) - (mkCheckExpType io_ty) + tcCheckMonoExpr main_expr_rn io_ty -- See Note [Root-main Id] -- Construct the binding @@ -2476,6 +2476,7 @@ data TcRnExprMode = TM_Inst -- ^ Instantiate the type fully (:type) | TM_Default -- ^ Default the type eagerly (:type +d) -- | tcRnExpr just finds the type of an expression +-- for :type tcRnExpr :: HscEnv -> TcRnExprMode -> LHsExpr GhcPs @@ -2590,7 +2591,7 @@ tcRnType hsc_env flexi normalise rdr_type solveEqualities $ tcNamedWildCardBinders wcs $ \ wcs' -> do { mapM_ emitNamedTypeHole wcs' - ; tcLHsTypeUnsaturated rn_type } + ; tcInferLHsTypeUnsaturated rn_type } -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kvs <- kindGeneralizeAll kind @@ -2623,7 +2624,7 @@ considers this example, with -fprint-explicit-foralls enabled: In this mode, we report the type that would be inferred if a variable were assigned to expression e, without applying the monomorphism restriction. - This means we deeply instantiate the type and then regeneralize, as discussed + This means we instantiate the type and then regeneralize, as discussed in #11376. > :type foo @Int diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs index b1017de024..8736206188 100644 --- a/compiler/GHC/Tc/Solver.hs +++ b/compiler/GHC/Tc/Solver.hs @@ -16,8 +16,7 @@ module GHC.Tc.Solver( simpl_top, - promoteTyVar, - promoteTyVarSet, + promoteTyVarSet, emitFlatConstraints, -- For Rules we need these solveWanteds, solveWantedsAndDrop, @@ -65,7 +64,6 @@ import Control.Monad import Data.Foldable ( toList ) import Data.List ( partition ) import Data.List.NonEmpty ( NonEmpty(..) ) -import GHC.Data.Maybe ( isJust ) {- ********************************************************************************* @@ -162,27 +160,143 @@ simplifyTop wanteds -- should generally bump the TcLevel to make sure that this run of the solver -- doesn't affect anything lying around. solveLocalEqualities :: String -> TcM a -> TcM a +-- Note [Failure in local type signatures] solveLocalEqualities callsite thing_inside = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside - ; emitConstraints wanted + ; emitFlatConstraints wanted + ; return res } - -- See Note [Fail fast if there are insoluble kind equalities] - ; when (insolubleWC wanted) $ - failM +emitFlatConstraints :: WantedConstraints -> TcM () +-- See Note [Failure in local type signatures] +emitFlatConstraints wanted + = do { wanted <- TcM.zonkWC wanted + ; case floatKindEqualities wanted of + Nothing -> do { traceTc "emitFlatConstraints: failing" (ppr wanted) + ; emitConstraints wanted -- So they get reported! + ; failM } + Just (simples, holes) + -> do { _ <- promoteTyVarSet (tyCoVarsOfCts simples) + ; traceTc "emitFlatConstraints:" $ + vcat [ text "simples:" <+> ppr simples + , text "holes: " <+> ppr holes ] + ; emitHoles holes -- Holes don't need promotion + ; emitSimples simples } } + +floatKindEqualities :: WantedConstraints -> Maybe (Bag Ct, Bag Hole) +-- Float out all the constraints from the WantedConstraints, +-- Return Nothing if any constraints can't be floated (captured +-- by skolems), or if there is an insoluble constraint, or +-- IC_Telescope telescope error +floatKindEqualities wc = float_wc emptyVarSet wc + where + float_wc :: TcTyCoVarSet -> WantedConstraints -> Maybe (Bag Ct, Bag Hole) + float_wc trapping_tvs (WC { wc_simple = simples + , wc_impl = implics + , wc_holes = holes }) + | all is_floatable simples + = do { (inner_simples, inner_holes) + <- flatMapBagPairM (float_implic trapping_tvs) implics + ; return ( simples `unionBags` inner_simples + , holes `unionBags` inner_holes) } + | otherwise + = Nothing + where + is_floatable ct + | insolubleEqCt ct = False + | otherwise = tyCoVarsOfCt ct `disjointVarSet` trapping_tvs + + float_implic :: TcTyCoVarSet -> Implication -> Maybe (Bag Ct, Bag Hole) + float_implic trapping_tvs (Implic { ic_wanted = wanted, ic_no_eqs = no_eqs + , ic_skols = skols, ic_status = status }) + | isInsolubleStatus status + = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope + | otherwise + = do { (simples, holes) <- float_wc new_trapping_tvs wanted + ; when (not (isEmptyBag simples) && not no_eqs) $ + Nothing + -- If there are some constraints to float out, but we can't + -- because we don't float out past local equalities + -- (c.f GHC.Tc.Solver.approximateWC), then fail + ; return (simples, holes) } + where + new_trapping_tvs = trapping_tvs `extendVarSetList` skols - ; return res } -{- Note [Fail fast if there are insoluble kind equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Rather like in simplifyInfer, fail fast if there is an insoluble -constraint. Otherwise we'll just succeed in kind-checking a nonsense -type, with a cascade of follow-up errors. +{- Note [Failure in local type signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When kind checking a type signature, we like to fail fast if we can't +solve all the kind equality constraints: see Note [Fail fast on kind +errors]. But what about /local/ type signatures, mentioning in-scope +type variables for which there might be given equalities. Here's +an example (T15076b): + + class (a ~ b) => C a b + data SameKind :: k -> k -> Type where { SK :: SameKind a b } + + bar :: forall (a :: Type) (b :: Type). + C a b => Proxy a -> Proxy b -> () + bar _ _ = const () (undefined :: forall (x :: a) (y :: b). SameKind x y) + +Consider the type singature on 'undefined'. It's ill-kinded unless +a~b. But the superclass of (C a b) means that indeed (a~b). So all +should be well. BUT it's hard to see that when kind-checking the signature +for undefined. We want to emit a residual (a~b) constraint, to solve +later. + +Another possiblity is that we might have something like + F alpha ~ [Int] +where alpha is bound further out, which might become soluble +"later" when we learn more about alpha. So we want to emit +those residual constraints. + +BUT it's no good simply wrapping all unsolved constraints from +a type signature in an implication constraint to solve later. The +problem is that we are going to /use/ that signature, including +instantiate it. Say we have + f :: forall a. (forall b. blah) -> blah2 + f x = <body> +To typecheck the definition of f, we have to instantiate those +foralls. Moreover, any unsolved kind equalities will be coercion +holes in the type. If we naively wrap them in an implication like + forall a. (co1:k1~k2, forall b. co2:k3~k4) +hoping to solve it later, we might end up filling in the holes +co1 and co2 with coercions involving 'a' and 'b' -- but by now +we've instantiated the type. Chaos! + +Moreover, the unsolved constraints might be skolem-escpae things, and +if we proceed with f bound to a nonsensical type, we get a cascade of +follow-up errors. For example polykinds/T12593, T15577, and many others. + +So here's the plan: -For example polykinds/T12593, T15577, and many others. +* solveLocalEqualitiesX: try to solve the constraints (solveLocalEqualitiesX) -Take care to ensure that you emit the insoluble constraints before -failing, because they are what will ultimately lead to the error -messsage! +* buildTvImplication: build an implication for the residual, unsolved + constraint + +* emitFlatConstraints: try to float out every unsolved equalities + inside that implication, in the hope that it constrains only global + type variables, not the locally-quantified ones. + + * If we fail, or find an insoluble constraint, emit the implication, + so that the errors will be reported, and fail. + + * If we succeed in floating all the equalities, promote them and + re-emit them as flat constraint, not wrapped at all (since they + don't mention any of the quantified variables. + +* Note that this float-and-promote step means that anonymous + wildcards get floated to top level, as we want; see + Note [Checking partial type signatures] in GHC.Tc.Gen.HsType. + +All this is done: + +* in solveLocalEqualities, where there is no kind-generalisation + to complicate matters. + +* in GHC.Tc.Gen.HsType.tcHsSigType, where quantification intervenes. + +See also #18062, #11506 -} solveLocalEqualitiesX :: String -> TcM a -> TcM (WantedConstraints, a) @@ -867,7 +981,6 @@ mkResidualConstraints rhs_tclvl ev_binds_var return $ unitBag $ implic1 { ic_tclvl = rhs_tclvl , ic_skols = qtvs - , ic_telescope = Nothing , ic_given = full_theta_vars , ic_wanted = inner_wanted , ic_binds = ev_binds_var @@ -1168,7 +1281,7 @@ defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates = do { -- Promote any tyvars that we cannot generalise -- See Note [Promote momomorphic tyvars] ; traceTc "decideMonoTyVars: promotion:" (ppr mono_tvs) - ; (prom, _) <- promoteTyVarSet mono_tvs + ; any_promoted <- promoteTyVarSet mono_tvs -- Default any kind/levity vars ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} @@ -1186,7 +1299,7 @@ defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates ; case () of _ | some_default -> simplify_cand candidates - | prom -> mapM TcM.zonkTcType candidates + | any_promoted -> mapM TcM.zonkTcType candidates | otherwise -> return candidates } where @@ -1789,9 +1902,9 @@ setImplicationStatus implic@(Implic { ic_status = status checkBadTelescope :: Implication -> TcS Bool -- True <=> the skolems form a bad telescope -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint -checkBadTelescope (Implic { ic_telescope = m_telescope - , ic_skols = skols }) - | isJust m_telescope +checkBadTelescope (Implic { ic_info = info + , ic_skols = skols }) + | ForAllSkol {} <- info = do{ skols <- mapM TcS.zonkTyCoVarKind skols ; return (go emptyVarSet (reverse skols))} @@ -2063,7 +2176,7 @@ we'll get more Givens (a unification is like adding a Given) to allow the implication to make progress. -} -promoteTyVar :: TcTyVar -> TcM (Bool, TcTyVar) +promoteTyVar :: TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2075,16 +2188,16 @@ promoteTyVar tv then do { cloned_tv <- TcM.cloneMetaTyVar tv ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl ; TcM.writeMetaTyVar tv (mkTyVarTy rhs_tv) - ; return (True, rhs_tv) } - else return (False, tv) } + ; return True } + else return False } -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM (Bool, TcTyVarSet) +promoteTyVarSet :: TcTyVarSet -> TcM Bool promoteTyVarSet tvs - = do { (bools, tyvars) <- mapAndUnzipM promoteTyVar (nonDetEltsUniqSet tvs) - -- non-determinism is OK because order of promotion doesn't matter + = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs) + -- Non-determinism is OK because order of promotion doesn't matter - ; return (or bools, mkVarSet tyvars) } + ; return (or bools) } promoteTyVarTcS :: TcTyVar -> TcS () -- When we float a constraint out of an implication we must restore @@ -2122,7 +2235,7 @@ approximateWC float_past_equalities wc float_wc :: TcTyCoVarSet -> WantedConstraints -> Cts float_wc trapping_tvs (WC { wc_simple = simples, wc_impl = implics }) = filterBag (is_floatable trapping_tvs) simples `unionBags` - do_bag (float_implic trapping_tvs) implics + concatMapBag (float_implic trapping_tvs) implics where float_implic :: TcTyCoVarSet -> Implication -> Cts @@ -2134,9 +2247,6 @@ approximateWC float_past_equalities wc where new_trapping_tvs = trapping_tvs `extendVarSetList` ic_skols imp - do_bag :: (a -> Bag c) -> Bag a -> Bag c - do_bag f = foldr (unionBags.f) emptyBag - is_floatable skol_tvs ct | isGivenCt ct = False | insolubleEqCt ct = False @@ -2419,21 +2529,20 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs | otherwise = acc -- Identify which equalities are candidates for floating - -- Float out alpha ~ ty, or ty ~ alpha which might be unified outside + -- Float out alpha ~ ty which might be unified outside -- See Note [Which equalities to float] is_float_eq_candidate ct | pred <- ctPred ct , EqPred NomEq ty1 ty2 <- classifyPredType pred - = case (tcGetTyVar_maybe ty1, tcGetTyVar_maybe ty2) of - (Just tv1, _) -> float_tv_eq_candidate tv1 ty2 - (_, Just tv2) -> float_tv_eq_candidate tv2 ty1 - _ -> False - | otherwise = False - - float_tv_eq_candidate tv1 ty2 -- See Note [Which equalities to float] - = isMetaTyVar tv1 - && (not (isTyVarTyVar tv1) || isTyVarTy ty2) + = float_eq ty1 ty2 || float_eq ty2 ty1 + | otherwise + = False + float_eq ty1 ty2 + = case getTyVar_maybe ty1 of + Just tv1 -> isMetaTyVar tv1 + && (not (isTyVarTyVar tv1) || isTyVarTy ty2) + Nothing -> False {- Note [Float equalities from under a skolem binding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2470,6 +2579,12 @@ happen. In particular, float out equalities that are: case, floating out won't help either, and it may affect grouping of error messages. + NB: generally we won't see (ty ~ alpha), with alpha on the right because + of Note [Unification variables on the left] in GHC.Tc.Utils.Unify. + But if we start with (F tys ~ alpha), it will orient as (fmv ~ alpha), + and unflatten back to (F tys ~ alpha). So we must look for alpha on + the right too. Example T4494. + * Nominal. No point in floating (alpha ~R# ty), because we do not unify representational equalities even if alpha is touchable. See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact. diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index 57cf913aa4..1bf603d3fd 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -904,22 +904,23 @@ It is conceivable to do a better job at tracking whether or not a type is flattened, but this is left as future work. (Mar '15) -Note [FunTy and decomposing tycon applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When can_eq_nc' attempts to decompose a tycon application we haven't yet zonked. -This means that we may very well have a FunTy containing a type of some unknown -kind. For instance, we may have, +Note [Decomposing FunTy] +~~~~~~~~~~~~~~~~~~~~~~~~ +can_eq_nc' may attempt to decompose a FunTy that is un-zonked. This +means that we may very well have a FunTy containing a type of some +unknown kind. For instance, we may have, FunTy (a :: k) Int -Where k is a unification variable. tcRepSplitTyConApp_maybe panics in the event -that it sees such a type as it cannot determine the RuntimeReps which the (->) -is applied to. Consequently, it is vital that we instead use -tcRepSplitTyConApp_maybe', which simply returns Nothing in such a case. - -When this happens can_eq_nc' will fail to decompose, zonk, and try again. +Where k is a unification variable. So the calls to getRuntimeRep_maybe may +fail (returning Nothing). In that case we'll fall through, zonk, and try again. Zonking should fill the variable k, meaning that decomposition will succeed the second time around. + +Also note that we require the AnonArgFlag to match. This will stop +us decomposing + (Int -> Bool) ~ (Show a => blah) +It's as if we treat (->) and (=>) as different type constructors. -} canEqNC :: CtEvidence -> EqRel -> Type -> Type -> TcS (StopOrContinue Ct) @@ -1003,13 +1004,26 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ = do { setEvBindIfWanted ev (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } --- Try to decompose type constructor applications --- Including FunTy (s -> t) -can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1 _ ty2 _ - --- See Note [FunTy and decomposing type constructor applications]. - | Just (tc1, tys1) <- repSplitTyConApp_maybe ty1 - , Just (tc2, tys2) <- repSplitTyConApp_maybe ty2 - , not (isTypeFamilyTyCon tc1) +-- Decompose FunTy: (s -> t) and (c => t) +-- NB: don't decompose (Int -> blah) ~ (Show a => blah) +can_eq_nc' _flat _rdr_env _envs ev eq_rel + (FunTy { ft_af = af1, ft_arg = ty1a, ft_res = ty1b }) _ + (FunTy { ft_af = af2, ft_arg = ty2a, ft_res = ty2b }) _ + | af1 == af2 -- Don't decompose (Int -> blah) ~ (Show a => blah) + , Just ty1a_rep <- getRuntimeRep_maybe ty1a -- getRutimeRep_maybe: + , Just ty1b_rep <- getRuntimeRep_maybe ty1b -- see Note [Decomposing FunTy] + , Just ty2a_rep <- getRuntimeRep_maybe ty2a + , Just ty2b_rep <- getRuntimeRep_maybe ty2b + = canDecomposableTyConAppOK ev eq_rel funTyCon + [ty1a_rep, ty1b_rep, ty1a, ty1b] + [ty2a_rep, ty2b_rep, ty2a, ty2b] + +-- Decompose type constructor applications +-- NB: e have expanded type synonyms already +can_eq_nc' _flat _rdr_env _envs ev eq_rel + (TyConApp tc1 tys1) _ + (TyConApp tc2 tys2) _ + | not (isTypeFamilyTyCon tc1) , not (isTypeFamilyTyCon tc2) = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 @@ -1452,15 +1466,13 @@ canTyConApp :: CtEvidence -> EqRel -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) -- See Note [Decomposing TyConApps] +-- Neither tc1 nor tc2 is a saturated funTyCon canTyConApp ev eq_rel tc1 tys1 tc2 tys2 | tc1 == tc2 , tys1 `equalLength` tys2 = do { inerts <- getTcSInerts ; if can_decompose inerts - then do { traceTcS "canTyConApp" - (ppr ev $$ ppr eq_rel $$ ppr tc1 $$ ppr tys1 $$ ppr tys2) - ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - ; stopWith ev "Decomposed TyConApp" } + then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 else canEqFailure ev eq_rel ty1 ty2 } -- See Note [Skolem abstract data] (at tyConSkolem) @@ -1476,6 +1488,10 @@ canTyConApp ev eq_rel tc1 tys1 tc2 tys2 | otherwise = canEqHardFailure ev ty1 ty2 where + -- Reconstruct the types for error messages. This would do + -- the wrong thing (from a pretty printing point of view) + -- for functions, because we've lost the AnonArgFlag; but + -- in fact we never call canTyConApp on a saturated FunTyCon ty1 = mkTyConApp tc1 tys1 ty2 = mkTyConApp tc2 tys2 @@ -1673,30 +1689,35 @@ Conclusion: canDecomposableTyConAppOK :: CtEvidence -> EqRel -> TyCon -> [TcType] -> [TcType] - -> TcS () + -> TcS (StopOrContinue Ct) -- Precondition: tys1 and tys2 are the same length, hence "OK" canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 = ASSERT( tys1 `equalLength` tys2 ) - case ev of - CtDerived {} - -> unifyDeriveds loc tc_roles tys1 tys2 - - CtWanted { ctev_dest = dest } - -- new_locs and tc_roles are both infinite, so - -- we are guaranteed that cos has the same length - -- as tys1 and tys2 - -> do { cos <- zipWith4M unifyWanted new_locs tc_roles tys1 tys2 - ; setWantedEq dest (mkTyConAppCo role tc cos) } - - CtGiven { ctev_evar = evar } - -> do { let ev_co = mkCoVarCo evar - ; given_evs <- newGivenEvVars loc $ - [ ( mkPrimEqPredRole r ty1 ty2 - , evCoercion $ mkNthCo r i ev_co ) - | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..] - , r /= Phantom - , not (isCoercionTy ty1) && not (isCoercionTy ty2) ] - ; emitWorkNC given_evs } + do { traceTcS "canDecomposableTyConAppOK" + (ppr ev $$ ppr eq_rel $$ ppr tc $$ ppr tys1 $$ ppr tys2) + ; case ev of + CtDerived {} + -> unifyDeriveds loc tc_roles tys1 tys2 + + CtWanted { ctev_dest = dest } + -- new_locs and tc_roles are both infinite, so + -- we are guaranteed that cos has the same length + -- as tys1 and tys2 + -> do { cos <- zipWith4M unifyWanted new_locs tc_roles tys1 tys2 + ; setWantedEq dest (mkTyConAppCo role tc cos) } + + CtGiven { ctev_evar = evar } + -> do { let ev_co = mkCoVarCo evar + ; given_evs <- newGivenEvVars loc $ + [ ( mkPrimEqPredRole r ty1 ty2 + , evCoercion $ mkNthCo r i ev_co ) + | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..] + , r /= Phantom + , not (isCoercionTy ty1) && not (isCoercionTy ty2) ] + ; emitWorkNC given_evs } + + ; stopWith ev "Decomposed TyConApp" } + where loc = ctEvLoc ev role = eqRelRole eq_rel @@ -1747,7 +1768,8 @@ canEqHardFailure :: CtEvidence -> TcType -> TcType -> TcS (StopOrContinue Ct) -- See Note [Make sure that insolubles are fully rewritten] canEqHardFailure ev ty1 ty2 - = do { (s1, co1) <- flatten FM_SubstOnly ev ty1 + = do { traceTcS "canEqHardFailure" (ppr ty1 $$ ppr ty2) + ; (s1, co1) <- flatten FM_SubstOnly ev ty1 ; (s2, co2) <- flatten FM_SubstOnly ev ty2 ; new_ev <- rewriteEqEvidence ev NotSwapped s1 s2 co1 co2 ; continueWith (mkIrredCt InsolubleCIS new_ev) } @@ -2007,7 +2029,7 @@ canEqTyVarHomo ev eq_rel swapped tv1 ps_xi1 xi2 _ -- this guarantees (TyEq:TV) | Just (tv2, co2) <- tcGetCastedTyVar_maybe xi2 - , swapOverTyVars tv1 tv2 + , swapOverTyVars (isGiven ev) tv1 tv2 = do { traceTcS "canEqTyVar swapOver" (ppr tv1 $$ ppr tv2 $$ ppr swapped) ; let role = eqRelRole eq_rel sym_co2 = mkTcSymCo co2 diff --git a/compiler/GHC/Tc/Solver/Flatten.hs b/compiler/GHC/Tc/Solver/Flatten.hs index 4dff585840..7f0b6a6120 100644 --- a/compiler/GHC/Tc/Solver/Flatten.hs +++ b/compiler/GHC/Tc/Solver/Flatten.hs @@ -1174,7 +1174,7 @@ flatten_one (TyConApp tc tys) -- _ -> fmode = flatten_ty_con_app tc tys -flatten_one ty@(FunTy _ ty1 ty2) +flatten_one ty@(FunTy { ft_arg = ty1, ft_res = ty2 }) = do { (xi1,co1) <- flatten_one ty1 ; (xi2,co2) <- flatten_one ty2 ; role <- getRole diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 144021caea..98550132c5 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -2313,18 +2313,18 @@ newtype instance T [a] :: <kind> where ... -- See Point 5 2. Where these kinds come from: Return kinds are processed through several different code paths: - data/newtypes: The return kind is part of the TyCon kind, gotten either + Data/newtypes: The return kind is part of the TyCon kind, gotten either by checkInitialKind (standalone kind signature / CUSK) or inferInitialKind. It is extracted by bindTyClTyVars in tcTyClDecl1. It is then passed to tcDataDefn. - families: The return kind is either written in a standalone signature + Families: The return kind is either written in a standalone signature or extracted from a family declaration in getInitialKind. If a family declaration is missing a result kind, it is assumed to be Type. This assumption is in getInitialKind for CUSKs or get_fam_decl_initial_kind for non-signature & non-CUSK cases. - instances: The data family already has a known kind. The return kind + Instances: The data family already has a known kind. The return kind of an instance is then calculated by applying the data family tycon to the patterns provided, as computed by the typeKind lhs_ty in the end of tcDataFamInstHeader. In the case of an instance written in GADT @@ -2350,10 +2350,9 @@ newtype instance T [a] :: <kind> where ... -- See Point 5 4. Datatype return kind restriction: A data/data-instance return kind must end in a type that, after type-synonym expansion, yields `TYPE LiftedRep`. By "end in", we mean we strip any foralls and function arguments off before - checking: this remaining part of the type is returned from - etaExpandAlgTyCon. Note that we do *not* do type family reduction here. - Examples: + checking: this remaining part of the type is returned from etaExpandAlgTyCon. + Examples: data T1 :: Type -- good data T2 :: Bool -> Type -- good data T3 :: Bool -> forall k. Type -- strange, but still accepted @@ -2361,27 +2360,38 @@ newtype instance T [a] :: <kind> where ... -- See Point 5 data T5 :: Bool -- bad data T6 :: Type -> Bool -- bad + Exactly the same applies to data instance (but not data family) + declarations. Examples + data instance D1 :: Type -- good + data instance D2 :: Boool -> Type -- good + + We can "look through" type synonyms + type Star = Type + data T7 :: Bool -> Star -- good (synonym expansion ok) type Arrow = (->) - data T7 :: Arrow Bool Type -- good + data T8 :: Arrow Bool Type -- good (ditto) + But we specifically do *not* do type family reduction here. type family ARROW where ARROW = (->) - data T8 :: ARROW Bool Type -- bad - - type Star = Type - data T9 :: Bool -> Star -- good + data T9 :: ARROW Bool Type -- bad type family F a where F Int = Bool F Bool = Type data T10 :: Bool -> F Bool -- bad + The /principle/ here is that in the TyCon for a data type or data instance, + we must be able to lay out all the type-variable binders, one by one, until + we reach (TYPE xx). There is no place for a cast here. We could add one, + but let's not! + This check is done in checkDataKindSig. For data declarations, this call is in tcDataDefn; for data instances, this call is in tcDataFamInstDecl. - However, because data instances in GADT syntax can have two return kinds (see - point (2) above), we must check both return kinds. The user-written return - kind is checked in tc_kind_sig within tcDataFamInstHeader. Examples: +4a Because data instances in GADT syntax can have two return kinds (see + point (2) above), we must check both return kinds. The user-written return + kind is checked by the call to checkDataKindSig in tcDataFamInstDecl. Examples: data family D (a :: Nat) :: k -- good (see Point 6) @@ -2906,36 +2916,11 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo imp_vars exp_bndrs hs_pats hs_rhs_ty ; return (qtvs, pats, rhs_ty) } ----------------- -tcFamTyPats :: TyCon - -> HsTyPats GhcRn -- Patterns - -> TcM (TcType, TcKind) -- (lhs_type, lhs_kind) --- Used for both type and data families -tcFamTyPats fam_tc hs_pats - = do { traceTc "tcFamTyPats {" $ - vcat [ ppr fam_tc, text "arity:" <+> ppr fam_arity ] - - ; let fun_ty = mkTyConApp fam_tc [] - - ; (fam_app, res_kind) <- unsetWOptM Opt_WarnPartialTypeSignatures $ - setXOptM LangExt.PartialTypeSignatures $ - -- See Note [Wildcards in family instances] in - -- GHC.Rename.Module - tcInferApps typeLevelMode lhs_fun fun_ty hs_pats - - ; traceTc "End tcFamTyPats }" $ - vcat [ ppr fam_tc, text "res_kind:" <+> ppr res_kind ] - - ; return (fam_app, res_kind) } - where - fam_name = tyConName fam_tc - fam_arity = tyConArity fam_tc - lhs_fun = noLoc (HsTyVar noExtField NotPromoted (noLoc fam_name)) - unravelFamInstPats :: TcType -> [TcType] -- Decompose fam_app to get the argument patterns -- -- We expect fam_app to look like (F t1 .. tn) --- tcInferApps is capable of returning ((F ty1 |> co) ty2), +-- tcFamTyPats is capable of returning ((F ty1 |> co) ty2), -- but that can't happen here because we already checked the -- arity of F matches the number of pattern unravelFamInstPats fam_app @@ -4749,20 +4734,20 @@ badDataConTyCon data_con res_ty_tmpl $+$ hang (text "Suggestion: instead use this type signature:") 2 (ppr (dataConName data_con) <+> dcolon <+> ppr suggested_ty) - -- To construct a type that GHC would accept (suggested_ty), we: - -- - -- 1) Find the existentially quantified type variables and the class - -- predicates from the datacon. (NB: We don't need the universally - -- quantified type variables, since rejigConRes won't substitute them in - -- the result type if it fails, as in this scenario.) - -- 2) Split apart the return type (which is headed by a forall or a - -- context) using tcSplitNestedSigmaTys, collecting the type variables - -- and class predicates we find, as well as the rho type lurking - -- underneath the nested foralls and contexts. - -- 3) Smash together the type variables and class predicates from 1) and - -- 2), and prepend them to the rho type from 2). - (tvs, theta, rho) = tcSplitNestedSigmaTys (dataConUserType data_con) + -- To construct a type that GHC would accept (suggested_ty), we + -- simply drag all the foralls and (=>) contexts to the front + -- of the type. suggested_ty = mkSpecSigmaTy tvs theta rho + (tvs, theta, rho) = go (dataConUserType data_con) + + go :: Type -> ([TyVar],ThetaType,Type) + -- The returned Type has no foralls or =>, even to the right of an (->) + go ty | null arg_tys = (tvs1, theta1, rho1) + | otherwise = (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2) + where + (tvs1, theta1, rho1) = tcSplitNestedSigmaTys ty + (arg_tys, ty2) = tcSplitFunTys rho1 + (tvs2, theta2, rho2) = go ty2 badGadtDecl :: Name -> SDoc badGadtDecl tc_name diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index 734ec05512..4c43d91f3e 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -699,8 +699,10 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- we did it before the "extra" tvs from etaExpandAlgTyCon -- would always be eta-reduced -- - -- See also Note [Datatype return kinds] in GHC.Tc.TyCl ; (extra_tcbs, final_res_kind) <- etaExpandAlgTyCon full_tcbs res_kind + + -- Check the result kind; it may come from a user-written signature. + -- See Note [Datatype return kinds] in GHC.Tc.TyCl point 4(a) ; checkDataKindSig (DataInstanceSort new_or_data) final_res_kind ; let extra_pats = map (mkTyVarTy . binderVar) extra_tcbs all_pats = pats `chkAppend` extra_pats @@ -847,7 +849,8 @@ tcDataFamInstHeader -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity hs_ctxt hs_pats m_ksig hs_cons new_or_data - = do { (imp_tvs, (exp_tvs, (stupid_theta, lhs_ty, lhs_applied_kind))) + = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) + ; (imp_tvs, (exp_tvs, (stupid_theta, lhs_ty, res_kind))) <- pushTcLevelM_ $ solveEqualities $ bindImplicitTKBndrs_Q_Skol imp_vars $ @@ -872,10 +875,15 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity ; let lhs_applied_ty = lhs_ty `mkTcAppTys` lhs_extra_args hs_lhs = nlHsTyConApp fixity (getName fam_tc) hs_pats ; _ <- unifyKind (Just (unLoc hs_lhs)) lhs_applied_kind res_kind + -- Check that the result kind of the TyCon applied to its args + -- is compatible with the explicit signature (or Type, if there + -- is none) + ; traceTc "tcDataFamInstHeader" $ + vcat [ ppr fam_tc, ppr m_ksig, ppr lhs_applied_kind, ppr res_kind ] ; return ( stupid_theta , lhs_applied_ty - , lhs_applied_kind ) } + , res_kind ) } -- See GHC.Tc.TyCl Note [Generalising in tcFamTyPatsGuts] -- This code (and the stuff immediately above) is very similar @@ -888,10 +896,15 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity ; qtvs <- quantifyTyVars dvs -- Zonk the patterns etc into the Type world - ; (ze, qtvs) <- zonkTyBndrs qtvs - ; lhs_ty <- zonkTcTypeToTypeX ze lhs_ty - ; stupid_theta <- zonkTcTypesToTypesX ze stupid_theta - ; lhs_applied_kind <- zonkTcTypeToTypeX ze lhs_applied_kind + ; (ze, qtvs) <- zonkTyBndrs qtvs + ; lhs_ty <- zonkTcTypeToTypeX ze lhs_ty + ; stupid_theta <- zonkTcTypesToTypesX ze stupid_theta + ; res_kind <- zonkTcTypeToTypeX ze res_kind + + -- We check that res_kind is OK with checkDataKindSig in + -- tcDataFamInstDecl, after eta-expansion. We need to check that + -- it's ok because res_kind can come from a user-written kind signature. + -- See Note [Datatype return kinds], point (4a) -- Check that type patterns match the class instance head -- The call to splitTyConApp_maybe here is just an inlining of @@ -899,7 +912,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity ; pats <- case splitTyConApp_maybe lhs_ty of Just (_, pats) -> pure pats Nothing -> pprPanic "tcDataFamInstHeader" (ppr lhs_ty) - ; return (qtvs, pats, lhs_applied_kind, stupid_theta) } + + ; return (qtvs, pats, res_kind, stupid_theta) } where fam_name = tyConName fam_tc data_ctxt = DataKindCtxt fam_name @@ -920,11 +934,7 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity ; lvl <- getTcLevel ; (subst, _tvs') <- tcInstSkolTyVarsAt lvl False emptyTCvSubst tvs -- Perhaps surprisingly, we don't need the skolemised tvs themselves - ; let final_kind = substTy subst inner_kind - ; checkDataKindSig (DataInstanceSort new_or_data) $ - snd $ tcSplitPiTys final_kind - -- See Note [Datatype return kinds], end of point (4) - ; return final_kind } + ; return (substTy subst inner_kind) } {- Note [Result kind signature for a data family instance] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -932,7 +942,7 @@ The expected type might have a forall at the type. Normally, we can't skolemise in kinds because we don't have type-level lambda. But here, we're at the top-level of an instance declaration, so we actually have a place to put the regeneralised variables. -Thus: skolemise away. cf. Inst.deeplySkolemise and GHC.Tc.Utils.Unify.tcSkolemise +Thus: skolemise away. cf. GHC.Tc.Utils.Unify.tcSkolemise Examples in indexed-types/should_compile/T12369 Note [Implementing eta reduction for data families] @@ -1781,7 +1791,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind -- The instance-sig is the focus here; the class-meth-sig -- is fixed (#18036) ; hs_wrap <- addErrCtxtM (methSigCtxt sel_name sig_ty local_meth_ty) $ - tcSubType_NC ctxt sig_ty local_meth_ty + tcSubTypeSigma ctxt sig_ty local_meth_ty ; return (sig_ty, hs_wrap) } ; inner_meth_name <- newName (nameOccName sel_name) diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 957506c7c5..a785fbbb7a 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -431,9 +431,9 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details = do { -- Look up the variable actually bound by lpat -- and check that it has the expected type arg_id <- tcLookupId arg_name - ; wrap <- tcSubType_NC GenSigCtxt - (idType arg_id) - (substTyUnchecked subst arg_ty) + ; wrap <- tcSubTypeSigma GenSigCtxt + (idType arg_id) + (substTyUnchecked subst arg_ty) -- Why do we need tcSubType here? -- See Note [Pattern synonyms and higher rank types] ; return (mkLHsWrap wrap $ nlHsVar arg_id) } diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs index 908a23ff26..3f01a7d03a 100644 --- a/compiler/GHC/Tc/Types/Constraint.hs +++ b/compiler/GHC/Tc/Types/Constraint.hs @@ -29,7 +29,7 @@ module GHC.Tc.Types.Constraint ( WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC, isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC, - addInsols, insolublesOnly, addSimples, addImplics, addHole, + addInsols, dropMisleading, addSimples, addImplics, addHoles, tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples, tyCoVarsOfWCList, insolubleCt, insolubleEqCt, isDroppableCt, insolubleImplic, @@ -961,19 +961,24 @@ addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints addInsols wc cts = wc { wc_simple = wc_simple wc `unionBags` cts } -addHole :: WantedConstraints -> Hole -> WantedConstraints -addHole wc hole - = wc { wc_holes = hole `consBag` wc_holes wc } +addHoles :: WantedConstraints -> Bag Hole -> WantedConstraints +addHoles wc holes + = wc { wc_holes = holes `unionBags` wc_holes wc } -insolublesOnly :: WantedConstraints -> WantedConstraints --- Keep only the definitely-insoluble constraints -insolublesOnly (WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) - = WC { wc_simple = filterBag insolubleCt simples - , wc_impl = mapBag implic_insols_only implics +dropMisleading :: WantedConstraints -> WantedConstraints +-- Drop misleading constraints; really just class constraints +-- See Note [Constraints and errors] in GHC.Tc.Utils.Monad +dropMisleading (WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) + = WC { wc_simple = filterBag keep_ct simples + , wc_impl = mapBag drop_implic implics , wc_holes = filterBag isOutOfScopeHole holes } where - implic_insols_only implic - = implic { ic_wanted = insolublesOnly (ic_wanted implic) } + drop_implic implic + = implic { ic_wanted = dropMisleading (ic_wanted implic) } + keep_ct ct + = case classifyPredType (ctPred ct) of + ClassPred {} -> False + _ -> True isSolvedStatus :: ImplicStatus -> Bool isSolvedStatus (IC_Solved {}) = True @@ -1100,9 +1105,6 @@ data Implication ic_info :: SkolemInfo, -- See Note [Skolems in an implication] -- See Note [Shadowing in a constraint] - ic_telescope :: Maybe SDoc, -- User-written telescope, if there is one - -- See Note [Checking telescopes] - ic_given :: [EvVar], -- Given evidence variables -- (order does not matter) -- See Invariant (GivenInv) in GHC.Tc.Utils.TcType @@ -1153,7 +1155,6 @@ implicationPrototype -- The rest have sensible default values , ic_skols = [] - , ic_telescope = Nothing , ic_given = [] , ic_wanted = emptyWC , ic_no_eqs = False @@ -1228,17 +1229,18 @@ all at once, creating one implication constraint for the lot: variables (ic_skols). This is done in setImplicationStatus. * This check is only necessary if the implication was born from a - user-written signature. If, say, it comes from checking a pattern - match that binds existentials, where the type of the data constructor - is known to be valid (it in tcConPat), no need for the check. + 'forall' in a user-written signature (the HsForAllTy case in + GHC.Tc.Gen.HsType. If, say, it comes from checking a pattern match + that binds existentials, where the type of the data constructor is + known to be valid (it in tcConPat), no need for the check. - So the check is done if and only if ic_telescope is (Just blah). + So the check is done if and only if ic_info is ForAllSkol -* If ic_telesope is (Just d), the d::SDoc displays the original, - user-written type variables. +* If ic_info is (ForAllSkol dt dvs), the dvs::SDoc displays the + original, user-written type variables. -* Be careful /NOT/ to discard an implication with non-Nothing - ic_telescope, even if ic_wanted is empty. We must give the +* Be careful /NOT/ to discard an implication with a ForAllSkol + ic_info, even if ic_wanted is empty. We must give the constraint solver a chance to make that bad-telescope test! Hence the extra guard in emitResidualTvConstraint; see #16247 diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs index 381cdd03ba..b453633c65 100644 --- a/compiler/GHC/Tc/Types/Origin.hs +++ b/compiler/GHC/Tc/Types/Origin.hs @@ -125,7 +125,7 @@ data UserTypeCtxt pprUserTypeCtxt :: UserTypeCtxt -> SDoc pprUserTypeCtxt (FunSigCtxt n _) = text "the type signature for" <+> quotes (ppr n) pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr n) -pprUserTypeCtxt (RuleSigCtxt n) = text "a RULE for" <+> quotes (ppr n) +pprUserTypeCtxt (RuleSigCtxt n) = text "the type signature for" <+> quotes (ppr n) pprUserTypeCtxt ExprSigCtxt = text "an expression type signature" pprUserTypeCtxt KindSigCtxt = text "a kind signature" pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n) @@ -184,7 +184,10 @@ data SkolemInfo -- like SigSkol, but when we're kind-checking the *type* -- hence, we have less info - | ForAllSkol SDoc -- Bound by a user-written "forall". + | ForAllSkol -- Bound by a user-written "forall". + SDoc -- Shows the entire forall type + SDoc -- Shows just the binders, used when reporting a bad telescope + -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint | DerivSkol Type -- Bound by a 'deriving' clause; -- the type is the instance we are trying to derive @@ -242,7 +245,7 @@ pprSkolInfo :: SkolemInfo -> SDoc -- Complete the sentence "is a rigid type variable bound by..." pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty pprSkolInfo (SigTypeSkol cx) = pprUserTypeCtxt cx -pprSkolInfo (ForAllSkol doc) = quotes doc +pprSkolInfo (ForAllSkol pt _) = quotes pt pprSkolInfo (IPSkol ips) = text "the implicit-parameter binding" <> plural ips <+> text "for" <+> pprWithCommas ppr ips pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred) @@ -306,8 +309,8 @@ is fine. We could do more, but it doesn't seem worth it. Note [SigSkol SkolemInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we (deeply) skolemise a type - f :: forall a. a -> forall b. b -> a +Suppose we skolemise a type + f :: forall a. Eq a => forall b. b -> a Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated a' -> b' -> a. But when, in an error message, we report that "b is a rigid type @@ -321,8 +324,8 @@ in the right place. So we proceed as follows: * Then when tidying in GHC.Tc.Utils.TcMType.tidySkolemInfo, we first tidy a' to whatever it tidies to, say a''; and then we walk over the type replacing the binder a by the tidied version a'', to give - forall a''. a'' -> forall b''. b'' -> a'' - We need to do this under function arrows, to match what deeplySkolemise + forall a''. Eq a'' => forall b''. b'' -> a'' + We need to do this under (=>) arrows, to match what topSkolemise does. * Typically a'' will have a nice pretty name like "a", but the point is diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 8c2a60ba50..2563ff7348 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -593,24 +593,29 @@ tc_extend_local_env top_lvl extra_env thing_inside -- that are bound together with extra_env and should not be regarded -- as free in the types of extra_env. = do { traceTc "tc_extend_local_env" (ppr extra_env) - ; env0 <- getLclEnv - ; let env1 = tcExtendLocalTypeEnv env0 extra_env ; stage <- getStage - ; let env2 = extend_local_env (top_lvl, thLevel stage) extra_env env1 - ; setLclEnv env2 thing_inside } - where - extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv - -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously - -- Reason for extending LocalRdrEnv: after running a TH splice we need - -- to do renaming. - extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env - , tcl_th_bndrs = th_bndrs }) - = env { tcl_rdr = extendLocalRdrEnvList rdr_env - [ n | (n, _) <- pairs, isInternalName n ] - -- The LocalRdrEnv contains only non-top-level names - -- (GlobalRdrEnv handles the top level) - , tcl_th_bndrs = extendNameEnvList th_bndrs -- We only track Ids in tcl_th_bndrs - [(n, thlvl) | (n, ATcId {}) <- pairs] } + ; env0@(TcLclEnv { tcl_rdr = rdr_env + , tcl_th_bndrs = th_bndrs + , tcl_env = lcl_type_env }) <- getLclEnv + + ; let thlvl = (top_lvl, thLevel stage) + + env1 = env0 { tcl_rdr = extendLocalRdrEnvList rdr_env + [ n | (n, _) <- extra_env, isInternalName n ] + -- The LocalRdrEnv contains only non-top-level names + -- (GlobalRdrEnv handles the top level) + + , tcl_th_bndrs = extendNameEnvList th_bndrs + [(n, thlvl) | (n, ATcId {}) <- extra_env] + -- We only track Ids in tcl_th_bndrs + + , tcl_env = extendNameEnvList lcl_type_env extra_env } + + -- tcl_rdr and tcl_th_bndrs: extend the local LocalRdrEnv and + -- Template Haskell staging env simultaneously. Reason for extending + -- LocalRdrEnv: after running a TH splice we need to do renaming. + + ; setLclEnv env1 thing_inside } tcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcLclEnv tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs index ea8ffd912b..df9cf982ee 100644 --- a/compiler/GHC/Tc/Utils/Instantiate.hs +++ b/compiler/GHC/Tc/Utils/Instantiate.hs @@ -10,10 +10,9 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} --- | The @Inst@ type: dictionaries or method instances module GHC.Tc.Utils.Instantiate ( - deeplySkolemise, - topInstantiate, topInstantiateInferred, deeplyInstantiate, + topSkolemise, + topInstantiate, topInstantiateInferred, instCall, instDFunType, instStupidTheta, instTyVarsWith, newWanted, newWanteds, @@ -36,11 +35,10 @@ module GHC.Tc.Utils.Instantiate ( import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckExpr, tcSyntaxOp ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExpr, tcSyntaxOp ) import {-# SOURCE #-} GHC.Tc.Utils.Unify( unifyType, unifyKind ) import GHC.Types.Basic ( IntegralLit(..), SourceText(..) ) -import GHC.Data.FastString import GHC.Hs import GHC.Tc.Utils.Zonk import GHC.Tc.Utils.Monad @@ -117,66 +115,62 @@ newMethodFromName origin name ty_args {- ************************************************************************ * * - Deep instantiation and skolemisation + Instantiation and skolemisation * * ************************************************************************ -Note [Deep skolemisation] -~~~~~~~~~~~~~~~~~~~~~~~~~ -deeplySkolemise decomposes and skolemises a type, returning a type -with all its arrows visible (ie not buried under foralls) +Note [Skolemisation] +~~~~~~~~~~~~~~~~~~~~ +topSkolemise decomposes and skolemises a type, returning a type +with no top level foralls or (=>) Examples: - deeplySkolemise (Int -> forall a. Ord a => blah) - = ( wp, [a], [d:Ord a], Int -> blah ) - where wp = \x:Int. /\a. \(d:Ord a). <hole> x + topSkolemise (forall a. Ord a => a -> a) + = ( wp, [a], [d:Ord a], a->a ) + where wp = /\a. \(d:Ord a). <hole> a d - deeplySkolemise (forall a. Ord a => Maybe a -> forall b. Eq b => blah) - = ( wp, [a,b], [d1:Ord a,d2:Eq b], Maybe a -> blah ) - where wp = /\a.\(d1:Ord a).\(x:Maybe a)./\b.\(d2:Ord b). <hole> x + topSkolemise (forall a. Ord a => forall b. Eq b => a->b->b) + = ( wp, [a,b], [d1:Ord a,d2:Eq b], a->b->b ) + where wp = /\a.\(d1:Ord a)./\b.\(d2:Ord b). <hole> a d1 b d2 + +This second example is the reason for the recursive 'go' +function in topSkolemise: we must remove successive layers +of foralls and (=>). In general, - if deeplySkolemise ty = (wrap, tvs, evs, rho) + if topSkolemise ty = (wrap, tvs, evs, rho) and e :: rho then wrap e :: ty - and 'wrap' binds tvs, evs + and 'wrap' binds {tvs, evs} -ToDo: this eta-abstraction plays fast and loose with termination, - because it can introduce extra lambdas. Maybe add a `seq` to - fix this -} -deeplySkolemise :: TcSigmaType - -> TcM ( HsWrapper - , [(Name,TyVar)] -- All skolemised variables - , [EvVar] -- All "given"s - , TcRhoType ) - -deeplySkolemise ty - = go init_subst ty +topSkolemise :: TcSigmaType + -> TcM ( HsWrapper + , [(Name,TyVar)] -- All skolemised variables + , [EvVar] -- All "given"s + , TcRhoType ) +-- See Note [Skolemisation] +topSkolemise ty + = go init_subst idHsWrapper [] [] ty where init_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty)) - go subst ty - | Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty - = do { let arg_tys' = substTys subst arg_tys - ; ids1 <- newSysLocalIds (fsLit "dk") arg_tys' - ; (subst', tvs1) <- tcInstSkolTyVarsX subst tvs + -- Why recursive? See Note [Skolemisation] + go subst wrap tv_prs ev_vars ty + | (tvs, theta, inner_ty) <- tcSplitSigmaTy ty + , not (null tvs && null theta) + = do { (subst', tvs1) <- tcInstSkolTyVarsX subst tvs ; ev_vars1 <- newEvVars (substTheta subst' theta) - ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty' - ; let tv_prs1 = map tyVarName tvs `zip` tvs1 - ; return ( mkWpLams ids1 - <.> mkWpTyLams tvs1 - <.> mkWpLams ev_vars1 - <.> wrap - <.> mkWpEvVarApps ids1 - , tv_prs1 ++ tvs_prs2 - , ev_vars1 ++ ev_vars2 - , mkVisFunTys arg_tys' rho ) } + ; go subst' + (wrap <.> mkWpTyLams tvs1 <.> mkWpLams ev_vars1) + (tv_prs ++ (map tyVarName tvs `zip` tvs1)) + (ev_vars ++ ev_vars1) + inner_ty } | otherwise - = return (idHsWrapper, [], [], substTy subst ty) + = return (wrap, tv_prs, ev_vars, substTy subst ty) -- substTy is a quick no-op on an empty substitution -- | Instantiate all outer type variables @@ -185,6 +179,7 @@ topInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) -- if topInstantiate ty = (wrap, rho) -- and e :: ty -- then wrap e :: rho (that is, wrap :: ty "->" rho) +-- NB: always returns a rho-type, with no top-level forall or (=>) topInstantiate = top_instantiate True -- | Instantiate all outer 'Inferred' binders @@ -195,13 +190,16 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType -- if topInstantiate ty = (wrap, rho) -- and e :: ty -- then wrap e :: rho +-- NB: may return a sigma-type topInstantiateInferred = top_instantiate False top_instantiate :: Bool -- True <=> instantiate *all* variables -- False <=> instantiate only the inferred ones -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) top_instantiate inst_all orig ty - | not (null binders && null theta) + | (binders, phi) <- tcSplitForAllVarBndrs ty + , (theta, rho) <- tcSplitPhiTy phi + , not (null binders && null theta) = do { let (inst_bndrs, leave_bndrs) = span should_inst binders (inst_theta, leave_theta) | null leave_bndrs = (theta, []) @@ -226,7 +224,7 @@ top_instantiate inst_all orig ty , text "theta:" <+> ppr inst_theta' ]) ; (wrap2, rho2) <- - if null leave_bndrs + if null leave_bndrs -- NB: if inst_all is True then leave_bndrs = [] -- account for types like forall a. Num a => forall b. Ord b => ... then top_instantiate inst_all orig sigma' @@ -238,67 +236,11 @@ top_instantiate inst_all orig ty | otherwise = return (idHsWrapper, ty) where - (binders, phi) = tcSplitForAllVarBndrs ty - (theta, rho) = tcSplitPhiTy phi should_inst bndr | inst_all = True | otherwise = binderArgFlag bndr == Inferred -deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) --- Int -> forall a. a -> a ==> (\x:Int. [] x alpha) :: Int -> alpha --- In general if --- if deeplyInstantiate ty = (wrap, rho) --- and e :: ty --- then wrap e :: rho --- That is, wrap :: ty ~> rho --- --- If you don't need the HsWrapper returned from this function, consider --- using tcSplitNestedSigmaTys in GHC.Tc.Utils.TcType, which is a pure alternative that --- only computes the returned TcRhoType. - -deeplyInstantiate orig ty = - deeply_instantiate orig - (mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty))) - ty - -deeply_instantiate :: CtOrigin - -> TCvSubst - -> TcSigmaType -> TcM (HsWrapper, TcRhoType) --- Internal function to deeply instantiate that builds on an existing subst. --- It extends the input substitution and applies the final substitution to --- the types on return. See #12549. - -deeply_instantiate orig subst ty - | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty - = do { (subst', tvs') <- newMetaTyVarsX subst tvs - ; let arg_tys' = substTys subst' arg_tys - theta' = substTheta subst' theta - ; ids1 <- newSysLocalIds (fsLit "di") arg_tys' - ; wrap1 <- instCall orig (mkTyVarTys tvs') theta' - ; traceTc "Instantiating (deeply)" (vcat [ text "origin" <+> pprCtOrigin orig - , text "type" <+> ppr ty - , text "with" <+> ppr tvs' - , text "args:" <+> ppr ids1 - , text "theta:" <+> ppr theta' - , text "subst:" <+> ppr subst']) - ; (wrap2, rho2) <- deeply_instantiate orig subst' rho - ; return (mkWpLams ids1 - <.> wrap2 - <.> wrap1 - <.> mkWpEvVarApps ids1, - mkVisFunTys arg_tys' rho2) } - - | otherwise - = do { let ty' = substTy subst ty - ; traceTc "deeply_instantiate final subst" - (vcat [ text "origin:" <+> pprCtOrigin orig - , text "type:" <+> ppr ty - , text "new type:" <+> ppr ty' - , text "subst:" <+> ppr subst ]) - ; return (idHsWrapper, ty') } - - instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst -- Use this when you want to instantiate (forall a b c. ty) with -- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might @@ -639,7 +581,7 @@ tcSyntaxName orig ty (std_nm, user_nm_expr) = do -- same type as the standard one. -- Tiresome jiggling because tcCheckSigma takes a located expression span <- getSrcSpanM - expr <- tcCheckExpr (L span user_nm_expr) sigma1 + expr <- tcCheckPolyExpr (L span user_nm_expr) sigma1 return (std_nm, unLoc expr) syntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> TidyEnv diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index 4f14d7b251..5bc6fe3034 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -98,7 +98,8 @@ module GHC.Tc.Utils.Monad( chooseUniqueOccTc, getConstraintVar, setConstraintVar, emitConstraints, emitStaticConstraints, emitSimple, emitSimples, - emitImplication, emitImplications, emitInsoluble, emitHole, + emitImplication, emitImplications, emitInsoluble, + emitHole, emitHoles, discardConstraints, captureConstraints, tryCaptureConstraints, pushLevelAndCaptureConstraints, pushTcLevelM_, pushTcLevelM, pushTcLevelsM, @@ -1111,7 +1112,7 @@ askNoErrs thing_inside ; addMessages msgs ; case mb_res of - Nothing -> do { emitConstraints (insolublesOnly lie) + Nothing -> do { emitConstraints (dropMisleading lie) ; failM } Just res -> do { emitConstraints lie @@ -1133,7 +1134,7 @@ tryCaptureConstraints thing_inside -- See Note [Constraints and errors] ; let lie_to_keep = case mb_res of - Nothing -> insolublesOnly lie + Nothing -> dropMisleading lie Just {} -> lie ; return (mb_res, lie_to_keep) } @@ -1555,7 +1556,13 @@ emitHole :: Hole -> TcM () emitHole hole = do { traceTc "emitHole" (ppr hole) ; lie_var <- getConstraintVar - ; updTcRef lie_var (`addHole` hole) } + ; updTcRef lie_var (`addHoles` unitBag hole) } + +emitHoles :: Bag Hole -> TcM () +emitHoles holes + = do { traceTc "emitHoles" (ppr holes) + ; lie_var <- getConstraintVar + ; updTcRef lie_var (`addHoles` holes) } -- | Throw out any constraints emitted by the thing_inside discardConstraints :: TcM a -> TcM a diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index 90598e42c4..d02af1351a 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -27,7 +27,8 @@ module GHC.Tc.Utils.TcMType ( newFmvTyVar, newFskTyVar, readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef, - newMetaDetails, isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar, + newTauTvDetailsAtLevel, newMetaDetails, newMetaTyVarName, + isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar, -------------------------------- -- Expected types @@ -70,7 +71,7 @@ module GHC.Tc.Utils.TcMType ( zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin, tidyEvVar, tidyCt, tidyHole, tidySkolemInfo, zonkTcTyVar, zonkTcTyVars, - zonkTcTyVarToTyVar, zonkTyVarTyVarPairs, + zonkTcTyVarToTyVar, zonkInvisTVBinder, zonkTyCoVarsAndFV, zonkTcTypeAndFV, zonkDTyCoVarSetAndFV, zonkTyCoVarsAndFVList, candidateQTyVarsOfType, candidateQTyVarsOfKind, @@ -81,7 +82,7 @@ module GHC.Tc.Utils.TcMType ( zonkTcType, zonkTcTypes, zonkCo, zonkTyCoVarKind, zonkTyCoVarKindBinder, - zonkEvVar, zonkWC, zonkSimples, + zonkEvVar, zonkWC, zonkImplication, zonkSimples, zonkId, zonkCoVar, zonkCt, zonkSkolemInfo, @@ -119,7 +120,6 @@ import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env -import GHC.Builtin.Names import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Data.FastString @@ -144,18 +144,13 @@ import qualified Data.Semigroup as Semi ************************************************************************ -} -mkKindName :: Unique -> Name -mkKindName unique = mkSystemName unique kind_var_occ - -kind_var_occ :: OccName -- Just one for all MetaKindVars - -- They may be jiggled by tidying -kind_var_occ = mkOccName tvName "k" - newMetaKindVar :: TcM TcKind newMetaKindVar = do { details <- newMetaDetails TauTv - ; uniq <- newUnique - ; let kv = mkTcTyVar (mkKindName uniq) liftedTypeKind details + ; name <- newMetaTyVarName (fsLit "k") + -- All MetaKindVars are called "k" + -- They may be jiggled by tidying + ; let kv = mkTcTyVar name liftedTypeKind details ; traceTc "newMetaKindVar" (ppr kv) ; return (mkTyVarTy kv) } @@ -834,6 +829,13 @@ newMetaDetails info , mtv_ref = ref , mtv_tclvl = tclvl }) } +newTauTvDetailsAtLevel :: TcLevel -> TcM TcTyVarDetails +newTauTvDetailsAtLevel tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = TauTv + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = ASSERT( isTcTyVar tv ) @@ -1060,18 +1062,15 @@ new_meta_tv_x info subst tv -- is not yet fixed so leaving as unchecked for now. -- OLD NOTE: -- Unchecked because we call newMetaTyVarX from - -- tcInstTyBinder, which is called from tcInferApps + -- tcInstTyBinder, which is called from tcInferTyApps -- which does not yet take enough trouble to ensure -- the in-scope set is right; e.g. #12785 trips -- if we use substTy here newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType newMetaTyVarTyAtLevel tc_lvl kind - = do { ref <- newMutVar Flexi - ; name <- newMetaTyVarName (fsLit "p") - ; let details = MetaTv { mtv_info = TauTv - , mtv_ref = ref - , mtv_tclvl = tc_lvl } + = do { details <- newTauTvDetailsAtLevel tc_lvl + ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } {- ********************************************************************* @@ -1254,13 +1253,14 @@ instance Outputable CandidatesQTvs where candidateKindVars :: CandidatesQTvs -> TyVarSet candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs) -partitionCandidates :: CandidatesQTvs -> (TyVar -> Bool) -> (DTyVarSet, CandidatesQTvs) +partitionCandidates :: CandidatesQTvs -> (TyVar -> Bool) -> (TyVarSet, CandidatesQTvs) +-- The selected TyVars are returned as a non-deterministic TyVarSet partitionCandidates dvs@(DV { dv_kvs = kvs, dv_tvs = tvs }) pred = (extracted, dvs { dv_kvs = rest_kvs, dv_tvs = rest_tvs }) where (extracted_kvs, rest_kvs) = partitionDVarSet pred kvs (extracted_tvs, rest_tvs) = partitionDVarSet pred tvs - extracted = extracted_kvs `unionDVarSet` extracted_tvs + extracted = dVarSetToVarSet extracted_kvs `unionVarSet` dVarSetToVarSet extracted_tvs -- | Gathers free variables to use as quantification candidates (in -- 'quantifyTyVars'). This might output the same var @@ -2218,12 +2218,9 @@ zonkTcTyVarToTyVar tv (ppr tv $$ ppr ty) ; return tv' } -zonkTyVarTyVarPairs :: [(Name,VarBndr TcTyVar Specificity)] -> TcM [(Name,VarBndr TcTyVar Specificity)] -zonkTyVarTyVarPairs prs - = mapM do_one prs - where - do_one (nm, Bndr tv spec) = do { tv' <- zonkTcTyVarToTyVar tv - ; return (nm, Bndr tv' spec) } +zonkInvisTVBinder :: VarBndr TcTyVar spec -> TcM (VarBndr TyVar spec) +zonkInvisTVBinder (Bndr tv spec) = do { tv' <- zonkTcTyVarToTyVar tv + ; return (Bndr tv' spec) } -- zonkId is used *during* typechecking just to zonk the Id's type zonkId :: TcId -> TcM TcId @@ -2342,7 +2339,7 @@ tidySigSkol env cx ty tv_prs where (env', tv') = tidy_tv_bndr env tv - tidy_ty env ty@(FunTy _ arg res) + tidy_ty env ty@(FunTy InvisArg arg res) -- Look under c => t = ty { ft_arg = tidyType env arg, ft_res = tidy_ty env res } tidy_ty env ty = tidyType env ty diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index fb1d6f432b..c1d7af0120 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -67,7 +67,7 @@ module GHC.Tc.Utils.TcType ( tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe, tcRepGetNumAppTys, tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar, - tcSplitSigmaTy, tcSplitNestedSigmaTys, tcDeepSplitSigmaTy_maybe, + tcSplitSigmaTy, tcSplitNestedSigmaTys, --------------------------------- -- Predicates. @@ -412,7 +412,7 @@ mkCheckExpType = Check -- This is defined here to avoid defining it in GHC.Tc.Gen.Expr boot file. data SyntaxOpType = SynAny -- ^ Any type - | SynRho -- ^ A rho type, deeply skolemised or instantiated as appropriate + | SynRho -- ^ A rho type, skolemised or instantiated as appropriate | SynList -- ^ A list type. You get back the element type of the list | SynFun SyntaxOpType SyntaxOpType -- ^ A function. @@ -431,11 +431,12 @@ mkSynFunTys arg_tys res_ty = foldr SynFun (SynType res_ty) arg_tys {- Note [TcRhoType] ~~~~~~~~~~~~~~~~ -A TcRhoType has no foralls or contexts at the top, or to the right of an arrow - YES (forall a. a->a) -> Int +A TcRhoType has no foralls or contexts at the top NO forall a. a -> Int NO Eq a => a -> a - NO Int -> forall a. a -> Int + YES a -> a + YES (forall a. a->a) -> Int + YES Int -> forall a. a -> Int ************************************************************************ @@ -1273,35 +1274,19 @@ tcSplitSigmaTy ty = case tcSplitForAllTys ty of -- if you instead called @tcSplitNestedSigmaTys@ on the type, it would return -- @([s,t,a,b,f], [Each s t a b, Applicative f], (a -> f b) -> s -> f t)@. tcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type) --- NB: This is basically a pure version of deeplyInstantiate (from Inst) that +-- NB: This is basically a pure version of topInstantiate (from Inst) that -- doesn't compute an HsWrapper. tcSplitNestedSigmaTys ty -- If there's a forall, split it apart and try splitting the rho type -- underneath it. - | Just (arg_tys, tvs1, theta1, rho1) <- tcDeepSplitSigmaTy_maybe ty + | (tvs1, theta1, rho1) <- tcSplitSigmaTy ty + , not (null tvs1 && null theta1) = let (tvs2, theta2, rho2) = tcSplitNestedSigmaTys rho1 - in (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2) + in (tvs1 ++ tvs2, theta1 ++ theta2, rho2) -- If there's no forall, we're done. | otherwise = ([], [], ty) ----------------------- -tcDeepSplitSigmaTy_maybe - :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType) --- Looks for a *non-trivial* quantified type, under zero or more function arrows --- By "non-trivial" we mean either tyvars or constraints are non-empty - -tcDeepSplitSigmaTy_maybe ty - | Just (arg_ty, res_ty) <- tcSplitFunTy_maybe ty - , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty - = Just (arg_ty:arg_tys, tvs, theta, rho) - - | (tvs, theta, rho) <- tcSplitSigmaTy ty - , not (null tvs && null theta) - = Just ([], tvs, theta, rho) - - | otherwise = Nothing - ------------------------ tcTyConAppTyCon :: Type -> TyCon tcTyConAppTyCon ty = case tcTyConAppTyCon_maybe ty of @@ -1997,9 +1982,9 @@ isSigmaTy _ = False isRhoTy :: TcType -> Bool -- True of TcRhoTypes; see Note [TcRhoType] isRhoTy ty | Just ty' <- tcView ty = isRhoTy ty' -isRhoTy (ForAllTy {}) = False -isRhoTy (FunTy { ft_af = VisArg, ft_res = r }) = isRhoTy r -isRhoTy _ = True +isRhoTy (ForAllTy {}) = False +isRhoTy (FunTy { ft_af = InvisArg }) = False +isRhoTy _ = True -- | Like 'isRhoTy', but also says 'True' for 'Infer' types isRhoExpTy :: ExpType -> Bool diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs index 7c14e56319..8ca3ae7723 100644 --- a/compiler/GHC/Tc/Utils/Unify.hs +++ b/compiler/GHC/Tc/Utils/Unify.hs @@ -13,11 +13,11 @@ -- | Type subsumption and unification module GHC.Tc.Utils.Unify ( -- Full-blown subsumption - tcWrapResult, tcWrapResultO, tcSkolemise, tcSkolemiseET, - tcSubTypeHR, tcSubTypeO, tcSubType_NC, tcSubTypeDS, - tcSubTypeDS_NC_O, tcSubTypePat, + tcWrapResult, tcWrapResultO, tcWrapResultMono, + tcSkolemise, tcSkolemiseScoped, tcSkolemiseET, + tcSubType, tcSubTypeSigma, tcSubTypePat, checkConstraints, checkTvConstraints, - buildImplicationFor, emitResidualTvConstraint, + buildImplicationFor, buildTvImplication, emitResidualTvConstraint, -- Various unifications unifyType, unifyKind, @@ -31,7 +31,7 @@ module GHC.Tc.Utils.Unify ( matchExpectedTyConApp, matchExpectedAppTy, matchExpectedFunTys, - matchActualFunTys, matchActualFunTysPart, + matchActualFunTysRho, matchActualFunTySigma, matchExpectedFunKind, metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..) @@ -48,6 +48,7 @@ import GHC.Core.TyCo.Ppr( debugPprType ) import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType +import GHC.Tc.Utils.Env import GHC.Core.Type import GHC.Core.Coercion import GHC.Tc.Types.Evidence @@ -70,7 +71,6 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Utils.Outputable as Outputable -import Data.Maybe( isNothing ) import Control.Monad import Control.Arrow ( second ) @@ -139,34 +139,46 @@ passed in. -} -- Use this one when you have an "expected" type. +-- This function skolemises at each polytype. matchExpectedFunTys :: forall a. SDoc -- See Note [Herald for matchExpectedFunTys] + -> UserTypeCtxt -> Arity - -> ExpRhoType -- deeply skolemised + -> ExpRhoType -- Skolemised -> ([ExpSigmaType] -> ExpRhoType -> TcM a) - -- must fill in these ExpTypes here - -> TcM (a, HsWrapper) + -> TcM (HsWrapper, a) -- If matchExpectedFunTys n ty = (_, wrap) -- then wrap : (t1 -> ... -> tn -> ty_r) ~> ty, -- where [t1, ..., tn], ty_r are passed to the thing_inside -matchExpectedFunTys herald arity orig_ty thing_inside +matchExpectedFunTys herald ctx arity orig_ty thing_inside = case orig_ty of Check ty -> go [] arity ty _ -> defer [] arity orig_ty where - go acc_arg_tys 0 ty - = do { result <- thing_inside (reverse acc_arg_tys) (mkCheckExpType ty) - ; return (result, idHsWrapper) } + -- Skolemise any foralls /before/ the zero-arg case + -- so that we guarantee to return a rho-type + go acc_arg_tys n ty + | (tvs, theta, _) <- tcSplitSigmaTy ty + , not (null tvs && null theta) + = do { (wrap_gen, (wrap_res, result)) <- tcSkolemise ctx ty $ \ty' -> + go acc_arg_tys n ty' + ; return (wrap_gen <.> wrap_res, result) } + + -- No more args; do this /before/ tcView, so + -- that we do not unnecessarily unwrap synonyms + go acc_arg_tys 0 rho_ty + = do { result <- thing_inside (reverse acc_arg_tys) (mkCheckExpType rho_ty) + ; return (idHsWrapper, result) } go acc_arg_tys n ty | Just ty' <- tcView ty = go acc_arg_tys n ty' go acc_arg_tys n (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty }) = ASSERT( af == VisArg ) - do { (result, wrap_res) <- go (mkCheckExpType arg_ty : acc_arg_tys) + do { (wrap_res, result) <- go (mkCheckExpType arg_ty : acc_arg_tys) (n-1) res_ty - ; return ( result - , mkWpFun idHsWrapper wrap_res arg_ty res_ty doc ) } + ; let fun_wrap = mkWpFun idHsWrapper wrap_res arg_ty res_ty doc + ; return ( fun_wrap, result ) } where doc = text "When inferring the argument type of a function with type" <+> quotes (ppr orig_ty) @@ -197,7 +209,7 @@ matchExpectedFunTys herald arity orig_ty thing_inside defer acc_arg_tys n (mkCheckExpType ty) ------------ - defer :: [ExpSigmaType] -> Arity -> ExpRhoType -> TcM (a, HsWrapper) + defer :: [ExpSigmaType] -> Arity -> ExpRhoType -> TcM (HsWrapper, a) defer acc_arg_tys n fun_ty = do { more_arg_tys <- replicateM n newInferExpType ; res_ty <- newInferExpType @@ -205,9 +217,9 @@ matchExpectedFunTys herald arity orig_ty thing_inside ; more_arg_tys <- mapM readExpType more_arg_tys ; res_ty <- readExpType res_ty ; let unif_fun_ty = mkVisFunTys more_arg_tys res_ty - ; wrap <- tcSubTypeDS AppOrigin GenSigCtxt unif_fun_ty fun_ty + ; wrap <- tcSubType AppOrigin ctx unif_fun_ty fun_ty -- Not a good origin at all :-( - ; return (result, wrap) } + ; return (wrap, result) } ------------ mk_ctxt :: [ExpSigmaType] -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc) @@ -220,36 +232,54 @@ matchExpectedFunTys herald arity orig_ty thing_inside -- Like 'matchExpectedFunTys', but used when you have an "actual" type, -- for example in function application -matchActualFunTys :: SDoc -- See Note [Herald for matchExpectedFunTys] - -> CtOrigin - -> Maybe (HsExpr GhcRn) -- the thing with type TcSigmaType - -> Arity - -> TcSigmaType - -> TcM (HsWrapper, [TcSigmaType], TcSigmaType) --- If matchActualFunTys n ty = (wrap, [t1,..,tn], ty_r) --- then wrap : ty ~> (t1 -> ... -> tn -> ty_r) -matchActualFunTys herald ct_orig mb_thing n_val_args_wanted fun_ty - = matchActualFunTysPart herald ct_orig mb_thing - n_val_args_wanted [] - n_val_args_wanted fun_ty - --- | Variant of 'matchActualFunTys' that works when supplied only part --- (that is, to the right of some arrows) of the full function type -matchActualFunTysPart +matchActualFunTysRho :: SDoc -- See Note [Herald for matchExpectedFunTys] + -> CtOrigin + -> Maybe (HsExpr GhcRn) -- the thing with type TcSigmaType + -> Arity + -> TcSigmaType + -> TcM (HsWrapper, [TcSigmaType], TcRhoType) +-- If matchActualFunTysRho n ty = (wrap, [t1,..,tn], res_ty) +-- then wrap : ty ~> (t1 -> ... -> tn -> res_ty) +-- and res_ty is a RhoType +-- NB: the returned type is top-instantiated; it's a RhoType +matchActualFunTysRho herald ct_orig mb_thing n_val_args_wanted fun_ty + = go n_val_args_wanted [] fun_ty + where + go 0 _ fun_ty + = do { (wrap, rho) <- topInstantiate ct_orig fun_ty + ; return (wrap, [], rho) } + go n so_far fun_ty + = do { (wrap_fun1, arg_ty1, res_ty1) <- matchActualFunTySigma + herald ct_orig mb_thing + (n_val_args_wanted, so_far) + fun_ty + ; (wrap_res, arg_tys, res_ty) <- go (n-1) (arg_ty1:so_far) res_ty1 + ; let wrap_fun2 = mkWpFun idHsWrapper wrap_res arg_ty1 res_ty doc + ; return (wrap_fun2 <.> wrap_fun1, arg_ty1:arg_tys, res_ty) } + where + doc = text "When inferring the argument type of a function with type" <+> + quotes (ppr fun_ty) + +-- | matchActualFunTySigm does looks for just one function arrow +-- returning an uninstantiated sigma-type +matchActualFunTySigma :: SDoc -- See Note [Herald for matchExpectedFunTys] -> CtOrigin - -> Maybe (HsExpr GhcRn) -- The thing with type TcSigmaType - -> Arity -- Total number of value args in the call - -> [TcSigmaType] -- Types of values args to which function has - -- been applied already (reversed) - -> Arity -- Number of new value args wanted - -> TcSigmaType -- Type to analyse - -> TcM (HsWrapper, [TcSigmaType], TcSigmaType) + -> Maybe (HsExpr GhcRn) -- The thing with type TcSigmaType + -> (Arity, [TcSigmaType]) -- Total number of value args in the call, and + -- types of values args to which function has + -- been applied already (reversed) + -- Both are used only for error messages) + -> TcSigmaType -- Type to analyse + -> TcM (HsWrapper, TcSigmaType, TcSigmaType) -- See Note [matchActualFunTys error handling] for all these arguments -matchActualFunTysPart herald ct_orig mb_thing - n_val_args_in_call arg_tys_so_far - n_val_args_wanted fun_ty - = go n_val_args_wanted arg_tys_so_far fun_ty + +-- If (wrap, arg_ty, res_ty) = matchActualFunTySigma ... fun_ty +-- then wrap :: fun_ty ~> (arg_ty -> res_ty) +-- and NB: res_ty is an (uninstantiated) SigmaType + +matchActualFunTySigma herald ct_orig mb_thing err_info fun_ty + = go fun_ty -- Does not allocate unnecessary meta variables: if the input already is -- a function, we just take it apart. Not only is this efficient, -- it's important for higher rank: the argument might be of form @@ -264,52 +294,28 @@ matchActualFunTysPart herald ct_orig mb_thing -- in elsewhere). where - -- This function has a bizarre mechanic: it accumulates arguments on - -- the way down and also builds an argument list on the way up. Why: - -- 1. The returns args list and the accumulated args list might be different. - -- The accumulated args include all the arg types for the function, - -- including those from before this function was called. The returned - -- list should include only those arguments produced by this call of - -- matchActualFunTys - -- - -- 2. The HsWrapper can be built only on the way up. It seems (more) - -- bizarre to build the HsWrapper but not the arg_tys. - -- - -- Refactoring is welcome. - go :: Arity - -> [TcSigmaType] -- Types of value args to which the function has - -- been applied so far (reversed) - -- Used only for error messages - -> TcSigmaType -- the remainder of the type as we're processing - -> TcM (HsWrapper, [TcSigmaType], TcSigmaType) - go 0 _ ty = return (idHsWrapper, [], ty) - - go n so_far ty + go :: TcSigmaType -- The remainder of the type as we're processing + -> TcM (HsWrapper, TcSigmaType, TcSigmaType) + go ty | Just ty' <- tcView ty = go ty' + + go ty | not (null tvs && null theta) = do { (wrap1, rho) <- topInstantiate ct_orig ty - ; (wrap2, arg_tys, res_ty) <- go n so_far rho - ; return (wrap2 <.> wrap1, arg_tys, res_ty) } + ; (wrap2, arg_ty, res_ty) <- go rho + ; return (wrap2 <.> wrap1, arg_ty, res_ty) } where (tvs, theta, _) = tcSplitSigmaTy ty - go n so_far ty - | Just ty' <- tcView ty = go n so_far ty' - - go n so_far (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty }) + go (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty }) = ASSERT( af == VisArg ) - do { (wrap_res, tys, ty_r) <- go (n-1) (arg_ty:so_far) res_ty - ; return ( mkWpFun idHsWrapper wrap_res arg_ty ty_r doc - , arg_ty : tys, ty_r ) } - where - doc = text "When inferring the argument type of a function with type" <+> - quotes (ppr fun_ty) + return (idHsWrapper, arg_ty, res_ty) - go n so_far ty@(TyVarTy tv) + go ty@(TyVarTy tv) | isMetaTyVar tv = do { cts <- readMetaTyVar tv ; case cts of - Indirect ty' -> go n so_far ty' - Flexi -> defer n ty } + Indirect ty' -> go ty' + Flexi -> defer ty } -- In all other cases we bale out into ordinary unification -- However unlike the meta-tyvar case, we are sure that the @@ -326,22 +332,23 @@ matchActualFunTysPart herald ct_orig mb_thing -- -- But in that case we add specialized type into error context -- anyway, because it may be useful. See also #9605. - go n so_far ty = addErrCtxtM (mk_ctxt so_far ty) (defer n ty) + go ty = addErrCtxtM (mk_ctxt ty) (defer ty) ------------ - defer n fun_ty - = do { arg_tys <- replicateM n newOpenFlexiTyVarTy - ; res_ty <- newOpenFlexiTyVarTy - ; let unif_fun_ty = mkVisFunTys arg_tys res_ty + defer fun_ty + = do { arg_ty <- newOpenFlexiTyVarTy + ; res_ty <- newOpenFlexiTyVarTy + ; let unif_fun_ty = mkVisFunTy arg_ty res_ty ; co <- unifyType mb_thing fun_ty unif_fun_ty - ; return (mkWpCastN co, arg_tys, res_ty) } + ; return (mkWpCastN co, arg_ty, res_ty) } ------------ - mk_ctxt :: [TcType] -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc) - mk_ctxt arg_tys res_ty env + mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc) + mk_ctxt res_ty env = do { (env', ty) <- zonkTidyTcType env $ - mkVisFunTys (reverse arg_tys) res_ty + mkVisFunTys (reverse arg_tys_so_far) res_ty ; return (env', mk_fun_tys_msg herald ty n_val_args_in_call) } + (n_val_args_in_call, arg_tys_so_far) = err_info mk_fun_tys_msg :: SDoc -> TcType -> Arity -> SDoc mk_fun_tys_msg herald ty n_args_in_call @@ -491,95 +498,51 @@ a place expecting a value of type expected_ty. I.e. that actual ty is more polymorphic than expected_ty -It returns a coercion function +It returns a wrapper function co_fn :: actual_ty ~ expected_ty which takes an HsExpr of type actual_ty into one of type expected_ty. - -These functions do not actually check for subsumption. They check if -expected_ty is an appropriate annotation to use for something of type -actual_ty. This difference matters when thinking about visible type -application. For example, - - forall a. a -> forall b. b -> b - DOES NOT SUBSUME - forall a b. a -> b -> b - -because the type arguments appear in a different order. (Neither does -it work the other way around.) BUT, these types are appropriate annotations -for one another. Because the user directs annotations, it's OK if some -arguments shuffle around -- after all, it's what the user wants. -Bottom line: none of this changes with visible type application. - -There are a number of wrinkles (below). - -Notice that Wrinkle 1 and 2 both require eta-expansion, which technically -may increase termination. We just put up with this, in exchange for getting -more predictable type inference. - -Wrinkle 1: Note [Deep skolemisation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We want (forall a. Int -> a -> a) <= (Int -> forall a. a->a) -(see section 4.6 of "Practical type inference for higher rank types") -So we must deeply-skolemise the RHS before we instantiate the LHS. - -That is why tc_sub_type starts with a call to tcSkolemise (which does the -deep skolemisation), and then calls the DS variant (which assumes -that expected_ty is deeply skolemised) - -Wrinkle 2: Note [Co/contra-variance of subsumption checking] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider g :: (Int -> Int) -> Int - f1 :: (forall a. a -> a) -> Int - f1 = g - - f2 :: (forall a. a -> a) -> Int - f2 x = g x -f2 will typecheck, and it would be odd/fragile if f1 did not. -But f1 will only typecheck if we have that - (Int->Int) -> Int <= (forall a. a->a) -> Int -And that is only true if we do the full co/contravariant thing -in the subsumption check. That happens in the FunTy case of -tcSubTypeDS_NC_O, and is the sole reason for the WpFun form of -HsWrapper. - -Another powerful reason for doing this co/contra stuff is visible -in #9569, involving instantiation of constraint variables, -and again involving eta-expansion. - -Wrinkle 3: Note [Higher rank types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider tc150: - f y = \ (x::forall a. a->a). blah -The following happens: -* We will infer the type of the RHS, ie with a res_ty = alpha. -* Then the lambda will split alpha := beta -> gamma. -* And then we'll check tcSubType IsSwapped beta (forall a. a->a) - -So it's important that we unify beta := forall a. a->a, rather than -skolemising the type. -} --- | Call this variant when you are in a higher-rank situation and --- you know the right-hand type is deeply skolemised. -tcSubTypeHR :: CtOrigin -- ^ of the actual type - -> Maybe (HsExpr GhcRn) -- ^ If present, it has type ty_actual - -> TcSigmaType -> ExpRhoType -> TcM HsWrapper -tcSubTypeHR orig = tcSubTypeDS_NC_O orig GenSigCtxt +----------------- +-- tcWrapResult needs both un-type-checked (for origins and error messages) +-- and type-checked (for wrapping) expressions +tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType + -> TcM (HsExpr GhcTcId) +tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr + +tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType + -> TcM (HsExpr GhcTcId) +tcWrapResultO orig rn_expr expr actual_ty res_ty + = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty + , text "Expected:" <+> ppr res_ty ]) + ; wrap <- tcSubTypeNC orig GenSigCtxt (Just rn_expr) actual_ty res_ty + ; return (mkHsWrap wrap expr) } + +tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTcId + -> TcRhoType -- Actual -- a rho-type not a sigma-type + -> ExpRhoType -- Expected + -> TcM (HsExpr GhcTcId) +-- A version of tcWrapResult to use when the actual type is a +-- rho-type, so nothing to instantiate; just go straight to unify. +-- 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 rn_expr) act_ty exp_ty + ; return (mkHsWrapCo co expr) } ------------------------ tcSubTypePat :: CtOrigin -> UserTypeCtxt -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper +-- Used in patterns; polarity is backwards compared +-- to tcSubType -- If wrap = tc_sub_type_et t1 t2 -- => wrap :: t1 ~> t2 -tcSubTypePat orig ctxt (Check ty_actual) ty_expected - = tc_sub_tc_type eq_orig orig ctxt ty_actual ty_expected - where - eq_orig = TypeEqOrigin { uo_actual = ty_expected - , uo_expected = ty_actual - , uo_thing = Nothing - , uo_visible = True } +tcSubTypePat inst_orig ctxt (Check ty_actual) ty_expected + = tc_sub_type unifyTypeET inst_orig ctxt ty_actual ty_expected tcSubTypePat _ _ (Infer inf_res) ty_expected = do { co <- fillInferResult ty_expected inf_res @@ -587,106 +550,72 @@ tcSubTypePat _ _ (Infer inf_res) ty_expected ; return (mkWpCastN (mkTcSymCo co)) } ------------------------- -tcSubTypeO :: CtOrigin -- ^ of the actual type - -> UserTypeCtxt -- ^ of the expected type - -> TcSigmaType - -> ExpRhoType - -> TcM HsWrapper -tcSubTypeO orig ctxt ty_actual ty_expected +--------------- +tcSubType :: CtOrigin -> UserTypeCtxt + -> TcSigmaType -- Actual + -> ExpRhoType -- Expected + -> TcM HsWrapper +-- Checks that 'actual' is more polymorphic than 'expected' +tcSubType orig ctxt ty_actual ty_expected = addSubTypeCtxt ty_actual ty_expected $ - do { traceTc "tcSubTypeDS_O" (vcat [ pprCtOrigin orig - , pprUserTypeCtxt ctxt - , ppr ty_actual - , ppr ty_expected ]) - ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected } - -addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a -addSubTypeCtxt ty_actual ty_expected thing_inside - | isRhoTy ty_actual -- If there is no polymorphism involved, the - , isRhoExpTy ty_expected -- TypeEqOrigin stuff (added by the _NC functions) - = thing_inside -- gives enough context by itself - | otherwise - = addErrCtxtM mk_msg thing_inside - where - mk_msg tidy_env - = do { (tidy_env, ty_actual) <- zonkTidyTcType tidy_env ty_actual - -- might not be filled if we're debugging. ugh. - ; mb_ty_expected <- readExpType_maybe ty_expected - ; (tidy_env, ty_expected) <- case mb_ty_expected of - Just ty -> second mkCheckExpType <$> - zonkTidyTcType tidy_env ty - Nothing -> return (tidy_env, ty_expected) - ; ty_expected <- readExpType ty_expected - ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected - ; let msg = vcat [ hang (text "When checking that:") - 4 (ppr ty_actual) - , nest 2 (hang (text "is more polymorphic than:") - 2 (ppr ty_expected)) ] - ; return (tidy_env, msg) } + do { traceTc "tcSubType" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected]) + ; tcSubTypeNC orig ctxt Nothing ty_actual ty_expected } + +tcSubTypeNC :: CtOrigin -- Used when instantiating + -> UserTypeCtxt -- Used when skolemising + -> Maybe (HsExpr GhcRn) -- The expression that has type 'actual' (if known) + -> TcSigmaType -- Actual type + -> ExpRhoType -- Expected type + -> TcM HsWrapper +tcSubTypeNC inst_orig ctxt m_thing ty_actual res_ty + = case res_ty of + Infer inf_res -> instantiateAndFillInferResult inst_orig ty_actual inf_res + Check ty_expected -> tc_sub_type (unifyType m_thing) inst_orig ctxt + ty_actual ty_expected --------------- --- The "_NC" variants do not add a typechecker-error context; --- the caller is assumed to do that - -tcSubType_NC :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper +tcSubTypeSigma :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper +-- External entry point, but no ExpTypes on either side -- Checks that actual <= expected -- Returns HsWrapper :: actual ~ expected -tcSubType_NC ctxt ty_actual ty_expected - = do { traceTc "tcSubType_NC" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected]) - ; tc_sub_tc_type origin origin ctxt ty_actual ty_expected } +tcSubTypeSigma ctxt ty_actual ty_expected + = tc_sub_type (unifyType Nothing) eq_orig ctxt ty_actual ty_expected where - origin = TypeEqOrigin { uo_actual = ty_actual - , uo_expected = ty_expected - , uo_thing = Nothing - , uo_visible = True } - -tcSubTypeDS :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> ExpRhoType -> TcM HsWrapper --- Just like tcSubType, but with the additional precondition that --- ty_expected is deeply skolemised (hence "DS") -tcSubTypeDS orig ctxt ty_actual ty_expected - = addSubTypeCtxt ty_actual ty_expected $ - do { traceTc "tcSubTypeDS_NC" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected]) - ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected } - -tcSubTypeDS_NC_O :: CtOrigin -- origin used for instantiation only - -> UserTypeCtxt - -> Maybe (HsExpr GhcRn) - -> TcSigmaType -> ExpRhoType -> TcM HsWrapper --- Just like tcSubType, but with the additional precondition that --- ty_expected is deeply skolemised -tcSubTypeDS_NC_O inst_orig ctxt m_thing ty_actual ty_expected - = case ty_expected of - Infer inf_res -> instantiateAndFillInferResult inst_orig ty_actual inf_res - Check ty -> tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty - where - eq_orig = TypeEqOrigin { uo_actual = ty_actual, uo_expected = ty - , uo_thing = ppr <$> m_thing - , uo_visible = True } + eq_orig = TypeEqOrigin { uo_actual = ty_actual + , uo_expected = ty_expected + , uo_thing = Nothing + , uo_visible = True } --------------- -tc_sub_tc_type :: CtOrigin -- used when calling uType - -> CtOrigin -- used when instantiating - -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper +tc_sub_type :: (TcType -> TcType -> TcM TcCoercionN) -- How to unify + -> CtOrigin -- Used when instantiating + -> UserTypeCtxt -- Used when skolemising + -> TcSigmaType -- Actual; a sigma-type + -> TcSigmaType -- Expected; also a sigma-type + -> TcM HsWrapper +-- Checks that actual_ty is more polymorphic than expected_ty -- If wrap = tc_sub_type t1 t2 -- => wrap :: t1 ~> t2 -tc_sub_tc_type eq_orig inst_orig ctxt ty_actual ty_expected +tc_sub_type unify inst_orig ctxt ty_actual ty_expected | definitely_poly ty_expected -- See Note [Don't skolemise unnecessarily] , not (possibly_poly ty_actual) - = do { traceTc "tc_sub_tc_type (drop to equality)" $ + = do { traceTc "tc_sub_type (drop to equality)" $ vcat [ text "ty_actual =" <+> ppr ty_actual , text "ty_expected =" <+> ppr ty_expected ] ; mkWpCastN <$> - uType TypeLevel eq_orig ty_actual ty_expected } + unify ty_actual ty_expected } | otherwise -- This is the general case - = do { traceTc "tc_sub_tc_type (general case)" $ + = do { traceTc "tc_sub_type (general case)" $ vcat [ text "ty_actual =" <+> ppr ty_actual , text "ty_expected =" <+> ppr ty_expected ] - ; (sk_wrap, inner_wrap) <- tcSkolemise ctxt ty_expected $ - \ _ sk_rho -> - tc_sub_type_ds eq_orig inst_orig ctxt - ty_actual sk_rho + + ; (sk_wrap, inner_wrap) + <- tcSkolemise ctxt ty_expected $ \ sk_rho -> + do { (wrap, rho_a) <- topInstantiate inst_orig ty_actual + ; cow <- unify rho_a sk_rho + ; return (mkWpCastN cow <.> wrap) } + ; return (sk_wrap <.> inner_wrap) } where possibly_poly ty @@ -705,6 +634,31 @@ tc_sub_tc_type eq_orig inst_orig ctxt ty_actual ty_expected | otherwise = False +------------------------ +addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a +addSubTypeCtxt ty_actual ty_expected thing_inside + | isRhoTy ty_actual -- If there is no polymorphism involved, the + , isRhoExpTy ty_expected -- TypeEqOrigin stuff (added by the _NC functions) + = thing_inside -- gives enough context by itself + | otherwise + = addErrCtxtM mk_msg thing_inside + where + mk_msg tidy_env + = do { (tidy_env, ty_actual) <- zonkTidyTcType tidy_env ty_actual + -- might not be filled if we're debugging. ugh. + ; mb_ty_expected <- readExpType_maybe ty_expected + ; (tidy_env, ty_expected) <- case mb_ty_expected of + Just ty -> second mkCheckExpType <$> + zonkTidyTcType tidy_env ty + Nothing -> return (tidy_env, ty_expected) + ; ty_expected <- readExpType ty_expected + ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected + ; let msg = vcat [ hang (text "When checking that:") + 4 (ppr ty_actual) + , nest 2 (hang (text "is more polymorphic than:") + 2 (ppr ty_expected)) ] + ; return (tidy_env, msg) } + {- Note [Don't skolemise unnecessarily] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we are trying to solve @@ -740,98 +694,9 @@ accept (e.g. #13752). So the test (which is only to improve error message) is very conservative: * ty_actual is /definitely/ monomorphic * ty_expected is /definitely/ polymorphic --} - ---------------- -tc_sub_type_ds :: CtOrigin -- used when calling uType - -> CtOrigin -- used when instantiating - -> UserTypeCtxt -> TcSigmaType -> TcRhoType -> TcM HsWrapper --- If wrap = tc_sub_type_ds t1 t2 --- => wrap :: t1 ~> t2 --- Here is where the work actually happens! --- Precondition: ty_expected is deeply skolemised -tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected - = do { traceTc "tc_sub_type_ds" $ - vcat [ text "ty_actual =" <+> ppr ty_actual - , text "ty_expected =" <+> ppr ty_expected ] - ; go ty_actual ty_expected } - where - go ty_a ty_e | Just ty_a' <- tcView ty_a = go ty_a' ty_e - | Just ty_e' <- tcView ty_e = go ty_a ty_e' - go (TyVarTy tv_a) ty_e - = do { lookup_res <- lookupTcTyVar tv_a - ; case lookup_res of - Filled ty_a' -> - do { traceTc "tcSubTypeDS_NC_O following filled act meta-tyvar:" - (ppr tv_a <+> text "-->" <+> ppr ty_a') - ; tc_sub_type_ds eq_orig inst_orig ctxt ty_a' ty_e } - Unfilled _ -> unify } - - -- Historical note (Sept 16): there was a case here for - -- go ty_a (TyVarTy alpha) - -- which, in the impredicative case unified alpha := ty_a - -- where th_a is a polytype. Not only is this probably bogus (we - -- simply do not have decent story for impredicative types), but it - -- caused #12616 because (also bizarrely) 'deriving' code had - -- -XImpredicativeTypes on. I deleted the entire case. - - go (FunTy { ft_af = VisArg, ft_arg = act_arg, ft_res = act_res }) - (FunTy { ft_af = VisArg, ft_arg = exp_arg, ft_res = exp_res }) - = -- See Note [Co/contra-variance of subsumption checking] - do { res_wrap <- tc_sub_type_ds eq_orig inst_orig ctxt act_res exp_res - ; arg_wrap <- tc_sub_tc_type eq_orig given_orig GenSigCtxt exp_arg act_arg - -- GenSigCtxt: See Note [Setting the argument context] - ; return (mkWpFun arg_wrap res_wrap exp_arg exp_res doc) } - -- arg_wrap :: exp_arg ~> act_arg - -- res_wrap :: act-res ~> exp_res - where - given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg []) - doc = text "When checking that" <+> quotes (ppr ty_actual) <+> - text "is more polymorphic than" <+> quotes (ppr ty_expected) - - go ty_a ty_e - | let (tvs, theta, _) = tcSplitSigmaTy ty_a - , not (null tvs && null theta) - = do { (in_wrap, in_rho) <- topInstantiate inst_orig ty_a - ; body_wrap <- tc_sub_type_ds - (eq_orig { uo_actual = in_rho - , uo_expected = ty_expected }) - inst_orig ctxt in_rho ty_e - ; return (body_wrap <.> in_wrap) } - - | otherwise -- Revert to unification - = inst_and_unify - -- It's still possible that ty_actual has nested foralls. Instantiate - -- these, as there's no way unification will succeed with them in. - -- See typecheck/should_compile/T11305 for an example of when this - -- is important. The problem is that we're checking something like - -- a -> forall b. b -> b <= alpha beta gamma - -- where we end up with alpha := (->) - - inst_and_unify = do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual - - -- If we haven't recurred through an arrow, then - -- the eq_orig will list ty_actual. In this case, - -- we want to update the origin to reflect the - -- instantiation. If we *have* recurred through - -- an arrow, it's better not to update. - ; let eq_orig' = case eq_orig of - TypeEqOrigin { uo_actual = orig_ty_actual } - | orig_ty_actual `tcEqType` ty_actual - , not (isIdHsWrapper wrap) - -> eq_orig { uo_actual = rho_a } - _ -> eq_orig - - ; cow <- uType TypeLevel eq_orig' rho_a ty_expected - ; return (mkWpCastN cow <.> wrap) } - - - -- use versions without synonyms expanded - unify = mkWpCastN <$> uType TypeLevel eq_orig ty_actual ty_expected - -{- Note [Settting the argument context] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Settting the argument context] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider we are doing the ambiguity check for the (bogus) f :: (forall a b. C b => a -> a) -> Int @@ -857,24 +722,6 @@ to a UserTypeCtxt of GenSigCtxt. Why? See Note [When to build an implication] -} ------------------ --- needs both un-type-checked (for origins) and type-checked (for wrapping) --- expressions -tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType - -> TcM (HsExpr GhcTcId) -tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr - --- | Sometimes we don't have a @HsExpr Name@ to hand, and this is more --- convenient. -tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType - -> TcM (HsExpr GhcTcId) -tcWrapResultO orig rn_expr expr actual_ty res_ty - = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty - , text "Expected:" <+> ppr res_ty ]) - ; cow <- tcSubTypeDS_NC_O orig GenSigCtxt - (Just rn_expr) actual_ty res_ty - ; return (mkHsWrap cow expr) } - {- ********************************************************************** %* * @@ -896,7 +743,7 @@ instantiateAndFillInferResult :: CtOrigin -> TcType -> InferResult -> TcM HsWrap -- => wrap :: t1 ~> t2 -- See Note [Instantiation of InferResult] instantiateAndFillInferResult orig ty inf_res - = do { (wrap, rho) <- deeplyInstantiate orig ty + = do { (wrap, rho) <- topInstantiate orig ty ; co <- fillInferResult rho inf_res ; return (mkWpCastN co <.> wrap) } @@ -1090,48 +937,64 @@ the thinking. * * ********************************************************************* -} --- | Take an "expected type" and strip off quantifiers to expose the --- type underneath, binding the new skolems for the @thing_inside@. --- The returned 'HsWrapper' has type @specific_ty -> expected_ty@. -tcSkolemise :: UserTypeCtxt -> TcSigmaType - -> ([TcTyVar] -> TcType -> TcM result) - -- ^ These are only ever used for scoped type variables. - -> TcM (HsWrapper, result) - -- ^ The expression has type: spec_ty -> expected_ty +{- Note [Skolemisation] +~~~~~~~~~~~~~~~~~~~~~~~ +tcSkolemise takes "expected type" and strip off quantifiers to expose the +type underneath, binding the new skolems for the 'thing_inside' +The returned 'HsWrapper' has type (specific_ty -> expected_ty). + +Note that for a nested type like + forall a. Eq a => forall b. Ord b => blah +we still only build one implication constraint + forall a b. (Eq a, Ord b) => <constraints> +This is just an optimisation, but it's why we use topSkolemise to +build the pieces from all the layers, before making a single call +to checkConstraints. + +tcSkolemiseScoped is very similar, but differs in two ways: + +* It deals specially with just the outer forall, bringing those + type variables into lexical scope. To my surprise, I found that + doing this regardless (in tcSkolemise) caused a non-trivial (1%-ish) + perf hit on the compiler. + +* It always calls checkConstraints, even if there are no skolem + variables at all. Reason: there might be nested deferred errors + that must not be allowed to float to top level. + See Note [When to build an implication] below. +-} + +tcSkolemise, tcSkolemiseScoped + :: UserTypeCtxt -> TcSigmaType + -> (TcType -> TcM result) + -> TcM (HsWrapper, result) + -- ^ The wrapper has type: spec_ty ~> expected_ty + +tcSkolemiseScoped ctxt expected_ty thing_inside + = do { (wrap, tv_prs, given, rho_ty) <- topSkolemise expected_ty + ; let skol_tvs = map snd tv_prs + skol_info = SigSkol ctxt expected_ty tv_prs + + ; (ev_binds, res) + <- checkConstraints skol_info skol_tvs given $ + tcExtendNameTyVarEnv tv_prs $ + thing_inside rho_ty + + ; return (wrap <.> mkWpLet ev_binds, res) } tcSkolemise ctxt expected_ty thing_inside - -- We expect expected_ty to be a forall-type - -- If not, the call is a no-op - = do { traceTc "tcSkolemise" Outputable.empty - ; (wrap, tv_prs, given, rho') <- deeplySkolemise expected_ty - - ; lvl <- getTcLevel - ; when debugIsOn $ - traceTc "tcSkolemise" $ vcat [ - ppr lvl, - text "expected_ty" <+> ppr expected_ty, - text "inst tyvars" <+> ppr tv_prs, - text "given" <+> ppr given, - text "inst type" <+> ppr rho' ] - - -- Generally we must check that the "forall_tvs" haven't been constrained - -- The interesting bit here is that we must include the free variables - -- of the expected_ty. Here's an example: - -- runST (newVar True) - -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool)) - -- for (newVar True), with s fresh. Then we unify with the runST's arg type - -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool. - -- So now s' isn't unconstrained because it's linked to a. - -- - -- However [Oct 10] now that the untouchables are a range of - -- TcTyVars, all this is handled automatically with no need for - -- extra faffing around + | isRhoTy expected_ty -- Short cut for common case + = do { res <- thing_inside expected_ty + ; return (idHsWrapper, res) } + | otherwise + = do { (wrap, tv_prs, given, rho_ty) <- topSkolemise expected_ty - ; let tvs' = map snd tv_prs + ; let skol_tvs = map snd tv_prs skol_info = SigSkol ctxt expected_ty tv_prs - ; (ev_binds, result) <- checkConstraints skol_info tvs' given $ - thing_inside tvs' rho' + ; (ev_binds, result) + <- checkConstraints skol_info skol_tvs given $ + thing_inside rho_ty ; return (wrap <.> mkWpLet ev_binds, result) } -- The ev_binds returned by checkConstraints is very @@ -1144,7 +1007,8 @@ tcSkolemiseET :: UserTypeCtxt -> ExpSigmaType tcSkolemiseET _ et@(Infer {}) thing_inside = (idHsWrapper, ) <$> thing_inside et tcSkolemiseET ctxt (Check ty) thing_inside - = tcSkolemise ctxt ty $ \_ -> thing_inside . mkCheckExpType + = tcSkolemise ctxt ty $ \rho_ty -> + thing_inside (mkCheckExpType rho_ty) checkConstraints :: SkolemInfo -> [TcTyVar] -- Skolems @@ -1162,7 +1026,7 @@ checkConstraints skol_info skol_tvs given thing_inside ; emitImplications implics ; return (ev_binds, result) } - else -- Fast path. We check every function argument with tcCheckExpr, + else -- Fast path. We check every function argument with tcCheckPolyExpr, -- which uses tcSkolemise and hence checkConstraints. -- So this fast path is well-exercised do { res <- thing_inside @@ -1175,38 +1039,33 @@ checkTvConstraints :: SkolemInfo checkTvConstraints skol_info skol_tvs thing_inside = do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside - ; emitResidualTvConstraint skol_info Nothing skol_tvs tclvl wanted + ; emitResidualTvConstraint skol_info skol_tvs tclvl wanted ; return result } -emitResidualTvConstraint :: SkolemInfo -> Maybe SDoc -> [TcTyVar] +emitResidualTvConstraint :: SkolemInfo -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM () -emitResidualTvConstraint skol_info m_telescope skol_tvs tclvl wanted +emitResidualTvConstraint skol_info skol_tvs tclvl wanted | isEmptyWC wanted - , isNothing m_telescope || skol_tvs `lengthAtMost` 1 - -- If m_telescope is (Just d), we must do the bad-telescope check, - -- so we must /not/ discard the implication even if there are no - -- wanted constraints. See Note [Checking telescopes] in GHC.Tc.Types.Constraint. - -- Lacking this check led to #16247 = return () | otherwise - = do { ev_binds <- newNoTcEvBinds + = do { implic <- buildTvImplication skol_info skol_tvs tclvl wanted + ; emitImplication implic } + +buildTvImplication :: SkolemInfo -> [TcTyVar] + -> TcLevel -> WantedConstraints -> TcM Implication +buildTvImplication skol_info skol_tvs tclvl wanted + = do { ev_binds <- newNoTcEvBinds -- Used for equalities only, so all the constraints + -- are solved by filling in coercion holes, not + -- by creating a value-level evidence binding ; implic <- newImplication - ; let status | insolubleWC wanted = IC_Insoluble - | otherwise = IC_Unsolved - -- If the inner constraints are insoluble, - -- we should mark the outer one similarly, - -- so that insolubleWC works on the outer one - - ; emitImplication $ - implic { ic_status = status - , ic_tclvl = tclvl - , ic_skols = skol_tvs - , ic_no_eqs = True - , ic_telescope = m_telescope - , ic_wanted = wanted - , ic_binds = ev_binds - , ic_info = skol_info } } + + ; return (implic { ic_tclvl = tclvl + , ic_skols = skol_tvs + , ic_no_eqs = True + , ic_wanted = wanted + , ic_binds = ev_binds + , ic_info = skol_info }) } implicationNeeded :: SkolemInfo -> [TcTyVar] -> [EvVar] -> TcM Bool -- See Note [When to build an implication] @@ -1319,21 +1178,35 @@ unifyType :: Maybe (HsExpr GhcRn) -- ^ If present, has type 'ty1' -> TcTauType -> TcTauType -> TcM TcCoercionN -- Actual and expected types -- Returns a coercion : ty1 ~ ty2 -unifyType thing ty1 ty2 = traceTc "utype" (ppr ty1 $$ ppr ty2 $$ ppr thing) >> - uType TypeLevel origin ty1 ty2 +unifyType thing ty1 ty2 + = uType TypeLevel origin ty1 ty2 where - origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 - , uo_thing = ppr <$> thing - , uo_visible = True } -- always called from a visible context + origin = TypeEqOrigin { uo_actual = ty1 + , uo_expected = ty2 + , uo_thing = ppr <$> thing + , uo_visible = True } + +unifyTypeET :: TcTauType -> TcTauType -> TcM CoercionN +-- Like unifyType, but swap expected and actual in error messages +-- This is used when typechecking patterns +unifyTypeET ty1 ty2 + = uType TypeLevel origin ty1 ty2 + where + origin = TypeEqOrigin { uo_actual = ty2 -- NB swapped + , uo_expected = ty1 -- NB swapped + , uo_thing = Nothing + , uo_visible = True } + unifyKind :: Maybe (HsType GhcRn) -> TcKind -> TcKind -> TcM CoercionN -unifyKind thing ty1 ty2 = traceTc "ukind" (ppr ty1 $$ ppr ty2 $$ ppr thing) >> - uType KindLevel origin ty1 ty2 - where origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 - , uo_thing = ppr <$> thing - , uo_visible = True } -- also always from a visible context +unifyKind thing ty1 ty2 + = uType KindLevel origin ty1 ty2 + where + origin = TypeEqOrigin { uo_actual = ty1 + , uo_expected = ty2 + , uo_thing = ppr <$> thing + , uo_visible = True } ---------------- {- %************************************************************************ @@ -1639,7 +1512,7 @@ uUnfilledVar1 origin t_or_k swapped tv1 ty2 go tv2 | tv1 == tv2 -- Same type variable => no-op = return (mkNomReflCo (mkTyVarTy tv1)) - | swapOverTyVars tv1 tv2 -- Distinct type variables + | swapOverTyVars False tv1 tv2 -- Distinct type variables -- Swap meta tyvar to the left if poss = do { tv1 <- zonkTyCoVarKind tv1 -- We must zonk tv1's kind because that might @@ -1696,8 +1569,12 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2 -swapOverTyVars :: TcTyVar -> TcTyVar -> Bool -swapOverTyVars tv1 tv2 +swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool +swapOverTyVars is_given tv1 tv2 + -- See Note [Unification variables on the left] + | not is_given, pri1 == 0, pri2 > 0 = True + | not is_given, pri2 == 0, pri1 > 0 = False + -- Level comparison: see Note [TyVar/TyVar orientation] | lvl1 `strictlyDeeperThan` lvl2 = False | lvl2 `strictlyDeeperThan` lvl1 = True @@ -1786,6 +1663,24 @@ So we look for a positive reason to swap, using a three-step test: Uniques. See Note [Eliminate younger unification variables] (which also explains why we don't do this any more) +Note [Unification variables on the left] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For wanteds, but not givens, swap (skolem ~ meta-tv) regardless of +level, so that the unification variable is on the left. + +* We /don't/ want this for Givens because if we ave + [G] a[2] ~ alpha[1] + [W] Bool ~ a[2] + we want to rewrite the wanted to Bool ~ alpha[1], + so we can float the constraint and solve it. + +* But for Wanteds putting the unification variable on + the left means an easier job when floating, and when + reporting errors -- just fewer cases to consider. + + In particular, we get better skolem-escape messages: + see #18114 + Note [Deeper level on the left] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The most important thing is that we want to put tyvars with diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index 4f6b4f5887..32dfc16ea3 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.Data.Maybe -- friends: -import GHC.Tc.Utils.Unify ( tcSubType_NC ) +import GHC.Tc.Utils.Unify ( tcSubTypeSigma ) import GHC.Tc.Solver ( simplifyAmbiguityCheck ) import GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..), AssocInstInfo(..) ) import GHC.Core.TyCo.FVs @@ -216,7 +216,7 @@ checkAmbiguity ctxt ty ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes ; (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $ captureConstraints $ - tcSubType_NC ctxt ty ty + tcSubTypeSigma ctxt ty ty ; simplifyAmbiguityCheck ty wanted ; traceTc "Done ambiguity check for" (ppr ty) } diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs index e97038bf5c..493b5bca94 100644 --- a/compiler/GHC/Types/Var.hs +++ b/compiler/GHC/Types/Var.hs @@ -541,11 +541,12 @@ is all about surface syntax. Therefore, they are kept as separate data types. -- Variable Binder -- -- VarBndr is polymorphic in both var and visibility fields. --- Currently there are six different uses of 'VarBndr': --- * Var.TyVarBinder = VarBndr TyVar ArgFlag --- * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag --- * TyCon.TyConBinder = VarBndr TyVar TyConBndrVis --- * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis +-- Currently there are sevenv different uses of 'VarBndr': +-- * Var.TyVarBinder = VarBndr TyVar ArgFlag +-- * Var.InvisTVBinder = VarBndr TyVar Specificity +-- * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag +-- * TyCon.TyConBinder = VarBndr TyVar TyConBndrVis +-- * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis -- * IfaceType.IfaceForAllBndr = VarBndr IfaceBndr ArgFlag -- * IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis data VarBndr var argf = Bndr var argf @@ -559,8 +560,8 @@ data VarBndr var argf = Bndr var argf -- -- A 'TyVarBinder' is a binder with only TyVar type TyCoVarBinder = VarBndr TyCoVar ArgFlag -type TyVarBinder = VarBndr TyVar ArgFlag -type InvisTVBinder = VarBndr TyVar Specificity +type TyVarBinder = VarBndr TyVar ArgFlag +type InvisTVBinder = VarBndr TyVar Specificity tyVarSpecToBinders :: [VarBndr a Specificity] -> [VarBndr a ArgFlag] tyVarSpecToBinders = map tyVarSpecToBinder diff --git a/docs/users_guide/8.12.1-notes.rst b/docs/users_guide/8.12.1-notes.rst index eb72ca9bde..b15302a78d 100644 --- a/docs/users_guide/8.12.1-notes.rst +++ b/docs/users_guide/8.12.1-notes.rst @@ -86,6 +86,13 @@ Language This change prepares the way for Quick Look impredicativity. +* GHC now implements simplified subsumption, as described in `GHC Proposal #287 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0287-simplify-subsumption.rst>`__. + This change simplifies the type system, and prevents the possiblity of GHC + silently changing the semantics of user programs, but it does mean that some libraries + may need eta-expansion to typecheck. More info here: :ref:`simple-subsumption`. + + This change also prepares the way for Quick Look impredicativity. + * GHC now allows users to manually define the specificity of type variable binders. By marking a variable with braces ``{tyvar}`` or ``{tyvar :: kind}``, it becomes inferred despite appearing in a type signature. This feature diff --git a/docs/users_guide/exts/rank_polymorphism.rst b/docs/users_guide/exts/rank_polymorphism.rst index 32447228c7..e85e4e2989 100644 --- a/docs/users_guide/exts/rank_polymorphism.rst +++ b/docs/users_guide/exts/rank_polymorphism.rst @@ -112,23 +112,11 @@ example: :: Since GHC 8.0 declarations such as ``MkSwizzle'`` will cause an out-of-scope error. -As for type signatures, implicit quantification happens for -non-overloaded types too. So if you write this: :: - - f :: (a -> a) -> a - -it's just as if you had written this: :: - - f :: forall a. (a -> a) -> a - -That is, since the type variable ``a`` isn't in scope, it's implicitly -universally quantified. - You construct values of types ``T1, MonadT, Swizzle`` by applying the constructor to suitable values, just as usual. For example, :: a1 :: T Int - a1 = T1 (\xy->x) 3 + a1 = T1 (\x y->x) 3 a2, a3 :: Swizzle a2 = MkSwizzle sort @@ -142,7 +130,7 @@ constructor to suitable values, just as usual. For example, :: in MkMonad r b - mkTs :: (forall b. b -> b -> b) -> a -> [T a] + mkTs :: (forall b. b -> b -> b) -> a -> a -> [T a] mkTs f x y = [T1 f x, T1 f y] The type of the argument can, as usual, be more general than the type @@ -169,6 +157,52 @@ In the function ``h`` we use the record selectors ``return`` and ``MonadT`` data structure, rather than using pattern matching. +.. _simple-subsumption: + +Subsumption +------------- + +Suppose: :: + + f1 :: (forall a b. Int -> a -> b -> b) -> Bool + g1 :: forall x y. Int -> y -> x -> x + + f2 :: (forall a. (Eq a, Show a) => a -> a) -> Bool + g2 :: forall x. (Show x, Eq x) => Int -> a -> b -> b + +then ``f1 g1`` and ``f2 g2`` are both well typed, despite the +different order of type variables and constraints. What happens is that the +argument is instantiated, and then re-generalised to match the type expected +by the function. + +But this instantiation and re-generalisation happens only at the top level +of a type. In particular, none of this happens if the foralls are underneath an arrow. +For example: :: + + f3 :: (Int -> forall a b. a -> b -> b) -> Bool + g3a :: Int -> forall x y. x -> y -> y + g3b :: forall x. Int -> forall y. x -> y -> y + g3c :: Int -> forall x y. y -> x -> x + + f4 :: (Int -> forall a. (Eq a, Show a) => a -> a) -> Bool + g4 :: Int -> forall x. (Show x, Eq x) => x -> x) -> Bool + +Then the application ``f3 g3a`` is well-typed, becuase ``g3a`` has a type that matches the type +expected by ``f3``. But ``f3 g3b`` is not well typed, because the foralls are in different places. +Nor is ``f3 g3c``, where the foralls are in the same place but the variables are in a different order. +Similarly ``f4 g4`` is not well typed, becuase the constraints appear in a different order. + +These examples can be made to typecheck by eta-expansion. For example ``f3 (\x -> g3b x)`` +is well typed, and similarly ``f3 (\x -> g3c x)`` and ``f4 (\x -> g4 x)``. + +Historical note. Earlier versions of GHC allowed these now-rejected applications, by inserting +automatic eta-expansions, as described in Section 4.6 of `Practical type inference for arbitrary-aank types <https://www.microsoft.com/en-us/research/publication/practical-type-inference-for-arbitrary-rank-types/>`__, where it is +called "deep skolemisation". +But these automatic eta-expansions may silently change the semantics of the user's program, +and deep skolemisation was removed from the language by +`GHC Proposal #287 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0287-simplify-subsumption.rst>`__. +This proposal has many more examples. + .. _higher-rank-type-inference: Type inference diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 36e27dd5b4..de1907f043 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -62,6 +62,7 @@ import GHC.Unit.State ( unitIsTrusted, unsafeGetUnitInfo, getInstalledPackageDet import GHC.Iface.Syntax ( showToHeader ) import GHC.Core.Ppr.TyThing import GHC.Builtin.Names +import GHC.Builtin.Types( stringTyCon_RDR ) import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName ) import GHC.Types.SrcLoc as SrcLoc import qualified GHC.Parser.Lexer as Lexer @@ -1671,7 +1672,7 @@ defineMacro overwrite s = do step <- getGhciStepIO expr <- GHC.parseExpr definition -- > ghciStepIO . definition :: String -> IO String - let stringTy = nlHsTyVar stringTy_RDR + let stringTy = nlHsTyVar stringTyCon_RDR ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step) `mkHsApp` (nlHsPar expr) @@ -1739,7 +1740,7 @@ cmdCmd str = handleSourceError GHC.printException $ do getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs) getGhciStepIO = do ghciTyConName <- GHC.getGHCiMonad - let stringTy = nlHsTyVar stringTy_RDR + let stringTy = nlHsTyVar stringTyCon_RDR ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy body = nlHsVar (getRdrName ghciStepIoMName) diff --git a/libraries/Cabal b/libraries/Cabal -Subproject b744cde70820841f4cfd0626bf99292f5e7edba +Subproject 8dc7f0db292ff1a5b1316127e3652d06ab51f3a diff --git a/libraries/base/tests/T9681.stderr b/libraries/base/tests/T9681.stderr index c3a2f2c3c7..58b4bc7371 100644 --- a/libraries/base/tests/T9681.stderr +++ b/libraries/base/tests/T9681.stderr @@ -1,5 +1,5 @@ T9681.hs:3:9: error: - • No instance for (Num [Char]) arising from a use of ‘+’ + • No instance for (Num String) arising from a use of ‘+’ • In the expression: 1 + "\n" In an equation for ‘foo’: foo = 1 + "\n" diff --git a/libraries/haskeline b/libraries/haskeline -Subproject 463fc49d17bfab846cceba48bccc02ef285e6cb +Subproject 3d3e7c18a44fa904f004e5eac0e666e396f1b3f diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr index 9e32035ebb..5e6bc9899d 100644 --- a/testsuite/tests/ado/T13242a.stderr +++ b/testsuite/tests/ado/T13242a.stderr @@ -1,7 +1,8 @@ T13242a.hs:10:5: error: • Couldn't match expected type ‘a0’ with actual type ‘a’ - ‘a’ is a rigid type variable bound by + because type variable ‘a’ would escape its scope + This (rigid, skolem) type variable is bound by a pattern with constructor: A :: forall a. Eq a => a -> T, in a pattern binding in a 'do' block diff --git a/testsuite/tests/ado/ado002.stderr b/testsuite/tests/ado/ado002.stderr index d7c0b6da68..3402d0df55 100644 --- a/testsuite/tests/ado/ado002.stderr +++ b/testsuite/tests/ado/ado002.stderr @@ -1,7 +1,7 @@ ado002.hs:8:8: error: - • Couldn't match expected type ‘Char -> IO b0’ - with actual type ‘IO Char’ + • Couldn't match expected type: Char -> IO b0 + with actual type: IO Char • The function ‘getChar’ is applied to one value argument, but its type ‘IO Char’ has none In a stmt of a 'do' block: y <- getChar 'a' @@ -12,8 +12,8 @@ ado002.hs:8:8: error: ado002.hs:9:3: error: • Couldn't match type ‘()’ with ‘Int’ - Expected type: IO Int - Actual type: IO () + Expected: IO Int + Actual: IO () • In a stmt of a 'do' block: print (x, y) In the expression: do x <- getChar @@ -43,8 +43,8 @@ ado002.hs:15:13: error: return (y, x) ado002.hs:23:9: error: - • Couldn't match expected type ‘Char -> IO t0’ - with actual type ‘IO Char’ + • Couldn't match expected type: Char -> IO a0 + with actual type: IO Char • The function ‘getChar’ is applied to one value argument, but its type ‘IO Char’ has none In a stmt of a 'do' block: x5 <- getChar x4 diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr index 47024fdfd1..2ac9b26388 100644 --- a/testsuite/tests/ado/ado004.stderr +++ b/testsuite/tests/ado/ado004.stderr @@ -22,9 +22,9 @@ TYPE SIGNATURES (Functor f, Num t, Num b) => (t -> f b) -> f b test2d :: - forall {f :: * -> *} {t1} {b} {t2}. - (Functor f, Num t1, Num b) => - (t1 -> f t2) -> f b + forall {f :: * -> *} {t} {b} {a}. + (Functor f, Num t, Num b) => + (t -> f a) -> f b test3 :: forall {m :: * -> *} {t1} {t2} {a}. (Monad m, Num t1) => @@ -42,5 +42,5 @@ TYPE SIGNATURES (Monad m, Num (m a)) => (m a -> m (m a)) -> p -> m a Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/annotations/should_fail/annfail06.hs b/testsuite/tests/annotations/should_fail/annfail06.hs index 1362f1956e..6fc5ae2cf2 100644 --- a/testsuite/tests/annotations/should_fail/annfail06.hs +++ b/testsuite/tests/annotations/should_fail/annfail06.hs @@ -11,8 +11,8 @@ import Data.Typeable deriving instance Typeable InstancesInWrongModule instance Data InstancesInWrongModule where - gfoldl = undefined - gunfold = undefined + gfoldl k z = undefined + gunfold k z = undefined {-# ANN module InstancesInWrongModule #-} @@ -20,4 +20,4 @@ instance Data InstancesInWrongModule where data Foo = Bar {-# ANN f InstancesInWrongModule #-} -f x = x
\ No newline at end of file +f x = x diff --git a/testsuite/tests/arrows/should_fail/T5380.stderr b/testsuite/tests/arrows/should_fail/T5380.stderr index 8b1c81af99..a116513014 100644 --- a/testsuite/tests/arrows/should_fail/T5380.stderr +++ b/testsuite/tests/arrows/should_fail/T5380.stderr @@ -17,13 +17,13 @@ T5380.hs:7:27: error: T5380.hs:7:34: error: • Couldn't match type ‘not_unit’ with ‘()’ + Expected: () -> not_unit + Actual: () -> () ‘not_unit’ is a rigid type variable bound by the type signature for: testB :: forall not_bool not_unit. not_bool -> (() -> ()) -> () -> not_unit at T5380.hs:6:1-49 - Expected type: () -> not_unit - Actual type: () -> () • In the expression: f In the command: f -< () In the expression: proc () -> if b then f -< () else f -< () diff --git a/testsuite/tests/backpack/should_fail/bkpfail24.stderr b/testsuite/tests/backpack/should_fail/bkpfail24.stderr index 484ebf144b..65a79bf119 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail24.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail24.stderr @@ -24,9 +24,8 @@ bkpfail24.bkp:14:15: error: f :: a -> b (bound at bkpfail24.bkp:14:9) bkpfail24.bkp:19:15: error: - • Couldn't match expected type ‘{H2.T}’ - with actual type ‘{H1.T}’ - NB: ‘{H1.T}’ is defined at bkpfail24.bkp:4:9-14 - ‘{H2.T}’ is defined at bkpfail24.bkp:6:9-14 + • Couldn't match expected type ‘{H2.T}’ with actual type ‘{H1.T}’ + NB: ‘{H2.T}’ is defined at bkpfail24.bkp:6:9-14 + ‘{H1.T}’ is defined at bkpfail24.bkp:4:9-14 • In the expression: x In an equation for ‘g’: g x = x diff --git a/testsuite/tests/boxy/Base1.stderr b/testsuite/tests/boxy/Base1.stderr index 75a8e0cfe2..e9b2144533 100644 --- a/testsuite/tests/boxy/Base1.stderr +++ b/testsuite/tests/boxy/Base1.stderr @@ -1,15 +1,17 @@ Base1.hs:20:13: error: - • Couldn't match type ‘a0 -> a0’ with ‘forall a. a -> a’ - Expected type: MEither Sid b - Actual type: MEither (a0 -> a0) b + • Couldn't match type: a0 -> a0 + with: forall a. a -> a + Expected: MEither Sid b + Actual: MEither (a0 -> a0) b • In the expression: MLeft fid In an equation for ‘test1’: test1 fid = MLeft fid Base1.hs:25:39: error: - • Couldn't match type ‘a1 -> a1’ with ‘forall a. a -> a’ - Expected type: Maybe (Sid, Sid) - Actual type: Maybe (a1 -> a1, a2 -> a2) + • Couldn't match type: a1 -> a1 + with: forall a. a -> a + Expected: Maybe (Sid, Sid) + Actual: Maybe (a1 -> a1, a2 -> a2) • In the expression: Just (x, y) In a case alternative: MRight y -> Just (x, y) In the expression: diff --git a/testsuite/tests/deSugar/should_compile/T10662.stderr b/testsuite/tests/deSugar/should_compile/T10662.stderr index f27fc977b6..6a5cc457fc 100644 --- a/testsuite/tests/deSugar/should_compile/T10662.stderr +++ b/testsuite/tests/deSugar/should_compile/T10662.stderr @@ -1,5 +1,5 @@ T10662.hs:3:3: warning: [-Wunused-do-bind (in -Wall)] - A do-notation statement discarded a result of type ‘[Char]’ + A do-notation statement discarded a result of type ‘String’ Suppress this warning by saying ‘_ <- return $ let a = "hello" in a’ diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr index 89b88f45ab..44af3fd5f7 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 138082 + Total ticks: 136724 diff --git a/testsuite/tests/dependent/should_fail/BadTelescope5.stderr b/testsuite/tests/dependent/should_fail/BadTelescope5.stderr index 57b2ee7876..d2ec36e5df 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope5.stderr +++ b/testsuite/tests/dependent/should_fail/BadTelescope5.stderr @@ -1,6 +1,10 @@ BadTelescope5.hs:10:81: error: - • Expected kind ‘k1’, but ‘d’ has kind ‘Proxy a1’ + • Expected kind ‘k’, but ‘d’ has kind ‘Proxy a’ + ‘k’ is a rigid type variable bound by + ‘forall a k (b :: k) (c :: Proxy b) (d :: Proxy a). + Proxy c -> SameKind b d’ + at BadTelescope5.hs:10:17 • In the second argument of ‘SameKind’, namely ‘d’ In the type signature: bar :: forall a k (b :: k) (c :: Proxy b) (d :: Proxy a). diff --git a/testsuite/tests/dependent/should_fail/T11407.stderr b/testsuite/tests/dependent/should_fail/T11407.stderr index b07aa2bbd8..df87248f2e 100644 --- a/testsuite/tests/dependent/should_fail/T11407.stderr +++ b/testsuite/tests/dependent/should_fail/T11407.stderr @@ -1,6 +1,6 @@ T11407.hs:10:40: error: - • Occurs check: cannot construct the infinite kind: k0 ~ x a + • Expected kind ‘x a’, but ‘a’ has kind ‘k0’ • In the second argument of ‘UhOh’, namely ‘(a :: x a)’ In the data instance declaration for ‘UhOh’ • Type variable kinds: diff --git a/testsuite/tests/dependent/should_fail/T11471.stderr b/testsuite/tests/dependent/should_fail/T11471.stderr index 640ae6c754..7772850564 100644 --- a/testsuite/tests/dependent/should_fail/T11471.stderr +++ b/testsuite/tests/dependent/should_fail/T11471.stderr @@ -4,8 +4,8 @@ T11471.hs:15:10: error: When matching types a :: * Int# :: TYPE 'IntRep - Expected type: Proxy a - Actual type: Proxy Int# + Expected: Proxy a + Actual: Proxy Int# • In the first argument of ‘f’, namely ‘(undefined :: Proxy Int#)’ In the expression: f (undefined :: Proxy Int#) 3# In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3# diff --git a/testsuite/tests/dependent/should_fail/T13780a.stderr b/testsuite/tests/dependent/should_fail/T13780a.stderr index 3b113bd89e..5253ed0dbd 100644 --- a/testsuite/tests/dependent/should_fail/T13780a.stderr +++ b/testsuite/tests/dependent/should_fail/T13780a.stderr @@ -1,6 +1,7 @@ T13780a.hs:9:40: error: - • Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ + • Couldn't match kind ‘a’ with ‘Bool’ + Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ • In the second argument of ‘(~)’, namely ‘MkFoo’ In the definition of data constructor ‘SMkFoo’ In the data instance declaration for ‘Sing’ diff --git a/testsuite/tests/dependent/should_fail/T14066.stderr b/testsuite/tests/dependent/should_fail/T14066.stderr index a6780ff75f..d958f9a519 100644 --- a/testsuite/tests/dependent/should_fail/T14066.stderr +++ b/testsuite/tests/dependent/should_fail/T14066.stderr @@ -1,6 +1,10 @@ T14066.hs:15:59: error: - • Expected kind ‘k2’, but ‘b’ has kind ‘k3’ + • Expected kind ‘k0’, but ‘b’ has kind ‘k’ + because kind variable ‘k’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall k (b :: k). SameKind a b’ + at T14066.hs:15:29-59 • In the second argument of ‘SameKind’, namely ‘b’ In the type signature: g :: forall k (b :: k). SameKind a b In the expression: @@ -8,6 +12,4 @@ T14066.hs:15:59: error: g :: forall k (b :: k). SameKind a b g = undefined in () - • Relevant bindings include - x :: Proxy a (bound at T14066.hs:15:4) - f :: Proxy a -> () (bound at T14066.hs:15:1) + • Relevant bindings include x :: Proxy a (bound at T14066.hs:15:4) diff --git a/testsuite/tests/dependent/should_fail/T14066d.stderr b/testsuite/tests/dependent/should_fail/T14066d.stderr index 289c7a121a..169897c416 100644 --- a/testsuite/tests/dependent/should_fail/T14066d.stderr +++ b/testsuite/tests/dependent/should_fail/T14066d.stderr @@ -1,6 +1,8 @@ T14066d.hs:11:35: error: • Couldn't match type ‘b1’ with ‘b’ + Expected: (Proxy a, Proxy c, b1) + Actual: (Proxy a, Proxy c, b) ‘b1’ is a rigid type variable bound by a type expected by the context: forall c b1 (a :: c). (Proxy a, Proxy c, b1) @@ -9,8 +11,6 @@ T14066d.hs:11:35: error: the type signature for: f :: forall b. b -> (Proxy Maybe, ()) at T14066d.hs:10:1-37 - Expected type: (Proxy a, Proxy c, b1) - Actual type: (Proxy a, Proxy c, b) • In the first argument of ‘g’, namely ‘y’ In the expression: g y In the expression: (fstOf3 y :: Proxy Maybe, g y) diff --git a/testsuite/tests/dependent/should_fail/T14066e.stderr b/testsuite/tests/dependent/should_fail/T14066e.stderr index ee903d6b4c..b103b16187 100644 --- a/testsuite/tests/dependent/should_fail/T14066e.stderr +++ b/testsuite/tests/dependent/should_fail/T14066e.stderr @@ -1,6 +1,11 @@ T14066e.hs:13:65: error: • Expected a type, but ‘c'’ has kind ‘k1’ + ‘k1’ is a rigid type variable bound by + the type signature for: + j :: forall {k1} {k2} (c :: k1) (b :: k2). + Proxy a -> Proxy b -> Proxy c -> Proxy b + at T14066e.hs:12:5-61 • In the kind ‘c'’ In the first argument of ‘Proxy’, namely ‘(b' :: c')’ In an expression type signature: Proxy (b' :: c') diff --git a/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr b/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr index bceccb1dcd..4ef380e5ba 100644 --- a/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr +++ b/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr @@ -3,5 +3,5 @@ T16326_Fail10.hs:12:18: error: • Illegal visible, dependent quantification in the type of a term: forall a -> a -> a (GHC does not yet support this) - • In a RULE for ‘x’: forall a -> a -> a + • In the type signature for ‘x’: forall a -> a -> a When checking the transformation rule "flurmp" diff --git a/testsuite/tests/dependent/should_fail/T17131.stderr b/testsuite/tests/dependent/should_fail/T17131.stderr index dd250ed414..daad6ac054 100644 --- a/testsuite/tests/dependent/should_fail/T17131.stderr +++ b/testsuite/tests/dependent/should_fail/T17131.stderr @@ -1,7 +1,10 @@ T17131.hs:12:34: error: - • Expected kind ‘TYPE ('TupleRep (TypeReps xs))’, + • Couldn't match kind: TypeReps xs + with: '[ 'LiftedRep] + Expected kind ‘TYPE ('TupleRep (TypeReps xs))’, but ‘(# a #)’ has kind ‘TYPE ('TupleRep '[ 'LiftedRep])’ + The type variable ‘xs’ is ambiguous • In the type ‘(# a #)’ In the type family declaration for ‘Tuple#’ NB: Type ‘Tuple#’ was inferred to use visible dependent quantification. diff --git a/testsuite/tests/dependent/should_fail/T17541.stderr b/testsuite/tests/dependent/should_fail/T17541.stderr index e17206c734..d0ea673a2b 100644 --- a/testsuite/tests/dependent/should_fail/T17541.stderr +++ b/testsuite/tests/dependent/should_fail/T17541.stderr @@ -1,7 +1,8 @@ T17541.hs:20:17: error: - • Expected kind ‘TYPE (Rep rep)’, - but ‘Int#’ has kind ‘TYPE 'IntRep’ + • Couldn't match kind ‘Rep rep’ with ‘'IntRep’ + Expected kind ‘TYPE (Rep rep)’, but ‘Int#’ has kind ‘TYPE 'IntRep’ + The type variable ‘rep’ is ambiguous • In the type ‘Int#’ In the type family declaration for ‘Unboxed’ NB: Type ‘Unboxed’ was inferred to use visible dependent quantification. diff --git a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr index e2ef266914..a919095337 100644 --- a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr +++ b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr @@ -1,5 +1,9 @@ TypeSkolEscape.hs:9:52: error: • Expected kind ‘k0’, but ‘a’ has kind ‘TYPE v’ + because kind variable ‘v’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall (v :: RuntimeRep) (a :: TYPE v). a’ + at TypeSkolEscape.hs:9:12-52 • In the type ‘forall (v :: RuntimeRep) (a :: TYPE v). a’ In the type declaration for ‘Bad’ diff --git a/testsuite/tests/deriving/should_fail/T1496.stderr b/testsuite/tests/deriving/should_fail/T1496.stderr index c560f5fe0f..6183819bc4 100644 --- a/testsuite/tests/deriving/should_fail/T1496.stderr +++ b/testsuite/tests/deriving/should_fail/T1496.stderr @@ -1,9 +1,10 @@ T1496.hs:10:32: error: - Couldn't match representation of type ‘c Int’ with that of ‘c Moo’ - arising from the coercion of the method ‘isInt’ - from type ‘forall (c :: * -> *). c Int -> c Int’ - to type ‘forall (c :: * -> *). c Int -> c Moo’ - NB: We cannot know what roles the parameters to ‘c’ have; - we must assume that the role is nominal - When deriving the instance for (IsInt Moo) + • Couldn't match representation of type: c Int + with that of: c Moo + arising from the coercion of the method ‘isInt’ + from type ‘forall (c :: * -> *). c Int -> c Int’ + to type ‘forall (c :: * -> *). c Int -> c Moo’ + NB: We cannot know what roles the parameters to ‘c’ have; + we must assume that the role is nominal + • When deriving the instance for (IsInt Moo) diff --git a/testsuite/tests/deriving/should_fail/T5498.stderr b/testsuite/tests/deriving/should_fail/T5498.stderr index ce87ef1867..1960487c38 100644 --- a/testsuite/tests/deriving/should_fail/T5498.stderr +++ b/testsuite/tests/deriving/should_fail/T5498.stderr @@ -1,10 +1,10 @@ T5498.hs:30:39: error: - Couldn't match representation of type ‘c a’ - with that of ‘c (Down a)’ - arising from the coercion of the method ‘intIso’ - from type ‘forall (c :: * -> *). c a -> c Int’ - to type ‘forall (c :: * -> *). c (Down a) -> c Int’ - NB: We cannot know what roles the parameters to ‘c’ have; - we must assume that the role is nominal - When deriving the instance for (IntIso (Down a)) + • Couldn't match representation of type: c a + with that of: c (Down a) + arising from the coercion of the method ‘intIso’ + from type ‘forall (c :: * -> *). c a -> c Int’ + to type ‘forall (c :: * -> *). c (Down a) -> c Int’ + NB: We cannot know what roles the parameters to ‘c’ have; + we must assume that the role is nominal + • When deriving the instance for (IntIso (Down a)) diff --git a/testsuite/tests/deriving/should_fail/T7148.stderr b/testsuite/tests/deriving/should_fail/T7148.stderr index ee42cc91f1..487d2da622 100644 --- a/testsuite/tests/deriving/should_fail/T7148.stderr +++ b/testsuite/tests/deriving/should_fail/T7148.stderr @@ -1,14 +1,20 @@ T7148.hs:27:40: error: - • Occurs check: cannot construct the infinite type: b ~ Tagged a b + • Couldn't match type ‘b’ with ‘Tagged a b’ arising from the coercion of the method ‘iso2’ from type ‘forall b1. SameType b1 () -> SameType b1 b’ to type ‘forall b1. SameType b1 () -> SameType b1 (Tagged a b)’ + ‘b’ is a rigid type variable bound by + the deriving clause for ‘IsoUnit (Tagged a b)’ + at T7148.hs:27:40-46 • When deriving the instance for (IsoUnit (Tagged a b)) T7148.hs:27:40: error: - • Occurs check: cannot construct the infinite type: b ~ Tagged a b + • Couldn't match type ‘b’ with ‘Tagged a b’ arising from the coercion of the method ‘iso1’ from type ‘forall b1. SameType () b1 -> SameType b b1’ to type ‘forall b1. SameType () b1 -> SameType (Tagged a b) b1’ + ‘b’ is a rigid type variable bound by + the deriving clause for ‘IsoUnit (Tagged a b)’ + at T7148.hs:27:40-46 • When deriving the instance for (IsoUnit (Tagged a b)) diff --git a/testsuite/tests/deriving/should_fail/T8984.stderr b/testsuite/tests/deriving/should_fail/T8984.stderr index 1cdc425293..9908f70f0a 100644 --- a/testsuite/tests/deriving/should_fail/T8984.stderr +++ b/testsuite/tests/deriving/should_fail/T8984.stderr @@ -1,9 +1,9 @@ T8984.hs:7:46: error: - Couldn't match representation of type ‘cat a (N cat a Int)’ - with that of ‘cat a (cat a Int)’ - arising from the coercion of the method ‘app’ - from type ‘cat a (cat a Int)’ to type ‘N cat a (N cat a Int)’ - NB: We cannot know what roles the parameters to ‘cat a’ have; - we must assume that the role is nominal - When deriving the instance for (C (N cat a)) + • Couldn't match representation of type: cat a (N cat a Int) + with that of: cat a (cat a Int) + arising from the coercion of the method ‘app’ + from type ‘cat a (cat a Int)’ to type ‘N cat a (N cat a Int)’ + NB: We cannot know what roles the parameters to ‘cat a’ have; + we must assume that the role is nominal + • When deriving the instance for (C (N cat a)) diff --git a/testsuite/tests/determinism/determ004/determ004.hs b/testsuite/tests/determinism/determ004/determ004.hs index 643fa0769d..97d268f1fa 100644 --- a/testsuite/tests/determinism/determ004/determ004.hs +++ b/testsuite/tests/determinism/determ004/determ004.hs @@ -302,13 +302,13 @@ sFoldr1 sF (SCons sX (SCons sWild_1627448474 sWild_1627448476)) sXs = applySing (applySing - (singFun2 (undefined :: Proxy (:$)) SCons) wild_1627448474_afeF) + (singFun2 (undefined :: Proxy (:$)) (\ x y -> SCons x y)) wild_1627448474_afeF) wild_1627448476_afeG in applySing (applySing f_afeD x_afeE) (applySing - (applySing (singFun2 (undefined :: Proxy Foldr1Sym0) sFoldr1) f_afeD) + (applySing (singFun2 (undefined :: Proxy Foldr1Sym0) (\x y -> sFoldr1 x y)) f_afeD) sXs) in lambda_afeC sF sX sWild_1627448474 sWild_1627448476 sFoldr1 _ SNil = undefined diff --git a/testsuite/tests/gadt/T3169.stderr b/testsuite/tests/gadt/T3169.stderr index d0f650b9ab..5770e03c70 100644 --- a/testsuite/tests/gadt/T3169.stderr +++ b/testsuite/tests/gadt/T3169.stderr @@ -1,8 +1,12 @@ T3169.hs:13:22: error: - • Occurs check: cannot construct the infinite type: elt ~ Map b elt - Expected type: Map a (Map b elt) - Actual type: Map (a, b) elt + • Couldn't match type ‘elt’ with ‘Map b 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 second argument of ‘lookup’, namely ‘m’ In the expression: lookup a m :: Maybe (Map b elt) In the expression: diff --git a/testsuite/tests/gadt/T3651.stderr b/testsuite/tests/gadt/T3651.stderr index 62e3bf16d7..cd235748bb 100644 --- a/testsuite/tests/gadt/T3651.stderr +++ b/testsuite/tests/gadt/T3651.stderr @@ -1,14 +1,14 @@ T3651.hs:11:15: error: • Couldn't match type ‘()’ with ‘Bool’ - Expected type: a - Actual type: () + Expected: a + Actual: () • In the expression: () In an equation for ‘unsafe1’: unsafe1 B U = () T3651.hs:14:15: error: • Couldn't match type ‘()’ with ‘Bool’ - Expected type: a - Actual type: () + Expected: a + Actual: () • In the expression: () In an equation for ‘unsafe2’: unsafe2 B U = () diff --git a/testsuite/tests/gadt/T7558.stderr b/testsuite/tests/gadt/T7558.stderr index 29d7fa65a3..c8b9ec4223 100644 --- a/testsuite/tests/gadt/T7558.stderr +++ b/testsuite/tests/gadt/T7558.stderr @@ -1,6 +1,10 @@ T7558.hs:8:18: error: - • Occurs check: cannot construct the infinite type: a ~ Maybe a + • Couldn't match expected type ‘a’ with actual type ‘Maybe a’ + ‘a’ is a rigid type variable bound by + the type signature for: + f :: forall a. T a a -> Bool + at T7558.hs:7:1-18 • In the expression: y In the first argument of ‘seq’, namely ‘[x, y]’ In the expression: [x, y] `seq` True diff --git a/testsuite/tests/gadt/gadt-escape1.stderr b/testsuite/tests/gadt/gadt-escape1.stderr index 41322f9cbc..19aa501a4c 100644 --- a/testsuite/tests/gadt/gadt-escape1.stderr +++ b/testsuite/tests/gadt/gadt-escape1.stderr @@ -1,16 +1,17 @@ gadt-escape1.hs:19:58: error: • Couldn't match type ‘p’ with ‘ExpGADT Int’ + Expected: p + Actual: ExpGADT t ‘p’ is untouchable inside the constraints: t ~ Int bound by a pattern with constructor: ExpInt :: Int -> ExpGADT Int, in a case alternative at gadt-escape1.hs:19:43-50 ‘p’ is a rigid type variable bound by - the inferred type of weird1 :: p at gadt-escape1.hs:19:1-58 + the inferred type of weird1 :: p + at gadt-escape1.hs:19:1-58 Possible fix: add a type signature for ‘weird1’ - Expected type: p - Actual type: ExpGADT t • In the expression: a In a case alternative: Hidden (ExpInt _) a -> a In the expression: diff --git a/testsuite/tests/gadt/rw.stderr b/testsuite/tests/gadt/rw.stderr index 067595f2d7..fe6ba1edee 100644 --- a/testsuite/tests/gadt/rw.stderr +++ b/testsuite/tests/gadt/rw.stderr @@ -15,12 +15,12 @@ rw.hs:14:47: error: rw.hs:19:43: error: • Couldn't match type ‘a’ with ‘Bool’ + Expected: a -> IO () + Actual: Bool -> IO () ‘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 - Expected type: a -> IO () - Actual type: Bool -> IO () • 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) diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stderr b/testsuite/tests/ghci.debugger/scripts/T14628.stderr index 276d63ff38..8990cdb97b 100644 --- a/testsuite/tests/ghci.debugger/scripts/T14628.stderr +++ b/testsuite/tests/ghci.debugger/scripts/T14628.stderr @@ -1,12 +1,13 @@ -<interactive>:4:7: - Couldn't match type ‘m’ with ‘(,) a0’ + +<interactive>:4:7: error: + • Couldn't match type ‘m’ with ‘(,) a0’ + Expected: (a0, ((), Int)) + Actual: m ((), Int) ‘m’ is untouchable inside the constraints: () bound by the inferred type of it :: ((), Int) at <interactive>:4:1-25 ‘m’ is an interactive-debugger skolem - Expected type: (a0, ((), Int)) - Actual type: m ((), Int) - In the second argument of ‘($)’, namely ‘runStateT _result 0’ + • 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/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr index 0defd52b38..c25cc4b81f 100644 --- a/testsuite/tests/ghci/scripts/Defer02.stderr +++ b/testsuite/tests/ghci/scripts/Defer02.stderr @@ -1,8 +1,8 @@ Defer01.hs:11:40: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘Char’ with ‘[Char]’ - Expected type: String - Actual type: Char + Expected: String + Actual: Char • In the first argument of ‘putStr’, namely ‘','’ In the second argument of ‘(>>)’, namely ‘putStr ','’ In the expression: putStr "Hello World" >> putStr ',' @@ -60,16 +60,16 @@ Defer01.hs:47:7: warning: [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘k’: k x = x Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match expected type ‘IO a0’ - with actual type ‘Char -> IO ()’ + • Couldn't match expected type: IO a0 + with actual type: Char -> IO () • Probable cause: ‘putChar’ is applied to too few arguments In the first argument of ‘(>>)’, namely ‘putChar’ In the expression: putChar >> putChar 'p' In an equation for ‘l’: l = putChar >> putChar 'p' *** Exception: Defer01.hs:11:40: error: • Couldn't match type ‘Char’ with ‘[Char]’ - Expected type: String - Actual type: Char + Expected: String + Actual: Char • In the first argument of ‘putStr’, namely ‘','’ In the second argument of ‘(>>)’, namely ‘putStr ','’ In the expression: putStr "Hello World" >> putStr ',' @@ -87,8 +87,8 @@ Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)] <interactive>:10:11: error: • Couldn't match type ‘Bool’ with ‘Int’ - Expected type: C Int - Actual type: C Bool + Expected: C Int + Actual: C Bool • In the first argument of ‘c’, namely ‘(C2 True)’ In the first argument of ‘print’, namely ‘(c (C2 True))’ In the expression: print (c (C2 True)) @@ -140,8 +140,8 @@ Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)] In the expression: print (k 2) In an equation for ‘it’: it = print (k 2) *** Exception: Defer01.hs:50:5: error: - • Couldn't match expected type ‘IO a0’ - with actual type ‘Char -> IO ()’ + • Couldn't match expected type: IO a0 + with actual type: Char -> IO () • Probable cause: ‘putChar’ is applied to too few arguments In the first argument of ‘(>>)’, namely ‘putChar’ In the expression: putChar >> putChar 'p' diff --git a/testsuite/tests/ghci/scripts/T10508.stderr b/testsuite/tests/ghci/scripts/T10508.stderr index 365bf9fcae..f7931e48e2 100644 --- a/testsuite/tests/ghci/scripts/T10508.stderr +++ b/testsuite/tests/ghci/scripts/T10508.stderr @@ -1,8 +1,9 @@ <interactive>:1:8: error: - • Couldn't match type ‘a0 -> a0’ with ‘[Char]’ - Expected type: IO Prelude.String - Actual type: IO (a0 -> a0) + • Couldn't match type: a0 -> a0 + with: [Char] + Expected: IO Prelude.String + Actual: IO (a0 -> a0) • In the expression: return id In the second argument of ‘(.)’, namely ‘(\ _ -> return id)’ In the expression: diff --git a/testsuite/tests/ghci/scripts/T12005.script b/testsuite/tests/ghci/scripts/T12005.script index a86e7d5e8e..4be674ede8 100644 --- a/testsuite/tests/ghci/scripts/T12005.script +++ b/testsuite/tests/ghci/scripts/T12005.script @@ -1,8 +1,8 @@ -:set -XKindSignatures -XRank2Types -XConstraintKinds -XAllowAmbiguousTypes -XInstanceSigs +:set -XKindSignatures -XRank2Types -XConstraintKinds -XAllowAmbiguousTypes import Data.Kind class Defer (p :: Constraint) where defer :: (p => r) -> r -instance Defer () where defer :: r -> r; defer = id +instance Defer () where defer x = x :i Defer diff --git a/testsuite/tests/ghci/scripts/T12447.stdout b/testsuite/tests/ghci/scripts/T12447.stdout index 7a64e1546d..6c469eeef3 100644 --- a/testsuite/tests/ghci/scripts/T12447.stdout +++ b/testsuite/tests/ghci/scripts/T12447.stdout @@ -1,3 +1,3 @@ deferEither @(_ ~ _) - :: (Typeable _1, Typeable _2) => - proxy (_1 ~ _2) -> ((_1 ~ _2) => r) -> Either String r + :: (Typeable w1, Typeable w2) => + proxy (w1 ~ w2) -> ((w1 ~ w2) => r) -> Either String r diff --git a/testsuite/tests/ghci/scripts/T16767.stdout b/testsuite/tests/ghci/scripts/T16767.stdout index 340ed6ee80..5cd96f96a7 100644 --- a/testsuite/tests/ghci/scripts/T16767.stdout +++ b/testsuite/tests/ghci/scripts/T16767.stdout @@ -1,2 +1,2 @@ -'Proxy @_ :: forall {k} {_ :: k}. Proxy @{k} _ -= 'Proxy @{k} @_ +'Proxy @_ :: forall {k} {w :: k}. Proxy @{k} w += 'Proxy @{k} @w diff --git a/testsuite/tests/ghci/scripts/T2976.stdout b/testsuite/tests/ghci/scripts/T2976.stdout index 9c977a2cb3..8d8edae907 100644 --- a/testsuite/tests/ghci/scripts/T2976.stdout +++ b/testsuite/tests/ghci/scripts/T2976.stdout @@ -1,6 +1,6 @@ test :: Int = 0 test = 0 test :: Int = 0 -test :: [Char] = _ +test :: String = _ test = "test" -test :: [Char] = "test" +test :: String = "test" diff --git a/testsuite/tests/ghci/scripts/T8357.stdout b/testsuite/tests/ghci/scripts/T8357.stdout index 7975d1f1a1..2f2cf22b47 100644 --- a/testsuite/tests/ghci/scripts/T8357.stdout +++ b/testsuite/tests/ghci/scripts/T8357.stdout @@ -1,3 +1,3 @@ -foo :: Rec '["foo" ::: [Char]] -bar :: Rec '["bar" ::: [Char]] -both :: Rec '["foo" ::: [Char], "bar" ::: [Char]] +foo :: Rec '["foo" ::: String] +bar :: Rec '["bar" ::: String] +both :: Rec '["foo" ::: [Char], "bar" ::: String] diff --git a/testsuite/tests/ghci/scripts/T8649.stderr b/testsuite/tests/ghci/scripts/T8649.stderr index aa40d50c2e..96afa36a54 100644 --- a/testsuite/tests/ghci/scripts/T8649.stderr +++ b/testsuite/tests/ghci/scripts/T8649.stderr @@ -1,9 +1,8 @@ <interactive>:4:4: error: - Couldn't match expected type ‘Ghci1.X’ - with actual type ‘X’ - NB: ‘X’ is defined at <interactive>:3:1-25 - ‘Ghci1.X’ is defined at <interactive>:1:1-14 - In the first argument of ‘f’, namely ‘(Y 3)’ - In the expression: f (Y 3) - In an equation for ‘it’: it = f (Y 3) + • Couldn't match expected type ‘Ghci1.X’ with actual type ‘X’ + NB: ‘Ghci1.X’ is defined at <interactive>:1:1-14 + ‘X’ is defined at <interactive>:3:1-25 + • In the first argument of ‘f’, namely ‘(Y 3)’ + In the expression: f (Y 3) + In an equation for ‘it’: it = f (Y 3) diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr index a814d2e5cb..971261ba40 100644 --- a/testsuite/tests/ghci/scripts/T8959b.stderr +++ b/testsuite/tests/ghci/scripts/T8959b.stderr @@ -10,7 +10,7 @@ T8959b.hs:8:7: error: In an equation for ‘bar’: bar = proc x -> do return ⤙ x T8959b.hs:10:7: error: - • Couldn't match expected type ‘(∀ a2. a2 → a2) → a1’ + • Couldn't match expected type ‘(∀ a. a → a) → a1’ with actual type ‘()’ • In the expression: () ∷ (∀ a. a → a) → a In an equation for ‘baz’: baz = () ∷ (∀ a. a → a) → a diff --git a/testsuite/tests/ghci/scripts/ghci012.stdout b/testsuite/tests/ghci/scripts/ghci012.stdout index 0fc695c4d1..32ceac8b06 100644 --- a/testsuite/tests/ghci/scripts/ghci012.stdout +++ b/testsuite/tests/ghci/scripts/ghci012.stdout @@ -1 +1 @@ -($$$) :: [a -> c] -> [a] -> [c] -- Defined at <interactive>:1:8 +($$$) :: [b -> c] -> [b] -> [c] -- Defined at <interactive>:1:8 diff --git a/testsuite/tests/ghci/scripts/ghci051.stderr b/testsuite/tests/ghci/scripts/ghci051.stderr index 6d28081344..9407837580 100644 --- a/testsuite/tests/ghci/scripts/ghci051.stderr +++ b/testsuite/tests/ghci/scripts/ghci051.stderr @@ -1,10 +1,9 @@ <interactive>:6:9: error: - Couldn't match type ‘T’ - with ‘Ghci1.T’ - NB: ‘Ghci1.T’ is defined at <interactive>:2:1-14 - ‘T’ is defined at <interactive>:5:1-16 - Expected type: T' - Actual type: T - In the expression: C :: T' - In an equation for ‘c’: c = C :: T' + • Couldn't match type ‘T’ with ‘Ghci1.T’ + Expected: T' + Actual: T + NB: ‘Ghci1.T’ is defined at <interactive>:2:1-14 + ‘T’ is defined at <interactive>:5:1-16 + • In the expression: C :: T' + In an equation for ‘c’: c = C :: T' diff --git a/testsuite/tests/ghci/scripts/ghci052.stderr b/testsuite/tests/ghci/scripts/ghci052.stderr index 224726f822..047ab5e966 100644 --- a/testsuite/tests/ghci/scripts/ghci052.stderr +++ b/testsuite/tests/ghci/scripts/ghci052.stderr @@ -1,35 +1,35 @@ <interactive>:8:4: error: - Couldn't match expected type ‘Ghci1.Planet’ - with actual type ‘Planet’ - NB: ‘Planet’ is defined at <interactive>:7:1-36 - ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 - In the first argument of ‘pn’, namely ‘Mercury’ - In the expression: pn Mercury - In an equation for ‘it’: it = pn Mercury + • Couldn't match expected type ‘Ghci1.Planet’ + with actual type ‘Planet’ + NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 + ‘Planet’ is defined at <interactive>:7:1-36 + • In the first argument of ‘pn’, namely ‘Mercury’ + In the expression: pn Mercury + In an equation for ‘it’: it = pn Mercury <interactive>:9:4: error: - Couldn't match expected type ‘Ghci1.Planet’ - with actual type ‘Planet’ - NB: ‘Planet’ is defined at <interactive>:7:1-36 - ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 - In the first argument of ‘pn’, namely ‘Venus’ - In the expression: pn Venus - In an equation for ‘it’: it = pn Venus + • Couldn't match expected type ‘Ghci1.Planet’ + with actual type ‘Planet’ + NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 + ‘Planet’ is defined at <interactive>:7:1-36 + • In the first argument of ‘pn’, namely ‘Venus’ + In the expression: pn Venus + In an equation for ‘it’: it = pn Venus <interactive>:10:4: error: - Couldn't match expected type ‘Ghci1.Planet’ - with actual type ‘Planet’ - NB: ‘Planet’ is defined at <interactive>:7:1-36 - ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 - In the first argument of ‘pn’, namely ‘Mars’ - In the expression: pn Mars - In an equation for ‘it’: it = pn Mars + • Couldn't match expected type ‘Ghci1.Planet’ + with actual type ‘Planet’ + NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 + ‘Planet’ is defined at <interactive>:7:1-36 + • In the first argument of ‘pn’, namely ‘Mars’ + In the expression: pn Mars + In an equation for ‘it’: it = pn Mars <interactive>:12:44: error: - Couldn't match expected type ‘Planet’ - with actual type ‘Ghci1.Planet’ - NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 - ‘Planet’ is defined at <interactive>:7:1-36 - In the pattern: Earth - In an equation for ‘pn’: pn Earth = "E" + • Couldn't match expected type ‘Planet’ + with actual type ‘Ghci1.Planet’ + NB: ‘Planet’ is defined at <interactive>:7:1-36 + ‘Ghci1.Planet’ is defined at <interactive>:4:1-37 + • In the pattern: Earth + In an equation for ‘pn’: pn Earth = "E" diff --git a/testsuite/tests/ghci/scripts/ghci053.stderr b/testsuite/tests/ghci/scripts/ghci053.stderr index 76d5ae2548..d2cd0a6a68 100644 --- a/testsuite/tests/ghci/scripts/ghci053.stderr +++ b/testsuite/tests/ghci/scripts/ghci053.stderr @@ -1,18 +1,18 @@ <interactive>:9:12: error: - Couldn't match expected type ‘Ghci1.Planet’ - with actual type ‘Planet’ - NB: ‘Planet’ is defined at <interactive>:7:1-41 - ‘Ghci1.Planet’ is defined at <interactive>:4:1-49 - In the second argument of ‘(==)’, namely ‘Mercury’ - In the expression: mercury == Mercury - In an equation for ‘it’: it = mercury == Mercury + • Couldn't match expected type ‘Ghci1.Planet’ + with actual type ‘Planet’ + NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-49 + ‘Planet’ is defined at <interactive>:7:1-41 + • In the second argument of ‘(==)’, namely ‘Mercury’ + In the expression: mercury == Mercury + In an equation for ‘it’: it = mercury == Mercury <interactive>:11:10: error: - Couldn't match expected type ‘Planet’ - with actual type ‘Ghci1.Planet’ - NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-49 - ‘Planet’ is defined at <interactive>:7:1-41 - In the second argument of ‘(==)’, namely ‘Earth’ - In the expression: Venus == Earth - In an equation for ‘it’: it = Venus == Earth + • Couldn't match expected type ‘Planet’ + with actual type ‘Ghci1.Planet’ + NB: ‘Planet’ is defined at <interactive>:7:1-41 + ‘Ghci1.Planet’ is defined at <interactive>:4:1-49 + • In the second argument of ‘(==)’, namely ‘Earth’ + In the expression: Venus == Earth + In an equation for ‘it’: it = Venus == Earth diff --git a/testsuite/tests/ghci/scripts/ghci061.stderr b/testsuite/tests/ghci/scripts/ghci061.stderr index 1ba00c5609..27dac2cb77 100644 --- a/testsuite/tests/ghci/scripts/ghci061.stderr +++ b/testsuite/tests/ghci/scripts/ghci061.stderr @@ -1,16 +1,18 @@ <interactive>:1:2: error: - • Couldn't match type ‘IO String’ with ‘Int -> IO String’ - Expected type: [String] -> Int -> IO String - Actual type: [String] -> IO String + • Couldn't match type: IO String + with: Int -> IO String + Expected: [String] -> Int -> IO String + Actual: [String] -> IO String • In the expression: (two_args) :: [String] -> Int -> IO String In an equation for ‘_compileParsedExpr’: _compileParsedExpr = (two_args) :: [String] -> Int -> IO String <interactive>:1:2: error: - • Couldn't match type ‘IO String’ with ‘Int -> IO String’ - Expected type: [String] -> Int -> IO String - Actual type: [String] -> IO String + • Couldn't match type: IO String + with: Int -> IO String + Expected: [String] -> Int -> IO String + Actual: [String] -> IO String • In the expression: (two_args) :: [String] -> Int -> IO String In an equation for ‘_compileParsedExpr’: _compileParsedExpr = (two_args) :: [String] -> Int -> IO String diff --git a/testsuite/tests/ghci/scripts/ghci064.stdout b/testsuite/tests/ghci/scripts/ghci064.stdout index e3fe5a9804..9190a68e67 100644 --- a/testsuite/tests/ghci/scripts/ghci064.stdout +++ b/testsuite/tests/ghci/scripts/ghci064.stdout @@ -6,25 +6,25 @@ instance GHC.Base.MonadPlus Maybe -- Defined in ‘GHC.Base’ instance MonadFail Maybe -- Defined in ‘Control.Monad.Fail’ instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Traversable Maybe -- Defined in ‘Data.Traversable’ -instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ -instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ -instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ -instance Semigroup _ => Semigroup (Maybe _) +instance Eq w => Eq (Maybe w) -- Defined in ‘GHC.Maybe’ +instance Semigroup w => Monoid (Maybe w) -- Defined in ‘GHC.Base’ +instance Ord w => Ord (Maybe w) -- Defined in ‘GHC.Maybe’ +instance Semigroup w => Semigroup (Maybe w) -- Defined in ‘GHC.Base’ -instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ -instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ -instance GHC.Generics.Generic (Maybe _) +instance Show w => Show (Maybe w) -- Defined in ‘GHC.Show’ +instance Read w => Read (Maybe w) -- Defined in ‘GHC.Read’ +instance GHC.Generics.Generic (Maybe w) -- Defined in ‘GHC.Generics’ -instance GHC.Generics.SingKind _ => GHC.Generics.SingKind (Maybe _) +instance GHC.Generics.SingKind w => GHC.Generics.SingKind (Maybe w) -- Defined in ‘GHC.Generics’ -instance Eq _ => Eq [_] -- Defined in ‘GHC.Classes’ -instance Monoid [_] -- Defined in ‘GHC.Base’ -instance Ord _ => Ord [_] -- Defined in ‘GHC.Classes’ -instance Semigroup [_] -- Defined in ‘GHC.Base’ -instance Show _ => Show [_] -- Defined in ‘GHC.Show’ -instance Read _ => Read [_] -- Defined in ‘GHC.Read’ -instance GHC.Generics.Generic [_] -- Defined in ‘GHC.Generics’ -instance [safe] MyShow _ => MyShow [_] +instance Eq w => Eq [w] -- Defined in ‘GHC.Classes’ +instance Monoid [w] -- Defined in ‘GHC.Base’ +instance Ord w => Ord [w] -- Defined in ‘GHC.Classes’ +instance Semigroup [w] -- Defined in ‘GHC.Base’ +instance Show w => Show [w] -- Defined in ‘GHC.Show’ +instance Read w => Read [w] -- Defined in ‘GHC.Read’ +instance GHC.Generics.Generic [w] -- Defined in ‘GHC.Generics’ +instance [safe] MyShow w => MyShow [w] -- Defined at ghci064.hs:7:10 instance Monoid [T] -- Defined in ‘GHC.Base’ instance Semigroup [T] -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/should_fail/T16287.stderr b/testsuite/tests/ghci/should_fail/T16287.stderr index 8b0f882ab7..df162c1b1b 100644 --- a/testsuite/tests/ghci/should_fail/T16287.stderr +++ b/testsuite/tests/ghci/should_fail/T16287.stderr @@ -4,6 +4,8 @@ <interactive>:1:4: error: • Expected kind ‘forall k. k’, but ‘F2’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall k. k • In the first argument of ‘T2’, namely ‘F2’ In the type ‘T2 F2’ @@ -12,6 +14,8 @@ <interactive>:1:11: error: • Expected kind ‘forall k. k’, but ‘F2’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall k. k • In the first argument of ‘T2’, namely ‘F2’ In the first argument of ‘Maybe’, namely ‘(T2 F2)’ In the type ‘Maybe (T2 F2)’ diff --git a/testsuite/tests/ghci/should_run/T13456.stdout b/testsuite/tests/ghci/should_run/T13456.stdout index 8bfc0283fd..7d354f4355 100644 --- a/testsuite/tests/ghci/should_run/T13456.stdout +++ b/testsuite/tests/ghci/should_run/T13456.stdout @@ -3,8 +3,8 @@ macro 'type' overwrites builtin command. Use ':def!' to overwrite. macro 'ty' overwrites builtin command. Use ':def!' to overwrite. I'm a macro I'm a macro -macro :: p -> IO [Char] -macro :: p -> IO [Char] +macro :: p -> IO String +macro :: p -> IO String macro 'test' is already defined. Use ':def!' to overwrite. the following macros are defined: test diff --git a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr index 5b6863c740..5ba9df0d1a 100644 --- a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr +++ b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr @@ -22,7 +22,8 @@ PushedInAsGivens.hs:10:31: error: bar :: a -> (a, Int) (bound at PushedInAsGivens.hs:9:1) PushedInAsGivens.hs:11:15: error: - • Couldn't match type ‘F Int’ with ‘[a]’ + • Couldn't match type: F Int + with: [a] arising from a use of ‘foo’ • In the expression: foo y In the expression: (y, foo y) diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.hs b/testsuite/tests/indexed-types/should_compile/Simple14.hs index 0a47a649a5..dba26194f1 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple14.hs +++ b/testsuite/tests/indexed-types/should_compile/Simple14.hs @@ -5,21 +5,23 @@ module Simple14 where data EQ_ x y = EQ_ -- Nov 2014: actually eqE has an ambiguous type +-- Apr 2020: now it doesn't again eqE :: EQ_ x y -> (x~y => EQ_ z z) -> p -eqE = error "eqE" +eqE x y = error "eqE" eqI :: EQ_ x x eqI = error "eqI" ntI :: (forall p. EQ_ x y -> p) -> EQ_ x y -ntI = error "ntI" +ntI x = error "ntI" foo :: forall m n. EQ_ (Maybe m) (Maybe n) -foo = ntI (`eqE` (eqI :: EQ_ m n)) +foo = ntI (\x -> x `eqE` (eqI :: EQ_ m n)) + -- Alternative -- foo = ntI (\eq -> eq `eqE` (eqI :: EQ_ m n)) -- eq :: EQ_ (Maybe m) (Maybe n) -- Need (Maybe m ~ Maybe n) => EQ_ m n ~ EQ_ zeta zeta -- which reduces to (m~n) => m ~ zeta --- but then we are stuck
\ No newline at end of file +-- but then we are stuck diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr index 4c61d95cc9..6159b08898 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr +++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr @@ -1,17 +1,21 @@ -Simple14.hs:8:8: error: - • Couldn't match type ‘z0’ with ‘z’ +Simple14.hs:19:27: error: + • Couldn't match type ‘z0’ with ‘n’ + Expected: EQ_ z0 z0 + Actual: EQ_ m n ‘z0’ is untouchable - inside the constraints: x ~ y + inside the constraints: Maybe m ~ Maybe n bound by a type expected by the context: - (x ~ y) => EQ_ z0 z0 - at Simple14.hs:8:8-39 - ‘z’ is a rigid type variable bound by + (Maybe m ~ Maybe n) => EQ_ z0 z0 + at Simple14.hs:19:26-41 + ‘n’ is a rigid type variable bound by the type signature for: - eqE :: forall x y z p. EQ_ x y -> ((x ~ y) => EQ_ z z) -> p - at Simple14.hs:8:8-39 - Expected type: EQ_ z0 z0 - Actual type: EQ_ z z - • In the ambiguity check for ‘eqE’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: eqE :: EQ_ x y -> (x ~ y => EQ_ z z) -> p + foo :: forall m n. EQ_ (Maybe m) (Maybe n) + at Simple14.hs:18:1-42 + • In the second argument of ‘eqE’, namely ‘(eqI :: EQ_ m n)’ + In the expression: x `eqE` (eqI :: EQ_ m n) + In the first argument of ‘ntI’, namely + ‘(\ x -> x `eqE` (eqI :: EQ_ m n))’ + • Relevant bindings include + x :: EQ_ (Maybe m) (Maybe n) (bound at Simple14.hs:19:13) + foo :: EQ_ (Maybe m) (Maybe n) (bound at Simple14.hs:19:1) diff --git a/testsuite/tests/indexed-types/should_compile/T10806.stderr b/testsuite/tests/indexed-types/should_compile/T10806.stderr index c78a10bd7b..96284e6c75 100644 --- a/testsuite/tests/indexed-types/should_compile/T10806.stderr +++ b/testsuite/tests/indexed-types/should_compile/T10806.stderr @@ -1,7 +1,7 @@ T10806.hs:11:32: error: - • Couldn't match expected type ‘Char -> Bool’ - with actual type ‘IO ()’ + • Couldn't match expected type: Char -> Bool + with actual type: IO () • The function ‘print’ is applied to two value arguments, but its type ‘Char -> IO ()’ has only one In the expression: print 'x' 'y' diff --git a/testsuite/tests/indexed-types/should_compile/T12538.stderr b/testsuite/tests/indexed-types/should_compile/T12538.stderr index ca106246e7..7a26b9c483 100644 --- a/testsuite/tests/indexed-types/should_compile/T12538.stderr +++ b/testsuite/tests/indexed-types/should_compile/T12538.stderr @@ -3,10 +3,11 @@ 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) ‘a'’ is a rigid type variable bound by - the instance declaration at T12538.hs:36:10-46 - Expected type: a -> b - Actual type: a -> DF (Tagged Int a) + the instance declaration + at T12538.hs:36:10-46 • In the expression: DF . tag In an equation for ‘df’: df = DF . tag In the instance declaration for ‘ToDF a b’ diff --git a/testsuite/tests/indexed-types/should_compile/T17923.hs b/testsuite/tests/indexed-types/should_compile/T17923.hs index 8c34024864..a6840ff616 100644 --- a/testsuite/tests/indexed-types/should_compile/T17923.hs +++ b/testsuite/tests/indexed-types/should_compile/T17923.hs @@ -38,7 +38,7 @@ data ShowCharSym0 :: E ~> E ~> E sShow_tuple :: SLambda Sym4 sShow_tuple - = applySing (singFun2 @Sym3 und) + = applySing (singFun2 @Sym3 (\x -> und x)) (und (singFun2 @Sym3 - (und (applySing (singFun2 @Sym3 und) - (applySing (singFun2 @ShowCharSym0 und) und))))) + (\y -> und (applySing (singFun2 @Sym3 (\x -> und x)) + (applySing (singFun2 @ShowCharSym0 (\x -> und x)) und)) y))) diff --git a/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr index 5bc6aca64c..63f24fa268 100644 --- a/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr +++ b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr @@ -1,6 +1,7 @@ ExtraTcsUntch.hs:23:18: error: - • Couldn't match expected type ‘F Int’ with actual type ‘[p]’ + • Couldn't match expected type: F Int + with actual type: [p] • In the first argument of ‘h’, namely ‘[x]’ In the expression: h [x] In an equation for ‘g1’: g1 _ = h [x] @@ -9,7 +10,8 @@ ExtraTcsUntch.hs:23:18: error: f :: p -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1) ExtraTcsUntch.hs:25:38: error: - • Couldn't match expected type ‘F Int’ with actual type ‘[[a0]]’ + • Couldn't match expected type: F Int + with actual type: [[a0]] The type variable ‘a0’ is ambiguous • In the first argument of ‘h’, namely ‘[[undefined]]’ In the expression: h [[undefined]] diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr index 9eab513529..1f155bbea0 100644 --- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr +++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr @@ -1,8 +1,9 @@ NoMatchErr.hs:19:7: error: - • Couldn't match type ‘Memo d0’ with ‘Memo d’ - Expected type: Memo d a -> Memo d a - Actual type: Memo d0 a -> Memo d0 a + • Couldn't match type: Memo d0 + with: Memo d + Expected: Memo d a -> Memo d a + Actual: Memo d0 a -> Memo d0 a NB: ‘Memo’ is a non-injective type family The type variable ‘d0’ is ambiguous • In the ambiguity check for ‘f’ diff --git a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr index c0b1d64889..b1aaea25b1 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr @@ -1,12 +1,12 @@ Overlap6.hs:15:7: error: • Couldn't match type ‘x’ with ‘And x 'True’ + Expected: Proxy (And x 'True) + Actual: Proxy x ‘x’ is a rigid type variable bound by the type signature for: g :: forall (x :: Bool). Proxy x -> Proxy (And x 'True) at Overlap6.hs:14:1-34 - Expected type: Proxy (And x 'True) - Actual type: Proxy x • In the expression: x In an equation for ‘g’: g x = x • Relevant bindings include diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr index fa635378a4..df131da8a3 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr @@ -1,9 +1,10 @@ SimpleFail16.hs:10:12: error: - Couldn't match expected type ‘p0 a0’ with actual type ‘F ()’ - The type variables ‘p0’, ‘a0’ are ambiguous - In the first argument of ‘foo’, namely ‘(undefined :: F ())’ - In the expression: foo (undefined :: F ()) - In an equation for ‘bar’: bar = foo (undefined :: F ()) - Relevant bindings include - bar :: p0 a0 (bound at SimpleFail16.hs:10:1) + • Couldn't match expected type: p0 a0 + with actual type: F () + The type variables ‘p0’, ‘a0’ are ambiguous + • In the first argument of ‘foo’, namely ‘(undefined :: F ())’ + In the expression: foo (undefined :: F ()) + In an equation for ‘bar’: bar = foo (undefined :: F ()) + • Relevant bindings include + bar :: p0 a0 (bound at SimpleFail16.hs:10:1) diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr index 69a7170504..c437d95501 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr @@ -1,12 +1,12 @@ SimpleFail5a.hs:31:11: error: • Couldn't match type ‘a’ with ‘Int’ + Expected: S3 a + Actual: S3 Int ‘a’ is a rigid type variable bound by the type signature for: bar3wrong :: forall a. S3 a -> a at SimpleFail5a.hs:30:1-22 - Expected type: S3 a - Actual type: S3 Int • In the pattern: D3Int In an equation for ‘bar3wrong’: bar3wrong D3Int = 1 • Relevant bindings include diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr index 0dfd570cc0..7398ef0fe8 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr @@ -1,7 +1,7 @@ -SimpleFail5b.hs:31:12: - Couldn't match type ‘Char’ with ‘Int’ - Expected type: S3 Int - Actual type: S3 Char - In the pattern: D3Char - In an equation for ‘bar3wrong'’: bar3wrong' D3Char = 'a' +SimpleFail5b.hs:31:12: error: + • Couldn't match type ‘Char’ with ‘Int’ + Expected: S3 Int + Actual: S3 Char + • In the pattern: D3Char + In an equation for ‘bar3wrong'’: bar3wrong' D3Char = 'a' diff --git a/testsuite/tests/indexed-types/should_fail/T13674.stderr b/testsuite/tests/indexed-types/should_fail/T13674.stderr index 53a7cb705c..55798b1189 100644 --- a/testsuite/tests/indexed-types/should_fail/T13674.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13674.stderr @@ -1,8 +1,12 @@ T13674.hs:56:21: error: - • Occurs check: cannot construct the infinite type: m ~ Lcm m m - Expected type: GF m - Actual type: GF (Lcm m m) + • Couldn't match type ‘m’ with ‘Lcm m m’ + Expected: GF m + Actual: GF (Lcm m m) + ‘m’ is a rigid type variable bound by + the type signature for: + bar :: forall (m :: Nat). KnownNat m => GF m -> GF m -> GF m + at T13674.hs:55:1-44 • In the first argument of ‘(-)’, namely ‘foo x y’ In the expression: foo x y - foo y x \\ lcmNat @m @m \\ Sub @() (lcmIsIdempotent @m) @@ -15,9 +19,13 @@ T13674.hs:56:21: error: bar :: GF m -> GF m -> GF m (bound at T13674.hs:56:1) T13674.hs:56:31: error: - • Occurs check: cannot construct the infinite type: m ~ Lcm m m - Expected type: GF m - Actual type: GF (Lcm m m) + • Couldn't match type ‘m’ with ‘Lcm m m’ + Expected: GF m + Actual: GF (Lcm m m) + ‘m’ is a rigid type variable bound by + the type signature for: + bar :: forall (m :: Nat). KnownNat m => GF m -> GF m -> GF m + at T13674.hs:55:1-44 • In the first argument of ‘(\\)’, namely ‘foo y x’ In the first argument of ‘(\\)’, namely ‘foo y x \\ lcmNat @m @m’ In the second argument of ‘(-)’, namely diff --git a/testsuite/tests/indexed-types/should_fail/T13784.stderr b/testsuite/tests/indexed-types/should_fail/T13784.stderr index 63edf0482f..11b1a188f2 100644 --- a/testsuite/tests/indexed-types/should_fail/T13784.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13784.stderr @@ -1,11 +1,11 @@ T13784.hs:29:28: error: • Couldn't match type ‘as’ with ‘a : Divide a as’ + Expected: Product (Divide a (a : as)) + Actual: Product as1 ‘as’ is a rigid type variable bound by the instance declaration at T13784.hs:25:10-30 - Expected type: Product (Divide a (a : as)) - Actual type: Product as1 • In the expression: as In the expression: (a, as) In an equation for ‘divide’: divide (a :* as) = (a, as) @@ -14,10 +14,10 @@ T13784.hs:29:28: error: (bound at T13784.hs:29:5) T13784.hs:33:24: error: - • Couldn't match type ‘Product (a : as0)’ - with ‘(b, Product (Divide b (a : as)))’ - Expected type: (b, Product (Divide b (a : as))) - Actual type: Product (a1 : as0) + • Couldn't match type: Product (a : as0) + with: (b, Product (Divide b (a : as))) + Expected: (b, Product (Divide b (a : as))) + Actual: Product (a1 : as0) • In the expression: a :* divide as In an equation for ‘divide’: divide (a :* as) = a :* divide as In the instance declaration for ‘Divideable b (a : as)’ @@ -26,10 +26,10 @@ T13784.hs:33:24: error: (bound at T13784.hs:33:5) T13784.hs:33:29: error: - • Couldn't match type ‘(a0, Product (Divide a0 as))’ - with ‘Product as0’ - Expected type: Product as0 - Actual type: (a0, Product (Divide a0 as1)) + • Couldn't match type: (a0, Product (Divide a0 as)) + with: Product as0 + Expected: Product as0 + Actual: (a0, Product (Divide a0 as1)) • In the second argument of ‘(:*)’, namely ‘divide as’ In the expression: a :* divide as In an equation for ‘divide’: divide (a :* as) = a :* divide as diff --git a/testsuite/tests/indexed-types/should_fail/T14246.stderr b/testsuite/tests/indexed-types/should_fail/T14246.stderr index fcc2605527..d6bfde7b5b 100644 --- a/testsuite/tests/indexed-types/should_fail/T14246.stderr +++ b/testsuite/tests/indexed-types/should_fail/T14246.stderr @@ -5,20 +5,24 @@ T14246.hs:18:5: error: In the type family declaration for ‘KLN’ T14246.hs:22:27: error: - • Expected kind ‘Vect (KLN f) L’, + • Couldn't match kind: 'S (KLN (f t)) + with: KLN f + Expected kind ‘Vect (KLN f) L’, but ‘Cons (Label (t :: v)) l’ has kind ‘Vect ('S (KLN (f t))) (*)’ • In the second argument of ‘Reveal’, namely ‘(Cons (Label (t :: v)) l)’ In the type family declaration for ‘Reveal’ T14246.hs:22:67: error: - • Expected kind ‘Vect (KLN (f t)) L’, + • Couldn't match kind ‘*’ with ‘L’ + Expected kind ‘Vect (KLN (f t)) L’, but ‘l’ has kind ‘Vect (KLN (f t)) (*)’ • In the second argument of ‘Reveal’, namely ‘l’ In the type ‘Reveal (f t) l’ In the type family declaration for ‘Reveal’ T14246.hs:23:24: error: - • Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect 'Z L’ + • Couldn't match kind ‘'Z’ with ‘KLN a’ + Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect 'Z L’ • In the second argument of ‘Reveal’, namely ‘Nil’ In the type family declaration for ‘Reveal’ diff --git a/testsuite/tests/indexed-types/should_fail/T14369.stderr b/testsuite/tests/indexed-types/should_fail/T14369.stderr index accd2d9b01..d31a77b2fa 100644 --- a/testsuite/tests/indexed-types/should_fail/T14369.stderr +++ b/testsuite/tests/indexed-types/should_fail/T14369.stderr @@ -1,8 +1,9 @@ T14369.hs:29:5: error: - • Couldn't match type ‘Demote a’ with ‘Demote a1’ - Expected type: Sing x -> Maybe (Demote a1) - Actual type: Sing x -> Demote (Maybe a) + • Couldn't match type: Demote a + with: Demote a1 + Expected: Sing x -> Maybe (Demote a1) + Actual: Sing x -> Demote (Maybe a) • In the expression: fromSing In an equation for ‘f’: f = fromSing • Relevant bindings include diff --git a/testsuite/tests/indexed-types/should_fail/T14904.stderr b/testsuite/tests/indexed-types/should_fail/T14904.stderr index dd5506c855..8a7142d350 100644 --- a/testsuite/tests/indexed-types/should_fail/T14904.stderr +++ b/testsuite/tests/indexed-types/should_fail/T14904.stderr @@ -1,6 +1,8 @@ T14904.hs:8:8: error: • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall (a :: k1). g a • In the first argument of ‘F’, namely ‘((f :: forall a. g a) :: forall a. g a)’ In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/T15870.stderr b/testsuite/tests/indexed-types/should_fail/T15870.stderr index 4acacbab50..2cba04fd97 100644 --- a/testsuite/tests/indexed-types/should_fail/T15870.stderr +++ b/testsuite/tests/indexed-types/should_fail/T15870.stderr @@ -1,6 +1,7 @@ T15870.hs:32:34: error: - • Expected kind ‘Optic a’, but ‘g2’ has kind ‘Optic b’ + • Couldn't match kind ‘k’ with ‘*’ + Expected kind ‘Optic a’, but ‘g2’ has kind ‘Optic b’ • In the second argument of ‘Get’, namely ‘g2’ In the type ‘Get a g2’ In the type instance declaration for ‘Get’ diff --git a/testsuite/tests/indexed-types/should_fail/T1897b.stderr b/testsuite/tests/indexed-types/should_fail/T1897b.stderr index a2055816ae..9048b59770 100644 --- a/testsuite/tests/indexed-types/should_fail/T1897b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1897b.stderr @@ -1,8 +1,9 @@ T1897b.hs:16:1: error: - • Couldn't match type ‘Depend a’ with ‘Depend a0’ - Expected type: t (Depend a) -> Bool - Actual type: t (Depend a0) -> Bool + • Couldn't match type: Depend a0 + with: Depend a + Expected: t (Depend a) -> Bool + Actual: t (Depend a0) -> Bool NB: ‘Depend’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for the inferred type for ‘isValid’ diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr index 4b144f85f6..a9fb9051e8 100644 --- a/testsuite/tests/indexed-types/should_fail/T1900.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr @@ -1,8 +1,9 @@ T1900.hs:7:3: error: - • Couldn't match type ‘Depend s0’ with ‘Depend s’ - Expected type: Depend s -> Depend s - Actual type: Depend s0 -> Depend s0 + • Couldn't match type: Depend s0 + with: Depend s + Expected: Depend s -> Depend s + Actual: Depend s0 -> Depend s0 NB: ‘Depend’ is a non-injective type family The type variable ‘s0’ is ambiguous • In the ambiguity check for ‘trans’ diff --git a/testsuite/tests/indexed-types/should_fail/T2239.hs b/testsuite/tests/indexed-types/should_fail/T2239.hs index 0d675b175c..c64021c070 100644 --- a/testsuite/tests/indexed-types/should_fail/T2239.hs +++ b/testsuite/tests/indexed-types/should_fail/T2239.hs @@ -45,11 +45,11 @@ simpleTF = id :: (forall b. b~Bool => b->b) -- Actually these two do not involve impredicative instantiation, -- so they now succeed -complexFD = id :: (forall b. MyEq b Bool => b->b) - -> (forall c. MyEq c Bool => c->c) +complexFD = (\x -> x) :: (forall b. MyEq b Bool => b->b) + -> (forall c. MyEq c Bool => c->c) -complexTF = id :: (forall b. b~Bool => b->b) - -> (forall c. c~Bool => c->c) +complexTF = (\x -> x) :: (forall b. b~Bool => b->b) + -> (forall c. c~Bool => c->c) {- For example, here is how the subsumption check works for complexTF when type-checking the expression @@ -65,4 +65,4 @@ complexTF = id :: (forall b. b~Bool => b->b) b~Bool |-3 alpha[3] ~ b->b, (forall c. c~Bool => c->c) <= a And this is perfectly soluble. alpha is touchable; and c is instantiated. --}
\ No newline at end of file +-} diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr index 6b1a6bd075..40409c10cc 100644 --- a/testsuite/tests/indexed-types/should_fail/T2544.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr @@ -1,8 +1,9 @@ T2544.hs:19:18: error: - • Couldn't match type ‘IxMap i0’ with ‘IxMap l’ - Expected type: IxMap l [Int] - Actual type: IxMap i0 [Int] + • 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’ diff --git a/testsuite/tests/indexed-types/should_fail/T2627b.stderr b/testsuite/tests/indexed-types/should_fail/T2627b.stderr index 63f11b97f1..b69883ab88 100644 --- a/testsuite/tests/indexed-types/should_fail/T2627b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2627b.stderr @@ -1,8 +1,18 @@ T2627b.hs:20:24: error: - • Occurs check: cannot construct the infinite type: - b0 ~ Dual (Dual b0) + • Could not deduce: Dual (Dual b0) ~ b0 arising from a use of ‘conn’ + from the context: (Dual a ~ b, Dual b ~ a) + bound by the type signature for: + conn :: forall a b. + (Dual a ~ b, Dual b ~ a) => + Comm a -> Comm b -> (Int, Int) + at T2627b.hs:19:1-66 + or from: a ~ R c d + bound by a pattern with constructor: + Rd :: forall c d. (c -> Comm d) -> Comm (R c d), + in an equation for ‘conn’ + at T2627b.hs:20:7-10 The type variable ‘b0’ is ambiguous • In the expression: conn undefined undefined In an equation for ‘conn’: diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr index f52703865f..64fa851258 100644 --- a/testsuite/tests/indexed-types/should_fail/T2664.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr @@ -7,8 +7,8 @@ T2664.hs:31:9: error: ((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) => IO (PChan (a :*: b), PChan c) at T2664.hs:23:5-12 - Expected type: IO (PChan (a :*: b), PChan c) - Actual type: IO (PChan (a :*: b), PChan (Dual b :+: Dual a)) + 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 diff --git a/testsuite/tests/indexed-types/should_fail/T2693.stderr b/testsuite/tests/indexed-types/should_fail/T2693.stderr index f9485d1d42..57d4303849 100644 --- a/testsuite/tests/indexed-types/should_fail/T2693.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2693.stderr @@ -1,6 +1,7 @@ T2693.hs:12:15: error: - • Couldn't match expected type ‘(a8, b1)’ with actual type ‘TFn a6’ + • Couldn't match expected type: (a8, b1) + with actual type: TFn a6 The type variables ‘a6’, ‘a8’, ‘b1’ are ambiguous • In the first argument of ‘fst’, namely ‘x’ In the first argument of ‘(+)’, namely ‘fst x’ @@ -8,7 +9,8 @@ T2693.hs:12:15: error: • Relevant bindings include n :: a8 (bound at T2693.hs:12:7) T2693.hs:12:23: error: - • Couldn't match expected type ‘(a8, b2)’ with actual type ‘TFn a7’ + • Couldn't match expected type: (a8, b2) + with actual type: TFn a7 The type variables ‘a7’, ‘a8’, ‘b2’ are ambiguous • In the first argument of ‘fst’, namely ‘x’ In the second argument of ‘(+)’, namely ‘fst x’ @@ -16,7 +18,8 @@ T2693.hs:12:23: error: • Relevant bindings include n :: a8 (bound at T2693.hs:12:7) T2693.hs:19:15: error: - • Couldn't match expected type ‘(a5, b0)’ with actual type ‘TFn a2’ + • Couldn't match expected type: (a5, b0) + with actual type: TFn a2 The type variables ‘a2’, ‘a5’, ‘b0’ are ambiguous • In the first argument of ‘fst’, namely ‘x’ In the first argument of ‘(+)’, namely ‘fst x’ @@ -24,7 +27,8 @@ T2693.hs:19:15: error: • Relevant bindings include n :: a5 (bound at T2693.hs:19:7) T2693.hs:19:23: error: - • Couldn't match expected type ‘(a4, a5)’ with actual type ‘TFn a3’ + • Couldn't match expected type: (a4, a5) + with actual type: TFn a3 The type variables ‘a3’, ‘a4’, ‘a5’ are ambiguous • In the first argument of ‘snd’, namely ‘x’ In the second argument of ‘(+)’, namely ‘snd x’ @@ -32,9 +36,10 @@ T2693.hs:19:23: error: • Relevant bindings include n :: a5 (bound at T2693.hs:19:7) T2693.hs:29:20: error: - • Couldn't match type ‘TFn a0’ with ‘PVR a1’ - Expected type: () -> Maybe (PVR a1) - Actual type: () -> Maybe (TFn a0) + • Couldn't match type: TFn a0 + with: PVR a1 + Expected: () -> Maybe (PVR a1) + Actual: () -> Maybe (TFn a0) The type variables ‘a0’, ‘a1’ are ambiguous • In the first argument of ‘mapM’, namely ‘g’ In a stmt of a 'do' block: pvs <- mapM g undefined diff --git a/testsuite/tests/indexed-types/should_fail/T3330a.stderr b/testsuite/tests/indexed-types/should_fail/T3330a.stderr index dfc2e4223d..1fba198ab7 100644 --- a/testsuite/tests/indexed-types/should_fail/T3330a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T3330a.stderr @@ -2,14 +2,13 @@ T3330a.hs:19:34: error: • Couldn't match type ‘ix’ with ‘r ix1 -> Writer [AnyF s] (r'0 ix1)’ + Expected: (s0 ix0 -> ix1) -> r ix1 -> Writer [AnyF s] (r'0 ix1) + Actual: s ix ‘ix’ is a rigid type variable bound by the type signature for: children :: forall (s :: * -> *) ix (r :: * -> *). s ix -> PF s r ix -> [AnyF s] at T3330a.hs:18:1-43 - Expected type: (s0 ix0 -> ix1) - -> r ix1 -> Writer [AnyF s] (r'0 ix1) - Actual type: s ix • In the first argument of ‘hmapM’, namely ‘p’ In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’ In the expression: execWriter (hmapM p collect x) @@ -21,13 +20,13 @@ T3330a.hs:19:34: error: T3330a.hs:19:44: error: • Couldn't match type ‘ix’ with ‘r0 ix0 -> Writer [AnyF s0] (r0 ix0)’ + Expected: PF s r (r0 ix0 -> Writer [AnyF s0] (r0 ix0)) + Actual: PF s r ix ‘ix’ is a rigid type variable bound by the type signature for: children :: forall (s :: * -> *) ix (r :: * -> *). s ix -> PF s r ix -> [AnyF s] at T3330a.hs:18:1-43 - Expected type: PF s r (r0 ix0 -> Writer [AnyF s0] (r0 ix0)) - Actual type: PF s r ix • In the third argument of ‘hmapM’, namely ‘x’ In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’ In the expression: execWriter (hmapM p collect x) diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.stderr b/testsuite/tests/indexed-types/should_fail/T3330c.stderr index 943dbb148b..9222e6fffe 100644 --- a/testsuite/tests/indexed-types/should_fail/T3330c.stderr +++ b/testsuite/tests/indexed-types/should_fail/T3330c.stderr @@ -4,8 +4,8 @@ T3330c.hs:25:43: error: When matching types f1 :: * -> * f1 x :: * - Expected type: Der ((->) x) (f1 x) - Actual type: R f1 + Expected: Der ((->) x) (f1 x) + Actual: R f1 • In the first argument of ‘plug’, namely ‘rf’ In the first argument of ‘Inl’, namely ‘(plug rf df x)’ In the expression: Inl (plug rf df x) diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr index 826fe1934a..81d9c404ed 100644 --- a/testsuite/tests/indexed-types/should_fail/T4093a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr @@ -5,12 +5,12 @@ T4093a.hs:8:8: error: bound by the type signature for: hang :: forall e. (Foo e ~ Maybe e) => Foo e at T4093a.hs:7:1-34 + Expected: Foo e + Actual: Maybe () ‘e’ is a rigid type variable bound by the type signature for: hang :: forall e. (Foo e ~ Maybe e) => Foo e at T4093a.hs:7:1-34 - Expected type: Foo e - Actual type: Maybe () • In the expression: Just () In an equation for ‘hang’: hang = Just () • Relevant bindings include hang :: Foo e (bound at T4093a.hs:8:1) diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.stderr b/testsuite/tests/indexed-types/should_fail/T4093b.stderr index 195b113ede..367c904e4f 100644 --- a/testsuite/tests/indexed-types/should_fail/T4093b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4093b.stderr @@ -9,6 +9,8 @@ T4093b.hs:31:13: error: EitherCO x (A C C n) (A C O n) ~ A C x n) => Block n e x -> A e x n at T4093b.hs:(19,1)-(22,26) + Expected: EitherCO e (A C O n) (A O O n) + Actual: (MaybeC C (n C O), MaybeC O (n O C)) ‘e’ is a rigid type variable bound by the type signature for: blockToNodeList :: forall (n :: * -> * -> *) e x. @@ -16,8 +18,6 @@ T4093b.hs:31:13: error: EitherCO x (A C C n) (A C O n) ~ A C x n) => Block n e x -> A e x n at T4093b.hs:(19,1)-(22,26) - Expected type: EitherCO e (A C O n) (A O O n) - Actual type: (MaybeC C (n C O), MaybeC O (n O C)) • In the expression: (JustC n, NothingC) In an equation for ‘f’: f n _ = (JustC n, NothingC) In an equation for ‘blockToNodeList’: diff --git a/testsuite/tests/indexed-types/should_fail/T4099.stderr b/testsuite/tests/indexed-types/should_fail/T4099.stderr index acc2ed29ae..5ed4d36640 100644 --- a/testsuite/tests/indexed-types/should_fail/T4099.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4099.stderr @@ -1,6 +1,7 @@ T4099.hs:11:30: error: - • Couldn't match expected type ‘T a0’ with actual type ‘T b’ + • Couldn't match expected type: T a0 + with actual type: T b NB: ‘T’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the second argument of ‘foo’, namely ‘x’ @@ -12,7 +13,8 @@ T4099.hs:11:30: error: bar1 :: b -> T b -> Int (bound at T4099.hs:11:1) T4099.hs:14:30: error: - • Couldn't match expected type ‘T a1’ with actual type ‘Maybe b’ + • Couldn't match expected type: T a1 + with actual type: Maybe b The type variable ‘a1’ is ambiguous • In the second argument of ‘foo’, namely ‘x’ In the expression: foo (error "urk") x diff --git a/testsuite/tests/indexed-types/should_fail/T4174.stderr b/testsuite/tests/indexed-types/should_fail/T4174.stderr index ccc88ced1e..ae962edf36 100644 --- a/testsuite/tests/indexed-types/should_fail/T4174.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4174.stderr @@ -1,14 +1,14 @@ T4174.hs:44:12: error: • Couldn't match type ‘b’ with ‘RtsSpinLock’ + Expected: m (Field (Way (GHC6'8 minor) n t p) a b) + Actual: m (Field (WayOf m) SmStep RtsSpinLock) ‘b’ is a rigid type variable bound by the type signature for: testcase :: forall (m :: * -> *) minor n t p a b. Monad m => m (Field (Way (GHC6'8 minor) n t p) a b) at T4174.hs:43:1-63 - Expected type: m (Field (Way (GHC6'8 minor) n t p) a b) - Actual type: m (Field (WayOf m) SmStep RtsSpinLock) • In the expression: sync_large_objects In an equation for ‘testcase’: testcase = sync_large_objects • Relevant bindings include diff --git a/testsuite/tests/indexed-types/should_fail/T4179.stderr b/testsuite/tests/indexed-types/should_fail/T4179.stderr index 2f0d5e3644..4665a1a321 100644 --- a/testsuite/tests/indexed-types/should_fail/T4179.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4179.stderr @@ -1,12 +1,12 @@ T4179.hs:26:16: error: - • Couldn't match type ‘A2 (x (A2 (FCon x) -> A3 (FCon x)))’ - with ‘A2 (FCon x)’ - Expected type: x (A2 (FCon x) -> A3 (FCon x)) - -> A2 (FCon x) -> A3 (FCon x) - Actual type: x (A2 (FCon x) -> A3 (FCon x)) - -> A2 (x (A2 (FCon x) -> A3 (FCon x))) - -> A3 (x (A2 (FCon x) -> A3 (FCon x))) + • Couldn't match type: A2 (x (A2 (FCon x) -> A3 (FCon x))) + with: A2 (FCon x) + Expected: x (A2 (FCon x) -> A3 (FCon x)) + -> A2 (FCon x) -> A3 (FCon x) + Actual: x (A2 (FCon x) -> A3 (FCon x)) + -> A2 (x (A2 (FCon x) -> A3 (FCon x))) + -> A3 (x (A2 (FCon x) -> A3 (FCon x))) NB: ‘A2’ is a non-injective type family • In the first argument of ‘foldDoC’, namely ‘op’ In the expression: foldDoC op diff --git a/testsuite/tests/indexed-types/should_fail/T4272.stderr b/testsuite/tests/indexed-types/should_fail/T4272.stderr index f0c5ab57f0..69df514c0f 100644 --- a/testsuite/tests/indexed-types/should_fail/T4272.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4272.stderr @@ -1,9 +1,12 @@ T4272.hs:15:26: error: - • Occurs check: cannot construct the infinite type: - a ~ TermFamily a a - Expected type: TermFamily a (TermFamily a a) - Actual type: TermFamily a a + • 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 first argument of ‘terms’, namely ‘(undefined :: TermFamily a a)’ In the second argument of ‘prune’, namely diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr index f712d47f0e..5dcce91edb 100644 --- a/testsuite/tests/indexed-types/should_fail/T5439.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr @@ -1,8 +1,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)’ + • 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 ‘inj $ Failure (e :: SomeException)’ In a stmt of a 'do' block: @@ -21,8 +21,8 @@ T5439.hs:82:33: error: (bound at T5439.hs:61:3) T5439.hs:82:39: error: - • Couldn't match expected type ‘Peano n0’ - with actual type ‘Attempt α0’ + • Couldn't match expected type: Peano n0 + with actual type: Attempt α0 • In the second argument of ‘($)’, namely ‘Failure (e :: SomeException)’ In the second argument of ‘($)’, namely diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr index e7448a9722..48f8bacef5 100644 --- a/testsuite/tests/indexed-types/should_fail/T5934.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr @@ -1,7 +1,8 @@ T5934.hs:12:7: error: - • Cannot instantiate unification variable ‘a0’ + • Couldn't match expected type ‘(forall s. GenST s) -> Int’ + with actual type ‘a0’ + Cannot instantiate unification variable ‘a0’ with a type involving polytypes: (forall s. GenST s) -> Int - GHC doesn't yet support impredicative polymorphism • In the expression: 0 In an equation for ‘run’: run = 0 diff --git a/testsuite/tests/indexed-types/should_fail/T6123.stderr b/testsuite/tests/indexed-types/should_fail/T6123.stderr index 0ae1a5e3c1..eafd27c454 100644 --- a/testsuite/tests/indexed-types/should_fail/T6123.stderr +++ b/testsuite/tests/indexed-types/should_fail/T6123.stderr @@ -1,7 +1,6 @@ T6123.hs:10:14: error: - • Occurs check: cannot construct the infinite type: a0 ~ Id a0 - arising from a use of ‘cid’ + • Couldn't match type ‘a0’ with ‘Id a0’ arising from a use of ‘cid’ The type variable ‘a0’ is ambiguous • In the expression: cid undefined In an equation for ‘cundefined’: cundefined = cid undefined diff --git a/testsuite/tests/indexed-types/should_fail/T7010.stderr b/testsuite/tests/indexed-types/should_fail/T7010.stderr index 0da40f7a69..12f443df7d 100644 --- a/testsuite/tests/indexed-types/should_fail/T7010.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7010.stderr @@ -1,8 +1,9 @@ T7010.hs:53:27: error: - • Couldn't match type ‘IO Float’ with ‘Serial (IO Float)’ - Expected type: (Float, ValueTuple Vector) - Actual type: (Float, ValueTuple Float) + • Couldn't match type: IO Float + with: Serial (IO Float) + Expected: (Float, ValueTuple Vector) + Actual: (Float, ValueTuple Float) • In the first argument of ‘withArgs’, namely ‘plug’ In the expression: withArgs plug In an equation for ‘filterFormants’: filterFormants = withArgs plug diff --git a/testsuite/tests/indexed-types/should_fail/T7354.stderr b/testsuite/tests/indexed-types/should_fail/T7354.stderr index b7b70b8f4e..1a20e096f1 100644 --- a/testsuite/tests/indexed-types/should_fail/T7354.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7354.stderr @@ -1,9 +1,8 @@ T7354.hs:28:11: error: - • Occurs check: cannot construct the infinite type: - p ~ Base t (Prim [p] p) - Expected type: Prim [p] p -> Base t (Prim [p] p) - Actual type: Prim [p] p -> p + • Couldn't match type ‘p’ with ‘Base t (Prim [p] p)’ + Expected: Prim [p] p -> Base t (Prim [p] p) + Actual: Prim [p] p -> p • In the first argument of ‘ana’, namely ‘alg’ In the expression: ana alg In an equation for ‘foo’: foo = ana alg diff --git a/testsuite/tests/indexed-types/should_fail/T7729.stderr b/testsuite/tests/indexed-types/should_fail/T7729.stderr index b209c9c4b7..baf93df666 100644 --- a/testsuite/tests/indexed-types/should_fail/T7729.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7729.stderr @@ -1,8 +1,9 @@ T7729.hs:36:14: error: - • Couldn't match type ‘BasePrimMonad m’ with ‘t0 (BasePrimMonad m)’ - Expected type: t0 (BasePrimMonad m) a -> Rand m a - Actual type: BasePrimMonad (Rand m) a -> Rand m a + • Couldn't match type: BasePrimMonad m + with: t0 (BasePrimMonad m) + Expected: t0 (BasePrimMonad m) a -> Rand m a + Actual: BasePrimMonad (Rand m) a -> Rand m a The type variable ‘t0’ is ambiguous • In the first argument of ‘(.)’, namely ‘liftPrim’ In the expression: liftPrim . lift diff --git a/testsuite/tests/indexed-types/should_fail/T7729a.stderr b/testsuite/tests/indexed-types/should_fail/T7729a.stderr index e5a6289d96..60be4271ed 100644 --- a/testsuite/tests/indexed-types/should_fail/T7729a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7729a.stderr @@ -1,8 +1,9 @@ T7729a.hs:36:26: error: - • Couldn't match type ‘BasePrimMonad m’ with ‘t0 (BasePrimMonad m)’ - Expected type: BasePrimMonad (Rand m) a - Actual type: t0 (BasePrimMonad m) a + • Couldn't match type: BasePrimMonad m + with: t0 (BasePrimMonad m) + Expected: BasePrimMonad (Rand m) a + Actual: t0 (BasePrimMonad m) a The type variable ‘t0’ is ambiguous • In the first argument of ‘liftPrim’, namely ‘(lift x)’ In the expression: liftPrim (lift x) diff --git a/testsuite/tests/indexed-types/should_fail/T7967.stderr b/testsuite/tests/indexed-types/should_fail/T7967.stderr index 63d2ba8328..8a7e419a5d 100644 --- a/testsuite/tests/indexed-types/should_fail/T7967.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7967.stderr @@ -1,7 +1,8 @@ T7967.hs:33:26: error: - • Couldn't match type ‘h0 : t0’ with ‘'[]’ - Expected type: Index n l - Actual type: Index 'Zero (h0 : t0) + • Couldn't match type: h0 : t0 + with: '[] + Expected: Index n l + Actual: Index 'Zero (h0 : t0) • In the expression: IZero In an equation for ‘sNatToIndex’: sNatToIndex SZero HNil = IZero diff --git a/testsuite/tests/indexed-types/should_fail/T8227.stderr b/testsuite/tests/indexed-types/should_fail/T8227.stderr index f86ac68d95..99d1763163 100644 --- a/testsuite/tests/indexed-types/should_fail/T8227.stderr +++ b/testsuite/tests/indexed-types/should_fail/T8227.stderr @@ -1,10 +1,10 @@ T8227.hs:17:27: error: - • Couldn't match type ‘Scalar (V a)’ - with ‘Scalar (V a) -> Scalar (V a)’ - Expected type: Scalar (V a) - Actual type: Scalar (V (Scalar (V a) -> Scalar (V a))) - -> Scalar (V (Scalar (V a) -> Scalar (V a))) + • Couldn't match type: Scalar (V a) + with: Scalar (V a) -> Scalar (V a) + Expected: Scalar (V a) + Actual: Scalar (V (Scalar (V a) -> Scalar (V a))) + -> Scalar (V (Scalar (V a) -> Scalar (V a))) • In the expression: arcLengthToParam eps eps In an equation for ‘absoluteToParam’: absoluteToParam eps seg = arcLengthToParam eps eps diff --git a/testsuite/tests/indexed-types/should_fail/T8518.stderr b/testsuite/tests/indexed-types/should_fail/T8518.stderr index b18202fec9..1f244f9ee2 100644 --- a/testsuite/tests/indexed-types/should_fail/T8518.stderr +++ b/testsuite/tests/indexed-types/should_fail/T8518.stderr @@ -1,7 +1,7 @@ T8518.hs:14:18: error: - • Couldn't match expected type ‘Z c -> B c -> Maybe (F c)’ - with actual type ‘F c’ + • Couldn't match expected type: Z c -> B c -> Maybe (F c) + with actual type: F c • The function ‘rpt’ is applied to four value arguments, but its type ‘Int -> c -> F c’ has only two In the expression: rpt (4 :: Int) c z b @@ -18,9 +18,10 @@ T8518.hs:14:18: error: callCont :: c -> Z c -> B c -> Maybe (F c) (bound at T8518.hs:14:1) T8518.hs:16:9: error: - • Couldn't match type ‘F t1’ with ‘Z t1 -> B t1 -> F t1’ - Expected type: t -> t1 -> F t1 - Actual type: t -> t1 -> Z t1 -> B t1 -> F t1 + • Couldn't match type: F t1 + with: Z t1 -> B t1 -> F t1 + Expected: t -> t1 -> F t1 + Actual: t -> t1 -> Z t1 -> B t1 -> F t1 • In an equation for ‘callCont’: callCont c z b = rpt (4 :: Int) c z b diff --git a/testsuite/tests/indexed-types/should_fail/T9036.stderr b/testsuite/tests/indexed-types/should_fail/T9036.stderr index 151dfb7f2d..0f783738ba 100644 --- a/testsuite/tests/indexed-types/should_fail/T9036.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9036.stderr @@ -1,9 +1,10 @@ T9036.hs:18:17: error: - • Couldn't match type ‘Curried t0 [t0]’ with ‘Curried t [t]’ - Expected type: Maybe (GetMonad t after) -> Curried t [t] - Actual type: Maybe (GetMonad t0 after) -> Curried t0 [t0] - NB: ‘Curried’ is a non-injective type family + • Couldn't match type: GetMonad t0 + with: GetMonad t + Expected: Maybe (GetMonad t after) -> Curried t [t] + Actual: Maybe (GetMonad t0 after) -> Curried t0 [t0] + NB: ‘GetMonad’ is a non-injective type family The type variable ‘t0’ is ambiguous • In the ambiguity check for ‘simpleLogger’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr index 320a6add8d..6922be8ade 100644 --- a/testsuite/tests/indexed-types/should_fail/T9171.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr @@ -1,9 +1,9 @@ T9171.hs:10:20: error: - • Couldn't match expected type ‘GetParam - @(*) @k2 @(*) Base (GetParam @(*) @(*) @k2 Base Int)’ - with actual type ‘GetParam - @(*) @k20 @(*) Base (GetParam @(*) @(*) @k20 Base Int)’ + • Couldn't match expected type: GetParam + @(*) @k2 @(*) Base (GetParam @(*) @(*) @k2 Base Int) + with actual type: GetParam + @(*) @k20 @(*) Base (GetParam @(*) @(*) @k20 Base Int) NB: ‘GetParam’ is a non-injective type family The type variable ‘k20’ is ambiguous • In the ambiguity check for an expression type signature diff --git a/testsuite/tests/indexed-types/should_fail/T9662.stderr b/testsuite/tests/indexed-types/should_fail/T9662.stderr index 4f35d92b5e..04acdc653d 100644 --- a/testsuite/tests/indexed-types/should_fail/T9662.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9662.stderr @@ -1,17 +1,17 @@ T9662.hs:49:8: error: - • Couldn't match type ‘k’ with ‘Int’ - ‘k’ is a rigid type variable bound by + • Couldn't match type ‘n’ with ‘Int’ + Expected: Exp (((sh :. k) :. m) :. n) + -> Exp (((sh :. k) :. m) :. n) + Actual: Exp + (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int)) + -> Exp + (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int)) + ‘n’ is a rigid type variable bound by the type signature for: test :: forall sh k m n. Shape (((sh :. k) :. m) :. n) -> Shape (((sh :. m) :. n) :. k) at T9662.hs:46:1-50 - Expected type: Exp (((sh :. m) :. n) :. k) - -> Exp (((sh :. m) :. n) :. k) - Actual type: Exp - (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int)) - -> Exp - (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int)) • In the first argument of ‘backpermute’, namely ‘(modify (atom :. atom :. atom :. atom) diff --git a/testsuite/tests/module/mod180.stderr b/testsuite/tests/module/mod180.stderr index f76cfc8480..1518a63e82 100644 --- a/testsuite/tests/module/mod180.stderr +++ b/testsuite/tests/module/mod180.stderr @@ -1,8 +1,8 @@ mod180.hs:8:5: error: - Couldn't match expected type ‘T’ - with actual type ‘main:Mod180_A.T’ - NB: ‘main:Mod180_A.T’ is defined at Mod180_A.hs:3:1-10 - ‘T’ is defined at Mod180_B.hs:3:1-10 - In the expression: x - In an equation for ‘z’: z = x + • Couldn't match expected type ‘T’ + with actual type ‘main:Mod180_A.T’ + NB: ‘T’ is defined at Mod180_B.hs:3:1-10 + ‘main:Mod180_A.T’ is defined at Mod180_A.hs:3:1-10 + • In the expression: x + In an equation for ‘z’: z = x diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr index 4d55087e18..3ff4cb3678 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr @@ -1,8 +1,8 @@ overloadedlistsfail03.hs:3:28: error: • Couldn't match type ‘[Char]’ with ‘Char’ - Expected type: GHC.Exts.Item [Char] - Actual type: [Char] + Expected: GHC.Exts.Item [Char] + Actual: String • In the expression: "b" In the first argument of ‘length’, namely ‘(['a', "b"] :: [Char])’ In the first argument of ‘print’, namely diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr index edd0c7fcef..6f0045a462 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr @@ -1,8 +1,8 @@ overloadedlistsfail05.hs:3:24: error: • Couldn't match type ‘Char’ with ‘Int’ - Expected type: GHC.Exts.Item [Int] - Actual type: Char + Expected: GHC.Exts.Item [Int] + Actual: Char • In the expression: 'a' In the first argument of ‘length’, namely ‘(['a' .. (10 :: Int)] :: [Int])’ diff --git a/testsuite/tests/parser/should_compile/T2245.stderr b/testsuite/tests/parser/should_compile/T2245.stderr index b823c00ed0..8e48cfb189 100644 --- a/testsuite/tests/parser/should_compile/T2245.stderr +++ b/testsuite/tests/parser/should_compile/T2245.stderr @@ -13,10 +13,10 @@ T2245.hs:5:10: warning: [-Wmissing-methods (in -Wdefault)] T2245.hs:7:27: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘T’ - (Ord a0) arising from a use of ‘<’ at T2245.hs:7:27 - (Fractional a0) + (Ord b0) arising from a use of ‘<’ at T2245.hs:7:27 + (Fractional b0) arising from the literal ‘1e400’ at T2245.hs:7:29-33 - (Read a0) arising from a use of ‘read’ at T2245.hs:7:38-41 + (Read b0) arising from a use of ‘read’ at T2245.hs:7:38-41 • In the first argument of ‘(.)’, namely ‘(< 1e400)’ In the second argument of ‘(.)’, namely ‘(< 1e400) . read’ In the second argument of ‘($)’, namely ‘show . (< 1e400) . read’ diff --git a/testsuite/tests/parser/should_fail/T8501c.stderr b/testsuite/tests/parser/should_fail/T8501c.stderr index b12b53e8ad..3b02432822 100644 --- a/testsuite/tests/parser/should_fail/T8501c.stderr +++ b/testsuite/tests/parser/should_fail/T8501c.stderr @@ -1,6 +1,6 @@ T8501c.hs:4:7: error: • Variable not in scope: - mdo :: (String -> IO ()) -> [Char] -> IO () + mdo :: (String -> IO ()) -> String -> IO () • Perhaps you meant ‘mod’ (imported from Prelude) Perhaps you meant to use RecursiveDo diff --git a/testsuite/tests/parser/should_fail/readFail003.stderr b/testsuite/tests/parser/should_fail/readFail003.stderr index 933f16179a..dbcc63f419 100644 --- a/testsuite/tests/parser/should_fail/readFail003.stderr +++ b/testsuite/tests/parser/should_fail/readFail003.stderr @@ -1,7 +1,7 @@ readFail003.hs:4:27: error: - • Occurs check: cannot construct the infinite type: - a ~ (a, [a1], [a2]) + • Couldn't match expected type ‘(a, [a1], [a2])’ + with actual type ‘a’ • In the expression: a In a pattern binding: ~(a, b, c) diff --git a/testsuite/tests/parser/should_fail/readFail032.stderr b/testsuite/tests/parser/should_fail/readFail032.stderr index 7cd106d69a..c845203048 100644 --- a/testsuite/tests/parser/should_fail/readFail032.stderr +++ b/testsuite/tests/parser/should_fail/readFail032.stderr @@ -1,11 +1,10 @@ -readFail032.hs:25:38: - Couldn't match type ‘Char’ with ‘[Char]’ - Expected type: [[Char]] - Actual type: [Char] - In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ +readFail032.hs:25:38: error: + • Couldn't match type ‘Char’ with ‘[Char]’ + Expected: [String] + Actual: String + • In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ In the expression: - "Type error on line 25" : "Type error on line 25" + "Type error on line 25" : "Type error on line 25" In an equation for ‘type_error’: type_error = "Type error on line 25" : "Type error on line 25" - diff --git a/testsuite/tests/parser/should_fail/readFail048.stderr b/testsuite/tests/parser/should_fail/readFail048.stderr index 62276db0c9..b1d7ab4dd2 100644 --- a/testsuite/tests/parser/should_fail/readFail048.stderr +++ b/testsuite/tests/parser/should_fail/readFail048.stderr @@ -1,11 +1,10 @@ -readFail048.hs:25:38: - Couldn't match type ‘Char’ with ‘[Char]’ - Expected type: [[Char]] - Actual type: [Char] - In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ +readFail048.hs:25:38: error: + • Couldn't match type ‘Char’ with ‘[Char]’ + Expected: [String] + Actual: String + • In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ In the expression: - "Type error on line 25" : "Type error on line 25" + "Type error on line 25" : "Type error on line 25" In an equation for ‘type_error’: type_error = "Type error on line 25" : "Type error on line 25" - diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr index 7a7a36472b..6672efb7ac 100644 --- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr @@ -15,5 +15,5 @@ DATA CONSTRUCTORS FAMILY INSTANCES data instance Sing _ -- Defined at DataFamilyInstanceLHS.hs:8:15 Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr index 4332d07a03..441bfa5720 100644 --- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - bravo :: forall {_}. Num _ => _ + bravo :: forall {w}. Num w => w Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr index 4332d07a03..441bfa5720 100644 --- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - bravo :: forall {_}. Num _ => _ + bravo :: forall {w}. Num w => w Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Either.stderr b/testsuite/tests/partial-sigs/should_compile/Either.stderr index f5f54d209e..6e48357b33 100644 --- a/testsuite/tests/partial-sigs/should_compile/Either.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Either.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - barry :: forall {_}. _ -> (Either [Char] _, Either [Char] _) + barry :: forall {w}. w -> (Either String w, Either String w) Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr index 28c25b80b6..eff1cb3577 100644 --- a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - every :: forall {_}. (_ -> Bool) -> [_] -> Bool + every :: forall {w}. (w -> Bool) -> [w] -> Bool Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr index 09a6ce2a17..73b2c3058f 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr @@ -132,12 +132,12 @@ TYPE SIGNATURES (P.Foldable t, Monad m) => (a -> m b) -> t a -> m () max :: forall {a}. Ord a => a -> a -> a - maxBound :: forall {_}. Bounded _ => _ + maxBound :: forall {w}. Bounded w => w maximum :: forall {t :: * -> *} {a}. (P.Foldable t, Ord a) => t a -> a maybe :: forall {b} {a}. b -> (a -> b) -> Maybe a -> b min :: forall {a}. Ord a => a -> a -> a - minBound :: forall {_}. Bounded _ => _ + minBound :: forall {w}. Bounded w => w minimum :: forall {t :: * -> *} {a}. (P.Foldable t, Ord a) => t a -> a mod :: forall {a}. Integral a => a -> a -> a @@ -149,7 +149,7 @@ TYPE SIGNATURES odd :: forall {a}. Integral a => a -> Bool or :: forall {t :: * -> *}. P.Foldable t => t Bool -> Bool otherwise :: Bool - pi :: forall {_}. Floating _ => _ + pi :: forall {w}. Floating w => w pred :: forall {a}. Enum a => a -> a print :: forall {a}. Show a => a -> IO () product :: @@ -219,7 +219,7 @@ TYPE SIGNATURES toRational :: forall {a}. Real a => a -> Rational truncate :: forall {a} {b}. (RealFrac a, Integral b) => a -> b uncurry :: forall {a} {b} {c}. (a -> b -> c) -> (a, b) -> c - undefined :: forall {_}. _ + undefined :: forall {w}. w unlines :: [String] -> String until :: forall {a}. (a -> Bool) -> (a -> a) -> a -> a unwords :: [String] -> String diff --git a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr index 49e98e3b0d..0bb722daf6 100644 --- a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - bar :: forall {_}. _ -> Bool + bar :: forall {w}. w -> Bool Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr index 298aa30c40..ea48244e0c 100644 --- a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr @@ -7,9 +7,9 @@ SplicesUsed.hs:7:15: warning: [-Wpartial-type-signatures (in -Wdefault)] In the type signature: maybeBool :: (_) SplicesUsed.hs:8:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_a’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of <expression> :: _ -> _ + • Found type wildcard ‘_a’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of <expression> :: w -> w at SplicesUsed.hs:8:14-23 • In an expression type signature: _a -> _a In the expression: id :: _a -> _a @@ -72,9 +72,9 @@ SplicesUsed.hs:16:2: warning: [-Wpartial-type-signatures (in -Wdefault)] • In the type signature: foo :: _ => _ SplicesUsed.hs:18:2: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_b’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: Bool -> _ -> (Bool, _) + • Found type wildcard ‘_b’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: Bool -> w -> (Bool, w) at SplicesUsed.hs:18:2-11 • In the type signature: bar :: _a -> _b -> (_a, _b) diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr index fcc5e38e87..e59a28a99d 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10403.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -2,22 +2,22 @@ T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Functor f’ Where: ‘f’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f + the inferred type of h1 :: Functor f => (a -> a1) -> f a -> H f at T10403.hs:17:1-41 • In the type signature: h1 :: _ => _ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’ - Where: ‘b’, ‘a’, ‘f’ are rigid type variables bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f + • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f a -> H f’ + Where: ‘a1’, ‘a’, ‘f’ are rigid type variables bound by + the inferred type of h1 :: Functor f => (a -> a1) -> f a -> H f at T10403.hs:17:1-41 • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’ + • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’ Where: ‘f0’ is an ambiguous type variable - ‘b’, ‘a’ are rigid type variables bound by - the inferred type of h2 :: (a -> b) -> f0 a -> H f0 + ‘a1’, ‘a’ are rigid type variables bound by + the inferred type of h2 :: (a -> a1) -> f0 a -> H f0 at T10403.hs:22:1-41 • In the type signature: h2 :: _ @@ -26,7 +26,7 @@ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] prevents the constraint ‘(Functor f0)’ from being solved. Relevant bindings include b :: f0 a (bound at T10403.hs:22:6) - h2 :: (a -> b) -> f0 a -> H f0 (bound at T10403.hs:22:1) + h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1) Probable fix: use a type annotation to specify what ‘f0’ should be. These potential instances exist: instance Functor IO -- Defined in ‘GHC.Base’ @@ -41,13 +41,13 @@ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘f0’ with ‘B t’ + Expected: H (B t) + Actual: H f0 because type variable ‘t’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: app2 :: forall t. H (B t) at T10403.hs:27:1-15 - Expected type: H (B t) - Actual type: H f0 • In the expression: h2 (H . I) (B ()) In an equation for ‘app2’: app2 = h2 (H . I) (B ()) • Relevant bindings include diff --git a/testsuite/tests/partial-sigs/should_compile/T11670.stderr b/testsuite/tests/partial-sigs/should_compile/T11670.stderr index 1a0e7df6ef..87e36e5fc5 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11670.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11670.stderr @@ -9,9 +9,9 @@ T11670.hs:10:42: warning: [-Wpartial-type-signatures (in -Wdefault)] peek :: Ptr a -> IO CLong (bound at T11670.hs:10:1) T11670.hs:13:40: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘Storable _’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of <expression> :: Storable _ => IO _ + • Found type wildcard ‘_’ standing for ‘Storable w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of <expression> :: Storable w => IO w at T11670.hs:13:40-48 • In an expression type signature: _ => IO _ In the expression: peekElemOff undefined 0 :: _ => IO _ @@ -22,9 +22,9 @@ T11670.hs:13:40: warning: [-Wpartial-type-signatures (in -Wdefault)] peek2 :: Ptr a -> IO CLong (bound at T11670.hs:13:1) T11670.hs:13:48: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of <expression> :: Storable _ => IO _ + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of <expression> :: Storable w => IO w at T11670.hs:13:40-48 • In the first argument of ‘IO’, namely ‘_’ In the type ‘IO _’ diff --git a/testsuite/tests/partial-sigs/should_compile/T14643.stderr b/testsuite/tests/partial-sigs/should_compile/T14643.stderr index c5f204e799..60288670fb 100644 --- a/testsuite/tests/partial-sigs/should_compile/T14643.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T14643.stderr @@ -1,8 +1,8 @@ T14643.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘()’ - • In the type signature: af :: (Num a, _) => a -> a + • In the type signature: ag :: (Num a, _) => a -> a T14643.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘()’ - • In the type signature: ag :: (Num a, _) => a -> a + • In the type signature: af :: (Num a, _) => a -> a diff --git a/testsuite/tests/partial-sigs/should_compile/T16728a.stderr b/testsuite/tests/partial-sigs/should_compile/T16728a.stderr index 50785ebc1c..a23c189c4b 100644 --- a/testsuite/tests/partial-sigs/should_compile/T16728a.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T16728a.stderr @@ -1,20 +1,20 @@ T16728a.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by the inferred types of - g :: a -> _ - h :: a -> _ + g :: a -> w + h :: a -> w at T16728a.hs:(5,1)-(7,9) • In the type ‘a -> _’ - In the type signature: g :: forall a. a -> _ + In the type signature: h :: forall a. a -> _ T16728a.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by the inferred types of - g :: a -> _ - h :: a -> _ + g :: a -> w + h :: a -> w at T16728a.hs:(5,1)-(7,9) • In the type ‘a -> _’ - In the type signature: h :: forall a. a -> _ + In the type signature: g :: forall a. a -> _ diff --git a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr index a079ea0342..2010018e05 100644 --- a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr @@ -12,5 +12,5 @@ FAMILY INSTANCES type instance F Bool _ = Bool -- Defined at TypeFamilyInstanceLHS.hs:8:15 Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr index 0499a2eb93..f83b50d0e7 100644 --- a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - unc :: forall {_1} {_2} {_3}. (_1 -> _2 -> _3) -> (_1, _2) -> _3 + unc :: forall {w1} {w2} {w3}. (w1 -> w2 -> w3) -> (w1, w2) -> w3 Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr index 62ae68aef0..f83b50d0e7 100644 --- a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - unc :: forall {a} {b} {_}. (a -> b -> _) -> (a, b) -> _ + unc :: forall {w1} {w2} {w3}. (w1 -> w2 -> w3) -> (w1, w2) -> w3 Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] diff --git a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr index 8cfb1f2fe0..fcefb13b71 100644 --- a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr @@ -1,9 +1,9 @@ TYPE SIGNATURES - bar :: forall {t} {_}. t -> (t -> _) -> _ + bar :: forall {t} {w}. t -> (t -> w) -> w foo :: forall {a}. (Show a, Enum a) => a -> String Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_a’ standing for ‘a’ @@ -27,23 +27,23 @@ WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in - WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t’ Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> _) -> _ + the inferred type of bar :: t -> (t -> w) -> w at WarningWildcardInstantiations.hs:9:1-13 • In the type ‘_ -> _ -> _’ In the type signature: bar :: _ -> _ -> _ WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘t -> _’ - Where: ‘t’, ‘_’ are rigid type variables bound by - the inferred type of bar :: t -> (t -> _) -> _ + • Found type wildcard ‘_’ standing for ‘t -> w’ + Where: ‘t’, ‘w’ are rigid type variables bound by + the inferred type of bar :: t -> (t -> w) -> w at WarningWildcardInstantiations.hs:9:1-13 • In the type ‘_ -> _ -> _’ In the type signature: bar :: _ -> _ -> _ WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> _) -> _ + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: t -> (t -> w) -> w at WarningWildcardInstantiations.hs:9:1-13 • In the type ‘_ -> _ -> _’ In the type signature: bar :: _ -> _ -> _ diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr index 2a83a36cc2..e42e098ef3 100644 --- a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr +++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr @@ -1,13 +1,13 @@ ExtraConstraintsWildcardInPatternSplice.hs:5:6: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of foo :: _ -> () + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of foo :: w -> () at ExtraConstraintsWildcardInPatternSplice.hs:5:1-29 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: _ In the pattern: _ :: _ In an equation for ‘foo’: foo (_ :: _) = () • Relevant bindings include - foo :: _ -> () + foo :: w -> () (bound at ExtraConstraintsWildcardInPatternSplice.hs:5:1) diff --git a/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr b/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr index 84d61eda91..146b0146eb 100644 --- a/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr +++ b/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr @@ -1,11 +1,11 @@ NamedExtraConstraintsWildcard.hs:5:1: error: - • Could not deduce: _0 - from the context: (Eq a, _) + • Could not deduce: w0 + from the context: (Eq a, w) bound by the inferred type for ‘foo’: - forall a {_ :: Constraint}. (Eq a, _) => a -> a + forall a {w :: Constraint}. (Eq a, w) => a -> a at NamedExtraConstraintsWildcard.hs:5:1-15 • In the ambiguity check for the inferred type for ‘foo’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes When checking the inferred type - foo :: forall a {_ :: Constraint}. (Eq a, _) => a -> a + foo :: forall a {w :: Constraint}. (Eq a, w) => a -> a diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr index 4c22dc62b9..e366651f7d 100644 --- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr +++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr @@ -1,12 +1,12 @@ NamedWildcardExplicitForall.hs:8:7: error: • Couldn't match type ‘_a’ with ‘Bool’ + Expected: _a -> _a + Actual: Bool -> Bool ‘_a’ is a rigid type variable bound by the type signature for: foo :: forall _a. _a -> _a at NamedWildcardExplicitForall.hs:7:1-27 - Expected type: _a -> _a - Actual type: Bool -> Bool • In the expression: not In an equation for ‘foo’: foo = not • Relevant bindings include diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr index 6a1d0edbb4..423fe1b040 100644 --- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr +++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr @@ -1,12 +1,12 @@ NamedWildcardsNotInMonotype.hs:5:1: error: - • Could not deduce (Eq _0) - from the context: (Show a, Eq _, Eq a) + • Could not deduce (Eq w0) + from the context: (Show a, Eq w, Eq a) bound by the inferred type for ‘foo’: - forall {a} {_}. (Show a, Eq _, Eq a) => a -> a -> String + forall {a} {w}. (Show a, Eq w, Eq a) => a -> a -> String at NamedWildcardsNotInMonotype.hs:5:1-33 - The type variable ‘_0’ is ambiguous + The type variable ‘w0’ is ambiguous • In the ambiguity check for the inferred type for ‘foo’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes When checking the inferred type - foo :: forall {a} {_}. (Show a, Eq _, Eq a) => a -> a -> String + foo :: forall {a} {w}. (Show a, Eq w, Eq a) => a -> a -> String diff --git a/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr b/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr index 8ca3dcd540..e4c368c6e1 100644 --- a/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr +++ b/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr @@ -1,9 +1,9 @@ PatBind3.hs:6:12: error: - • Couldn't match type ‘(Bool, _)’ with ‘Char’ - Expected type: Maybe ((Bool, _) -> Char) - Actual type: Maybe ((Bool, _) -> (Bool, _)) + • Couldn't match type ‘(Bool, w)’ with ‘Char’ + Expected: Maybe ((Bool, w) -> Char) + Actual: Maybe ((Bool, w) -> (Bool, w)) • In the expression: Just id In a pattern binding: Just foo = Just id • Relevant bindings include - foo :: (Bool, _) -> Char (bound at PatBind3.hs:6:6) + foo :: (Bool, w) -> Char (bound at PatBind3.hs:6:6) diff --git a/testsuite/tests/partial-sigs/should_fail/T10615.stderr b/testsuite/tests/partial-sigs/should_fail/T10615.stderr index b474e3dda7..9cd93c24a7 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10615.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10615.stderr @@ -1,36 +1,36 @@ T10615.hs:4:7: error: - • Found type wildcard ‘_’ standing for ‘a1’ - Where: ‘a1’ is an ambiguous type variable + • Found type wildcard ‘_’ standing for ‘w1’ + Where: ‘w1’ is an ambiguous type variable To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> f’ In the type signature: f1 :: _ -> f T10615.hs:5:6: error: - • Couldn't match type ‘f’ with ‘b1 -> a1’ + • Couldn't match type ‘f’ with ‘b1 -> w1’ + Expected: w1 -> f + Actual: w1 -> b1 -> w1 ‘f’ is a rigid type variable bound by - the inferred type of f1 :: a1 -> f + the inferred type of f1 :: w1 -> f at T10615.hs:4:1-12 - Expected type: a1 -> f - Actual type: a1 -> b1 -> a1 • In the expression: const In an equation for ‘f1’: f1 = const - • Relevant bindings include f1 :: a1 -> f (bound at T10615.hs:5:1) + • Relevant bindings include f1 :: w1 -> f (bound at T10615.hs:5:1) T10615.hs:7:7: error: - • Found type wildcard ‘_’ standing for ‘a0’ - Where: ‘a0’ is an ambiguous type variable + • Found type wildcard ‘_’ standing for ‘w0’ + Where: ‘w0’ is an ambiguous type variable To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> _f’ In the type signature: f2 :: _ -> _f T10615.hs:8:6: error: - • Couldn't match type ‘_f’ with ‘b0 -> a0’ + • Couldn't match type ‘_f’ with ‘b0 -> w0’ + Expected: w0 -> _f + Actual: w0 -> b0 -> w0 ‘_f’ is a rigid type variable bound by - the inferred type of f2 :: a0 -> _f + the inferred type of f2 :: w0 -> _f at T10615.hs:7:1-13 - Expected type: a0 -> _f - Actual type: a0 -> b0 -> a0 • In the expression: const In an equation for ‘f2’: f2 = const - • Relevant bindings include f2 :: a0 -> _f (bound at T10615.hs:8:1) + • Relevant bindings include f2 :: w0 -> _f (bound at T10615.hs:8:1) diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr index 1d122cf590..be667ec3a6 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr @@ -1,20 +1,45 @@ -T14040a.hs:21:18: error: - • Cannot generalise type; skolem ‘z’ would escape its scope - if I tried to quantify (_1 :: WeirdList z) in this type: - forall a1 (wl :: WeirdList a1) - (p :: forall x. x -> WeirdList x -> *). - Sing @(WeirdList a1) wl - -> (forall y. p @x0 _0 ('WeirdNil @x0)) - -> (forall z (x :: z) (xs :: WeirdList (WeirdList z)). - Sing @z x - -> Sing @(WeirdList (WeirdList z)) xs - -> p @(WeirdList z) _1 xs - -> p @z _2 ('WeirdCons @z x xs)) - -> p @a1 _3 wl - (Indeed, I sometimes struggle even printing this correctly, - due to its ill-scoped nature.) - • In the type signature: +T14040a.hs:26:46: error: + • Couldn't match kind ‘k1’ with ‘WeirdList z’ + Expected kind ‘WeirdList k1’, + but ‘xs’ has kind ‘WeirdList (WeirdList z)’ + because kind variable ‘z’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)’ + at T14040a.hs:(25,19)-(27,41) + • In the second argument of ‘p’, namely ‘xs’ + In the type ‘Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)) + -> p _ wl’ + In the type signature: + elimWeirdList :: forall (a :: Type) + (wl :: WeirdList a) + (p :: forall (x :: Type). x -> WeirdList x -> Type). + Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)) + -> p _ wl + +T14040a.hs:27:27: error: + • Couldn't match kind ‘k0’ with ‘z’ + Expected kind ‘WeirdList k0’, + but ‘WeirdCons x xs’ has kind ‘WeirdList z’ + because kind variable ‘z’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)’ + at T14040a.hs:(25,19)-(27,41) + • In the second argument of ‘p’, namely ‘(WeirdCons x xs)’ + In the type ‘Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)) + -> p _ wl’ + In the type signature: elimWeirdList :: forall (a :: Type) (wl :: WeirdList a) (p :: forall (x :: Type). x -> WeirdList x -> Type). diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr index 372ca3fba2..ced11e50a2 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr @@ -11,7 +11,12 @@ T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)] act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) T14584.hs:56:50: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Expected kind ‘m1’, but ‘a’ has kind ‘*’ + • Could not deduce: m1 ~ * + from the context: (Action act, Monoid a, Good m1) + bound by the instance declaration at T14584.hs:54:10-89 + ‘m1’ is a rigid type variable bound by + the instance declaration + at T14584.hs:54:10-89 • In the type ‘a’ In the second argument of ‘fromSing’, namely ‘(sing @m @a :: Sing _)’ diff --git a/testsuite/tests/partial-sigs/should_fail/T14584a.stderr b/testsuite/tests/partial-sigs/should_fail/T14584a.stderr index 8c98b76ae2..9d7ab35dd5 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14584a.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T14584a.stderr @@ -6,6 +6,10 @@ T14584a.hs:12:5: warning: [-Wdeferred-type-errors (in -Wdefault)] T14584a.hs:12:9: warning: [-Wdeferred-type-errors (in -Wdefault)] • Expected a type, but ‘m’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by + the type signature for: + f :: forall {k2} (m :: k2). () + at T14584a.hs:11:1-17 • In the type ‘m’ In the expression: id @m :: _ In an equation for ‘f’: f = id @m :: _ @@ -23,6 +27,10 @@ T14584a.hs:12:14: warning: [-Wpartial-type-signatures (in -Wdefault)] T14584a.hs:15:17: warning: [-Wdeferred-type-errors (in -Wdefault)] • Expected a type, but ‘m’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by + the type signature for: + g :: forall {k2} (m :: k2). () + at T14584a.hs:14:1-17 • In the type ‘m’ In the expression: id @m In an equation for ‘h’: h = id @m diff --git a/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr b/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr index 6ec4c440cc..fbbfc6e4c9 100644 --- a/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr +++ b/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr @@ -1,17 +1,17 @@ TidyClash.hs:8:19: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: w_ -> (w_, _ -> _1) + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: w_ -> (w_, w -> w1) at TidyClash.hs:9:1-28 To use the inferred type, enable PartialTypeSignatures • In the type ‘w_ -> (w_, _ -> _)’ In the type signature: bar :: w_ -> (w_, _ -> _) TidyClash.hs:8:24: error: - • Found type wildcard ‘_’ standing for ‘_1’ - Where: ‘_1’ is a rigid type variable bound by - the inferred type of bar :: w_ -> (w_, _ -> _1) + • Found type wildcard ‘_’ standing for ‘w1’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of bar :: w_ -> (w_, w -> w1) at TidyClash.hs:9:1-28 To use the inferred type, enable PartialTypeSignatures • In the type ‘w_ -> (w_, _ -> _)’ diff --git a/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr b/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr index a2c63ecbbc..7e6b1da683 100644 --- a/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr +++ b/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr @@ -1,26 +1,26 @@ TidyClash2.hs:13:20: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of barry :: _ -> _1 -> t + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of barry :: w -> w1 -> t at TidyClash2.hs:14:1-40 To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> _ -> t’ In the type signature: barry :: forall t. _ -> _ -> t TidyClash2.hs:13:25: error: - • Found type wildcard ‘_’ standing for ‘_1’ - Where: ‘_1’ is a rigid type variable bound by - the inferred type of barry :: _ -> _1 -> t + • Found type wildcard ‘_’ standing for ‘w1’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of barry :: w -> w1 -> t at TidyClash2.hs:14:1-40 To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> _ -> t’ In the type signature: barry :: forall t. _ -> _ -> t TidyClash2.hs:14:13: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of barry :: _ -> _1 -> t + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of barry :: w -> w1 -> t at TidyClash2.hs:14:1-40 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: _ @@ -28,12 +28,12 @@ TidyClash2.hs:14:13: error: In an equation for ‘barry’: barry (x :: _) (y :: _) = undefined :: _ • Relevant bindings include - barry :: _ -> _1 -> t (bound at TidyClash2.hs:14:1) + barry :: w -> w1 -> t (bound at TidyClash2.hs:14:1) TidyClash2.hs:14:22: error: - • Found type wildcard ‘_’ standing for ‘_1’ - Where: ‘_1’ is a rigid type variable bound by - the inferred type of barry :: _ -> _1 -> t + • Found type wildcard ‘_’ standing for ‘w1’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of barry :: w -> w1 -> t at TidyClash2.hs:14:1-40 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: _ @@ -41,13 +41,13 @@ TidyClash2.hs:14:22: error: In an equation for ‘barry’: barry (x :: _) (y :: _) = undefined :: _ • Relevant bindings include - x :: _ (bound at TidyClash2.hs:14:8) - barry :: _ -> _1 -> t (bound at TidyClash2.hs:14:1) + x :: w (bound at TidyClash2.hs:14:8) + barry :: w -> w1 -> t (bound at TidyClash2.hs:14:1) TidyClash2.hs:14:40: error: - • Found type wildcard ‘_’ standing for ‘_2’ - Where: ‘_2’ is a rigid type variable bound by - the inferred type of <expression> :: _2 + • Found type wildcard ‘_’ standing for ‘w2’ + Where: ‘w2’ is a rigid type variable bound by + the inferred type of <expression> :: w2 at TidyClash2.hs:14:40 To use the inferred type, enable PartialTypeSignatures • In an expression type signature: _ @@ -55,6 +55,6 @@ TidyClash2.hs:14:40: error: In an equation for ‘barry’: barry (x :: _) (y :: _) = undefined :: _ • Relevant bindings include - y :: _1 (bound at TidyClash2.hs:14:17) - x :: _ (bound at TidyClash2.hs:14:8) - barry :: _ -> _1 -> t (bound at TidyClash2.hs:14:1) + y :: w1 (bound at TidyClash2.hs:14:17) + x :: w (bound at TidyClash2.hs:14:8) + barry :: w -> w1 -> t (bound at TidyClash2.hs:14:1) diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr index a6c21368c2..a7e31fd8c9 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr @@ -24,25 +24,25 @@ WildcardInstantiations.hs:5:30: error: WildcardInstantiations.hs:8:8: error: • Found type wildcard ‘_’ standing for ‘t’ Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> _) -> _ + the inferred type of bar :: t -> (t -> w) -> w at WildcardInstantiations.hs:9:1-13 To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> _ -> _’ In the type signature: bar :: _ -> _ -> _ WildcardInstantiations.hs:8:13: error: - • Found type wildcard ‘_’ standing for ‘t -> _’ - Where: ‘t’, ‘_’ are rigid type variables bound by - the inferred type of bar :: t -> (t -> _) -> _ + • Found type wildcard ‘_’ standing for ‘t -> w’ + Where: ‘t’, ‘w’ are rigid type variables bound by + the inferred type of bar :: t -> (t -> w) -> w at WildcardInstantiations.hs:9:1-13 To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> _ -> _’ In the type signature: bar :: _ -> _ -> _ WildcardInstantiations.hs:8:18: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> _) -> _ + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: t -> (t -> w) -> w at WildcardInstantiations.hs:9:1-13 To use the inferred type, enable PartialTypeSignatures • In the type ‘_ -> _ -> _’ diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr index d75a630d04..726b43898e 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr @@ -1,34 +1,34 @@ WildcardsInPatternAndExprSig.hs:4:18: error: - • Found type wildcard ‘_a’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: Maybe [_] -> _ -> [_] + • Found type wildcard ‘_a’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: Maybe [w] -> w -> [w] at WildcardsInPatternAndExprSig.hs:4:1-68 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: _a In the pattern: x :: _a In the pattern: [x :: _a] • Relevant bindings include - bar :: Maybe [_] -> _ -> [_] + bar :: Maybe [w] -> w -> [w] (bound at WildcardsInPatternAndExprSig.hs:4:1) WildcardsInPatternAndExprSig.hs:4:25: error: - • Found type wildcard ‘_’ standing for ‘[_]’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: Maybe [_] -> _ -> [_] + • Found type wildcard ‘_’ standing for ‘[w]’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: Maybe [w] -> w -> [w] at WildcardsInPatternAndExprSig.hs:4:1-68 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: _ In the pattern: [x :: _a] :: _ In the pattern: Just ([x :: _a] :: _) • Relevant bindings include - bar :: Maybe [_] -> _ -> [_] + bar :: Maybe [w] -> w -> [w] (bound at WildcardsInPatternAndExprSig.hs:4:1) WildcardsInPatternAndExprSig.hs:4:38: error: - • Found type wildcard ‘_b’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: Maybe [_] -> _ -> [_] + • Found type wildcard ‘_b’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: Maybe [w] -> w -> [w] at WildcardsInPatternAndExprSig.hs:4:1-68 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: Maybe [_b] @@ -37,13 +37,13 @@ WildcardsInPatternAndExprSig.hs:4:38: error: bar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c) = [x, z] :: [_d] • Relevant bindings include - bar :: Maybe [_] -> _ -> [_] + bar :: Maybe [w] -> w -> [w] (bound at WildcardsInPatternAndExprSig.hs:4:1) WildcardsInPatternAndExprSig.hs:4:49: error: - • Found type wildcard ‘_c’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: Maybe [_] -> _ -> [_] + • Found type wildcard ‘_c’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: Maybe [w] -> w -> [w] at WildcardsInPatternAndExprSig.hs:4:1-68 To use the inferred type, enable PartialTypeSignatures • In a pattern type signature: _c @@ -52,14 +52,14 @@ WildcardsInPatternAndExprSig.hs:4:49: error: bar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c) = [x, z] :: [_d] • Relevant bindings include - x :: _ (bound at WildcardsInPatternAndExprSig.hs:4:13) - bar :: Maybe [_] -> _ -> [_] + x :: w (bound at WildcardsInPatternAndExprSig.hs:4:13) + bar :: Maybe [w] -> w -> [w] (bound at WildcardsInPatternAndExprSig.hs:4:1) WildcardsInPatternAndExprSig.hs:4:66: error: - • Found type wildcard ‘_d’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of bar :: Maybe [_] -> _ -> [_] + • Found type wildcard ‘_d’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of bar :: Maybe [w] -> w -> [w] at WildcardsInPatternAndExprSig.hs:4:1-68 To use the inferred type, enable PartialTypeSignatures • In an expression type signature: [_d] @@ -68,7 +68,7 @@ WildcardsInPatternAndExprSig.hs:4:66: error: bar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c) = [x, z] :: [_d] • Relevant bindings include - z :: _ (bound at WildcardsInPatternAndExprSig.hs:4:44) - x :: _ (bound at WildcardsInPatternAndExprSig.hs:4:13) - bar :: Maybe [_] -> _ -> [_] + z :: w (bound at WildcardsInPatternAndExprSig.hs:4:44) + x :: w (bound at WildcardsInPatternAndExprSig.hs:4:13) + bar :: Maybe [w] -> w -> [w] (bound at WildcardsInPatternAndExprSig.hs:4:1) diff --git a/testsuite/tests/partial-sigs/should_run/T15415.stderr b/testsuite/tests/partial-sigs/should_run/T15415.stderr index a43f80e6bd..1070a07ca8 100644 --- a/testsuite/tests/partial-sigs/should_run/T15415.stderr +++ b/testsuite/tests/partial-sigs/should_run/T15415.stderr @@ -1,8 +1,8 @@ <interactive>:1:7: error: - • Found type wildcard ‘_’ standing for ‘_0 :: k0’ + • Found type wildcard ‘_’ standing for ‘w0 :: k0’ Where: ‘k0’ is an ambiguous type variable - ‘_0’ is an ambiguous type variable + ‘w0’ is an ambiguous type variable To use the inferred type, enable PartialTypeSignatures • In the first argument of ‘Proxy’, namely ‘_’ In the type ‘Proxy _’ @@ -15,16 +15,16 @@ In the type ‘Proxy (Maybe :: _)’ <interactive>:1:11: error: - • Found type wildcard ‘_’ standing for ‘_0’ - Where: ‘_0’ is an ambiguous type variable + • Found type wildcard ‘_’ standing for ‘w0’ + Where: ‘w0’ is an ambiguous type variable To use the inferred type, enable PartialTypeSignatures • In the first argument of ‘Dependent’, namely ‘_’ In the type ‘Dependent _’ <interactive>:1:7: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘_0 :: k0’ + • Found type wildcard ‘_’ standing for ‘w0 :: k0’ Where: ‘k0’ is an ambiguous type variable - ‘_0’ is an ambiguous type variable + ‘w0’ is an ambiguous type variable • In the first argument of ‘Proxy’, namely ‘_’ In the type ‘Proxy _’ @@ -35,7 +35,7 @@ In the type ‘Proxy (Maybe :: _)’ <interactive>:1:11: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘_0’ - Where: ‘_0’ is an ambiguous type variable + • Found type wildcard ‘_’ standing for ‘w0’ + Where: ‘w0’ is an ambiguous type variable • In the first argument of ‘Dependent’, namely ‘_’ In the type ‘Dependent _’ diff --git a/testsuite/tests/partial-sigs/should_run/T15415.stdout b/testsuite/tests/partial-sigs/should_run/T15415.stdout index 17af08faea..709da2f17c 100644 --- a/testsuite/tests/partial-sigs/should_run/T15415.stdout +++ b/testsuite/tests/partial-sigs/should_run/T15415.stdout @@ -1,6 +1,6 @@ Proxy _ :: * Proxy (Maybe :: _) :: * -Dependent _ :: _ -> * +Dependent _ :: w -> * Proxy _ :: * Proxy (Maybe :: _) :: * -Dependent _ :: _ -> * +Dependent _ :: w -> * diff --git a/testsuite/tests/patsyn/should_fail/T11010.stderr b/testsuite/tests/patsyn/should_fail/T11010.stderr index 6e3aae58f5..28216760ee 100644 --- a/testsuite/tests/patsyn/should_fail/T11010.stderr +++ b/testsuite/tests/patsyn/should_fail/T11010.stderr @@ -1,13 +1,13 @@ T11010.hs:9:36: error: • Couldn't match type ‘a1’ with ‘Int’ + Expected: a -> b + Actual: a1 -> b ‘a1’ is a rigid type variable bound by a pattern with constructor: Fun :: forall a b. String -> (a -> b) -> Expr a -> Expr b, in a pattern synonym declaration at T11010.hs:9:26-36 - Expected type: a -> b - Actual type: a1 -> b • In the declaration for pattern synonym ‘IntFun’ • Relevant bindings include x :: Expr a1 (bound at T11010.hs:9:36) diff --git a/testsuite/tests/patsyn/should_fail/T11039.stderr b/testsuite/tests/patsyn/should_fail/T11039.stderr index 14d67a2bb2..f8f4d35768 100644 --- a/testsuite/tests/patsyn/should_fail/T11039.stderr +++ b/testsuite/tests/patsyn/should_fail/T11039.stderr @@ -1,10 +1,10 @@ T11039.hs:8:15: error: • Couldn't match type ‘f’ with ‘A’ + Expected: f a + Actual: A a ‘f’ is a rigid type variable bound by the signature for pattern synonym ‘Q’ at T11039.hs:7:1-38 - Expected type: f a - Actual type: A a • In the pattern: A a In the declaration for pattern synonym ‘Q’ diff --git a/testsuite/tests/patsyn/should_fail/T14552.stderr b/testsuite/tests/patsyn/should_fail/T14552.stderr index b9b6b8448b..34ee266cdd 100644 --- a/testsuite/tests/patsyn/should_fail/T14552.stderr +++ b/testsuite/tests/patsyn/should_fail/T14552.stderr @@ -1,8 +1,8 @@ T14552.hs:22:9: error: • Cannot generalise type; skolem ‘k’ would escape its scope - if I tried to quantify (aa0 :: k) in this type: - forall k (w :: k --> *). Exp a0 (F @k @(*) w aa0) + if I tried to quantify (t0 :: k) in this type: + forall k (w :: k --> *). Exp a0 (F @k @(*) w t0) (Indeed, I sometimes struggle even printing this correctly, due to its ill-scoped nature.) • In the declaration for pattern synonym ‘FOO’ diff --git a/testsuite/tests/patsyn/should_fail/T15685.stderr b/testsuite/tests/patsyn/should_fail/T15685.stderr index 7f01ebc479..37627b852b 100644 --- a/testsuite/tests/patsyn/should_fail/T15685.stderr +++ b/testsuite/tests/patsyn/should_fail/T15685.stderr @@ -1,6 +1,11 @@ T15685.hs:13:24: error: • Couldn't match kind ‘a1’ with ‘[k0]’ + When matching types + f :: a1 -> * + NP a0 :: [k0] -> * + Expected: f a2 + Actual: NP a0 b0 ‘a1’ is untouchable inside the constraints: as ~ (a2 : as1) bound by a pattern with constructor: @@ -12,11 +17,6 @@ T15685.hs:13:24: error: the inferred type of HereNil :: NS f as at T15685.hs:13:9-15 Possible fix: add a type signature for ‘HereNil’ - When matching types - f :: a1 -> * - NP a0 :: [k0] -> * - Expected type: f a2 - Actual type: NP a0 b0 • In the pattern: Nil In the pattern: Here Nil In the declaration for pattern synonym ‘HereNil’ diff --git a/testsuite/tests/patsyn/should_fail/T15695.stderr b/testsuite/tests/patsyn/should_fail/T15695.stderr index 6ef415ad9b..2e834c6d08 100644 --- a/testsuite/tests/patsyn/should_fail/T15695.stderr +++ b/testsuite/tests/patsyn/should_fail/T15695.stderr @@ -13,6 +13,8 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)] a3 -> ApplyT kind a b, in an equation for ‘from'’ at T15695.hs:39:8-21 + Expected: a4 + Actual: Either (NA 'VO) a3 ‘a2’ is a rigid type variable bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). @@ -24,8 +26,6 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)] a3 -> ApplyT kind a b, in an equation for ‘from'’ at T15695.hs:39:8-21 - Expected type: a4 - Actual type: Either (NA 'VO) a3 • In the pattern: Left a In the pattern: ASSO (Left a) In an equation for ‘from'’: from' (ASSO (Left a)) = Here (a :* Nil) @@ -34,9 +34,10 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)] (bound at T15695.hs:39:1) T15695.hs:40:26: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘a0 : as0’ with ‘'[]’ - Expected type: NS (NP NA) '[ '[ 'VO]] - Actual type: NS (NP NA) ('[ 'VO] : a0 : as0) + • 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) In an equation for ‘from'’: from' (ASSO (Right b)) = There (Here undefined) diff --git a/testsuite/tests/patsyn/should_fail/mono.stderr b/testsuite/tests/patsyn/should_fail/mono.stderr index 8f370ce2f0..264579f91b 100644 --- a/testsuite/tests/patsyn/should_fail/mono.stderr +++ b/testsuite/tests/patsyn/should_fail/mono.stderr @@ -1,8 +1,8 @@ mono.hs:7:4: error: • Couldn't match type ‘Bool’ with ‘Int’ - Expected type: [Bool] - Actual type: [Int] + Expected: [Bool] + Actual: [Int] • In the pattern: Single x In an equation for ‘f’: f (Single x) = x diff --git a/testsuite/tests/perf/compiler/T10547.stderr b/testsuite/tests/perf/compiler/T10547.stderr index f0935d55f0..bd07bc120e 100644 --- a/testsuite/tests/perf/compiler/T10547.stderr +++ b/testsuite/tests/perf/compiler/T10547.stderr @@ -1,11 +1,11 @@ -T10547.hs:35:25: - Couldn't match type ‘Bool’ with ‘Char’ - Expected type: (T12, Char) - Actual type: (S12, Bool) +T10547.hs:35:25: error: + • Couldn't match type ‘Bool’ with ‘Char’ + Expected: (T12, Char) + Actual: (S12, Bool) Type synonyms expanded: Expected type: (Int, Char) Actual type: (Int, Bool) - In the second argument of ‘f’, namely ‘b’ + • In the second argument of ‘f’, namely ‘b’ In the second argument of ‘const’, namely ‘(f a b)’ In the expression: const 1 (f a b) diff --git a/testsuite/tests/perf/compiler/T16473.hs b/testsuite/tests/perf/compiler/T16473.hs index 8a9751e306..14dc7412f2 100644 --- a/testsuite/tests/perf/compiler/T16473.hs +++ b/testsuite/tests/perf/compiler/T16473.hs @@ -48,7 +48,7 @@ instance Functor (Semantic f) where {-# INLINE fmap #-} instance Applicative (Semantic f) where - pure a = Semantic $ const $ pure a + pure a = Semantic (\x -> const (pure a) x) {-# INLINE pure #-} Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k {-# INLINE (<*>) #-} diff --git a/testsuite/tests/polykinds/KindVType.stderr b/testsuite/tests/polykinds/KindVType.stderr index feb1417675..bf8c99c03b 100644 --- a/testsuite/tests/polykinds/KindVType.stderr +++ b/testsuite/tests/polykinds/KindVType.stderr @@ -1,7 +1,7 @@ KindVType.hs:8:8: error: • Couldn't match type ‘Int’ with ‘Maybe’ - Expected type: Proxy Maybe - Actual type: Proxy Int + Expected: Proxy Maybe + Actual: Proxy Int • In the expression: Proxy :: Proxy Int In an equation for ‘foo’: foo = (Proxy :: Proxy Int) diff --git a/testsuite/tests/polykinds/T10503.hs b/testsuite/tests/polykinds/T10503.hs index 2b9900652f..d352ce720f 100644 --- a/testsuite/tests/polykinds/T10503.hs +++ b/testsuite/tests/polykinds/T10503.hs @@ -1,9 +1,10 @@ {-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-} module GHCBug where +import Data.Kind data Proxy p = Proxy -data KProxy (a :: *) = KProxy +data KProxy (a :: Type) = KProxy -h :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy *) => r) -> r -h = undefined +h :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy Type) => r) -> r +h x = undefined diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr deleted file mode 100644 index 0895bdba26..0000000000 --- a/testsuite/tests/polykinds/T10503.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -T10503.hs:8:6: error: - • Could not deduce: k ~ * - from the context: Proxy 'KProxy ~ Proxy 'KProxy - bound by a type expected by the context: - (Proxy 'KProxy ~ Proxy 'KProxy) => r - at T10503.hs:8:6-87 - ‘k’ is a rigid type variable bound by - the type signature for: - h :: forall k r. ((Proxy 'KProxy ~ Proxy 'KProxy) => r) -> r - at T10503.hs:8:6-87 - • In the ambiguity check for ‘h’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: - h :: forall k r. - (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy (*)) => r) - -> r diff --git a/testsuite/tests/polykinds/T11142.stderr b/testsuite/tests/polykinds/T11142.stderr index 4f5c5fcf29..780bbdc63f 100644 --- a/testsuite/tests/polykinds/T11142.stderr +++ b/testsuite/tests/polykinds/T11142.stderr @@ -1,17 +1,10 @@ T11142.hs:9:49: error: - • Expected kind ‘k1’, but ‘b’ has kind ‘k0’ + • Expected kind ‘k’, but ‘b’ has kind ‘k0’ + because kind variable ‘k’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall k (a :: k). SameKind a b’ + at T11142.hs:9:19-49 • In the second argument of ‘SameKind’, namely ‘b’ In the type signature: foo :: forall b. (forall k (a :: k). SameKind a b) -> () - -T11142.hs:10:7: error: - • Cannot instantiate unification variable ‘a0’ - with a type involving polytypes: - (forall k1 (a :: k1). SameKind a b) -> () - GHC doesn't yet support impredicative polymorphism - • In the expression: undefined - In an equation for ‘foo’: foo = undefined - • Relevant bindings include - foo :: (forall k1 (a :: k1). SameKind a b) -> () - (bound at T11142.hs:10:1) diff --git a/testsuite/tests/polykinds/T12444.stderr b/testsuite/tests/polykinds/T12444.stderr index 0ebd2986cf..0a75b049ec 100644 --- a/testsuite/tests/polykinds/T12444.stderr +++ b/testsuite/tests/polykinds/T12444.stderr @@ -1,13 +1,13 @@ T12444.hs:19:11: error: • Couldn't match type ‘b’ with ‘'Succ (c :+: b)’ + Expected: SNat ('Succ (c :+: b)) + Actual: SNat b ‘b’ is a rigid type variable bound by the type signature for: foo :: forall (c :: Nat) (b :: Nat). SNat ('Succ c) -> SNat b -> SNat ('Succ (c :+: b)) at T12444.hs:18:1-55 - Expected type: SNat ('Succ (c :+: b)) - Actual type: SNat b • In the expression: x In an equation for ‘foo’: foo _ x = x • Relevant bindings include diff --git a/testsuite/tests/polykinds/T12593.stderr b/testsuite/tests/polykinds/T12593.stderr index fcf194ba50..5ce7b07187 100644 --- a/testsuite/tests/polykinds/T12593.stderr +++ b/testsuite/tests/polykinds/T12593.stderr @@ -1,9 +1,16 @@ +T12593.hs:11:16: error: + • Expected kind ‘k0 -> k1 -> *’, but ‘Free k k1 k2 p’ has kind ‘*’ + • In the type signature: + run :: k2 q => + Free k k1 k2 p a b + -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + T12593.hs:12:31: error: • Expecting one more argument to ‘k’ Expected a type, but ‘k’ has kind - ‘((k0 -> Constraint) -> k1 -> *) -> Constraint’ + ‘((k2 -> Constraint) -> k3 -> *) -> Constraint’ • In the kind ‘k’ In the type signature: run :: k2 q => diff --git a/testsuite/tests/polykinds/T14172.stderr b/testsuite/tests/polykinds/T14172.stderr index 6a0d3927eb..d27f45bb9c 100644 --- a/testsuite/tests/polykinds/T14172.stderr +++ b/testsuite/tests/polykinds/T14172.stderr @@ -11,12 +11,10 @@ T14172.hs:6:46: error: In the type ‘(a -> f b) -> g a -> f (h _)’ T14172.hs:7:19: error: - • Occurs check: cannot construct the infinite type: a ~ g'0 a - Expected type: (f'0 a -> f (f'0 b)) - -> Compose f'0 g'0 a -> f (h a') - Actual type: (Unwrapped (Compose f'0 g'0 a) - -> f (Unwrapped (h a'))) - -> Compose f'0 g'0 a -> f (h a') + • Couldn't match type ‘a’ with ‘g'0 a’ + Expected: (f'0 a -> f (f'0 b)) -> Compose f'0 g'0 a -> f (h a') + Actual: (Unwrapped (Compose f'0 g'0 a) -> f (Unwrapped (h a'))) + -> Compose f'0 g'0 a -> f (h a') • In the first argument of ‘(.)’, namely ‘_Wrapping Compose’ In the expression: _Wrapping Compose . traverse In an equation for ‘traverseCompose’: diff --git a/testsuite/tests/polykinds/T14265.stderr b/testsuite/tests/polykinds/T14265.stderr index fa951ad920..cf3ab9acf3 100644 --- a/testsuite/tests/polykinds/T14265.stderr +++ b/testsuite/tests/polykinds/T14265.stderr @@ -1,8 +1,8 @@ T14265.hs:7:12: error: - • Found type wildcard ‘_’ standing for ‘_ :: k’ - Where: ‘k’, ‘_’ are rigid type variables bound by - the inferred type of f :: proxy _ -> () + • Found type wildcard ‘_’ standing for ‘w :: k’ + Where: ‘k’, ‘w’ are rigid type variables bound by + the inferred type of f :: proxy w -> () at T14265.hs:8:1-8 To use the inferred type, enable PartialTypeSignatures • In the first argument of ‘proxy’, namely ‘_’ @@ -10,9 +10,9 @@ T14265.hs:7:12: error: In the type signature: f :: proxy _ -> () T14265.hs:10:15: error: - • Found type wildcard ‘_’ standing for ‘_’ - Where: ‘_’ is a rigid type variable bound by - the inferred type of foo :: StateT _ _1 () + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () at T14265.hs:11:1-15 To use the inferred type, enable PartialTypeSignatures • In the first argument of ‘StateT’, namely ‘_’ @@ -20,9 +20,9 @@ T14265.hs:10:15: error: In the type signature: foo :: StateT _ _ () T14265.hs:10:17: error: - • Found type wildcard ‘_’ standing for ‘_1 :: * -> *’ - Where: ‘_1’ is a rigid type variable bound by - the inferred type of foo :: StateT _ _1 () + • Found type wildcard ‘_’ standing for ‘w1 :: * -> *’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () at T14265.hs:11:1-15 To use the inferred type, enable PartialTypeSignatures • In the second argument of ‘StateT’, namely ‘_’ diff --git a/testsuite/tests/polykinds/T14520.stderr b/testsuite/tests/polykinds/T14520.stderr index b8a1ed1bf0..20e1b5cf33 100644 --- a/testsuite/tests/polykinds/T14520.stderr +++ b/testsuite/tests/polykinds/T14520.stderr @@ -2,5 +2,6 @@ T14520.hs:15:24: error: • Expected kind ‘bat w w’, but ‘Id’ has kind ‘XXX @a0 @(*) (XXX @a0 @(a0 ~>> *) kat0 b0) b0’ + The type variables ‘kat0’, ‘b0’ are ambiguous • In the first argument of ‘Sing’, namely ‘(Id :: bat w w)’ In the type signature: sId :: Sing w -> Sing (Id :: bat w w) diff --git a/testsuite/tests/polykinds/T14555.stderr b/testsuite/tests/polykinds/T14555.stderr index 66fb55ae4f..3861872124 100644 --- a/testsuite/tests/polykinds/T14555.stderr +++ b/testsuite/tests/polykinds/T14555.stderr @@ -1,6 +1,7 @@ T14555.hs:12:34: error: - • Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’ + • Couldn't match kind ‘rep’ with ‘'GHC.Types.LiftedRep’ + Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’ • In the second argument of ‘Exp’, namely ‘(a -> b)’ In the type ‘Exp xs (a -> b)’ In the definition of data constructor ‘Lam’ diff --git a/testsuite/tests/polykinds/T14563.stderr b/testsuite/tests/polykinds/T14563.stderr index 1265ec0e3a..2d81507659 100644 --- a/testsuite/tests/polykinds/T14563.stderr +++ b/testsuite/tests/polykinds/T14563.stderr @@ -1,6 +1,7 @@ T14563.hs:9:39: error: - • Expected kind ‘TYPE rep -> TYPE rep''’, + • Couldn't match kind ‘rep''’ with ‘'GHC.Types.LiftedRep’ + Expected kind ‘TYPE rep -> TYPE rep''’, but ‘h’ has kind ‘TYPE rep -> *’ • In the second argument of ‘Lan’, namely ‘h’ In the type ‘Lan g h a’ diff --git a/testsuite/tests/polykinds/T14580.stderr b/testsuite/tests/polykinds/T14580.stderr index 8658a8484a..154e191f7e 100644 --- a/testsuite/tests/polykinds/T14580.stderr +++ b/testsuite/tests/polykinds/T14580.stderr @@ -1,6 +1,7 @@ T14580.hs:8:32: error: - • Expected kind ‘Cat a’, but ‘iso :: cat a b’ has kind ‘cat a b’ + • Couldn't match kind ‘b’ with ‘a -> *’ + Expected kind ‘Cat a’, but ‘iso :: cat a b’ has kind ‘cat a b’ • In the first argument of ‘ISO’, namely ‘(iso :: cat a b)’ In the type ‘ISO (iso :: cat a b)’ In the type declaration for ‘<-->’ diff --git a/testsuite/tests/polykinds/T14846.stderr b/testsuite/tests/polykinds/T14846.stderr index edb19408b2..2d49b819a0 100644 --- a/testsuite/tests/polykinds/T14846.stderr +++ b/testsuite/tests/polykinds/T14846.stderr @@ -1,6 +1,8 @@ T14846.hs:38:8: error: • Couldn't match type ‘ríki’ with ‘Hom riki’ + Expected: ríki a a + Actual: Hom riki a a ‘ríki’ is a rigid type variable bound by the type signature for: i :: forall {k5} {k6} {cls3 :: k6 -> Constraint} (xx :: k5) @@ -8,8 +10,6 @@ T14846.hs:38:8: error: StructI xx a => ríki a a at T14846.hs:38:8-48 - Expected type: ríki a a - Actual type: Hom riki a a • When checking that instance signature for ‘i’ is more general than its signature in the class Instance sig: forall {k1} {k2} {cls :: k2 -> Constraint} (xx :: k1) @@ -22,35 +22,13 @@ T14846.hs:38:8: error: ríki a a In the instance declaration for ‘Category (Hom riki)’ -T14846.hs:39:12: error: - • Could not deduce (StructI xx1 structured0) - arising from a use of ‘struct’ - from the context: Category riki - bound by the instance declaration at T14846.hs:37:10-65 - or from: StructI xx a - bound by the type signature for: - i :: forall {k5} {k6} {cls3 :: k6 -> Constraint} (xx :: k5) - (a :: Struct cls3). - StructI xx a => - Hom riki a a - at T14846.hs:38:8-48 - The type variables ‘xx1’, ‘structured0’ are ambiguous - Relevant bindings include - i :: Hom riki a a (bound at T14846.hs:39:3) - These potential instance exist: - instance forall k (xx :: k) (cls :: k -> Constraint) - (structured :: Struct cls). - (Structured xx cls ~ structured, cls xx) => - StructI xx structured - -- Defined at T14846.hs:28:10 - • In the expression: struct :: AStruct (Structured a cls) - In the expression: case struct :: AStruct (Structured a cls) of - In an equation for ‘i’: - i = case struct :: AStruct (Structured a cls) of - T14846.hs:39:44: error: - • Expected kind ‘Struct cls3 -> Constraint’, + • Couldn't match kind ‘k4’ with ‘Struct cls3’ + Expected kind ‘Struct cls3 -> Constraint’, but ‘cls’ has kind ‘k4 -> Constraint’ + ‘k4’ is a rigid type variable bound by + the instance declaration + at T14846.hs:37:10-65 • In the second argument of ‘Structured’, namely ‘cls’ In the first argument of ‘AStruct’, namely ‘(Structured a cls)’ In an expression type signature: AStruct (Structured a cls) diff --git a/testsuite/tests/polykinds/T15881.stderr b/testsuite/tests/polykinds/T15881.stderr index 8f395735db..47cc5abf5c 100644 --- a/testsuite/tests/polykinds/T15881.stderr +++ b/testsuite/tests/polykinds/T15881.stderr @@ -1,6 +1,6 @@ T15881.hs:8:18: error: - • Occurs check: cannot construct the infinite kind: k0 ~ k0 -> * + • Expected kind ‘k0’, but ‘n’ has kind ‘k0 -> *’ • In the first argument of ‘n’, namely ‘n’ In the kind ‘n n’ In the data type declaration for ‘A’ diff --git a/testsuite/tests/polykinds/T16244.stderr b/testsuite/tests/polykinds/T16244.stderr index d261a70ba3..6b932ad285 100644 --- a/testsuite/tests/polykinds/T16244.stderr +++ b/testsuite/tests/polykinds/T16244.stderr @@ -1,6 +1,6 @@ T16244.hs:11:18: error: - • Couldn't match kind ‘k1’ with ‘k’ + • Expected kind ‘k’, but ‘b’ has kind ‘k1’ ‘k1’ is a rigid type variable bound by the class declaration for ‘C’ at T16244.hs:11:26 diff --git a/testsuite/tests/polykinds/T16245.stderr b/testsuite/tests/polykinds/T16245.stderr index e478fe4e5f..4f7cc415c2 100644 --- a/testsuite/tests/polykinds/T16245.stderr +++ b/testsuite/tests/polykinds/T16245.stderr @@ -1,6 +1,6 @@ T16245.hs:11:36: error: - • Couldn't match kind ‘k1’ with ‘k’ + • Expected kind ‘k’, but ‘b’ has kind ‘k1’ ‘k1’ is a rigid type variable bound by the class declaration for ‘C’ at T16245.hs:11:45 diff --git a/testsuite/tests/polykinds/T17841.stderr b/testsuite/tests/polykinds/T17841.stderr index 6157f55399..11243a4322 100644 --- a/testsuite/tests/polykinds/T17841.stderr +++ b/testsuite/tests/polykinds/T17841.stderr @@ -1,6 +1,9 @@ T17841.hs:7:45: error: • Expected a type, but ‘t’ has kind ‘k2’ + ‘k2’ is a rigid type variable bound by + the class declaration for ‘Foo’ + at T17841.hs:7:17 • In the kind ‘t’ In the first argument of ‘Proxy’, namely ‘(a :: t)’ In the type signature: foo :: Proxy (a :: t) diff --git a/testsuite/tests/polykinds/T17963.stderr b/testsuite/tests/polykinds/T17963.stderr index 84201e0de4..5cade1ded2 100644 --- a/testsuite/tests/polykinds/T17963.stderr +++ b/testsuite/tests/polykinds/T17963.stderr @@ -1,13 +1,12 @@ T17963.hs:15:23: error: - • Couldn't match a lifted type with an unlifted type - ‘rep1’ is a rigid type variable bound by - the class declaration for ‘Category'’ - at T17963.hs:13:27-29 + • Couldn't match kind ‘rep1’ with ‘'LiftedRep’ When matching kinds k0 :: * ob :: TYPE rep1 - Expected kind ‘ob’, but ‘a’ has kind ‘k0’ + ‘rep1’ is a rigid type variable bound by + the class declaration for ‘Category'’ + at T17963.hs:13:27-29 • In the first argument of ‘cat’, namely ‘a’ In the type signature: id' :: forall a. cat a a In the class declaration for ‘Category'’ diff --git a/testsuite/tests/polykinds/T7224.stderr b/testsuite/tests/polykinds/T7224.stderr index 774a4bce69..c9d2236206 100644 --- a/testsuite/tests/polykinds/T7224.stderr +++ b/testsuite/tests/polykinds/T7224.stderr @@ -1,12 +1,18 @@ T7224.hs:6:19: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ + ‘i’ is a rigid type variable bound by + the class declaration for ‘PMonad'’ + at T7224.hs:5:21 • In the first argument of ‘m’, namely ‘i’ In the type signature: ret' :: a -> m i i a In the class declaration for ‘PMonad'’ T7224.hs:7:14: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ + ‘i’ is a rigid type variable bound by + the class declaration for ‘PMonad'’ + at T7224.hs:5:21 • In the first argument of ‘m’, namely ‘i’ In the type signature: bind' :: m i j a -> (a -> m j k b) -> m i k b diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr index 5c5055ea2a..f59e44d5cd 100644 --- a/testsuite/tests/polykinds/T7230.stderr +++ b/testsuite/tests/polykinds/T7230.stderr @@ -19,8 +19,8 @@ T7230.hs:48:32: error: Sing x -> Sing xs -> Sing (x : xs), in an equation for ‘crash’ at T7230.hs:48:17-26 - Expected type: SBool (Increasing xs) - Actual type: SBool (x :<<= x1) + Expected: SBool (Increasing xs) + Actual: SBool (x :<<= x1) • In the expression: x %:<<= y In an equation for ‘crash’: crash (SCons x (SCons y xs)) = x %:<<= y diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr index 37b00a7a70..5f4ff6d18f 100644 --- a/testsuite/tests/polykinds/T7278.stderr +++ b/testsuite/tests/polykinds/T7278.stderr @@ -1,5 +1,8 @@ T7278.hs:9:43: error: - • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k1’ + • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’ + ‘k’ is a rigid type variable bound by + the type signature for ‘f’ + at T7278.hs:9:1-49 • In the type signature: f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0 diff --git a/testsuite/tests/polykinds/T7328.stderr b/testsuite/tests/polykinds/T7328.stderr index 76f81555dd..d1ba591512 100644 --- a/testsuite/tests/polykinds/T7328.stderr +++ b/testsuite/tests/polykinds/T7328.stderr @@ -1,6 +1,6 @@ T7328.hs:8:34: error: - • Occurs check: cannot construct the infinite kind: k1 ~ k0 -> k1 + • Expected kind ‘k1’, but ‘f’ has kind ‘k0 -> k1’ • In the first argument of ‘Foo’, namely ‘f’ In the first argument of ‘Proxy’, namely ‘(Foo f)’ In the type signature: foo :: a ~ f i => Proxy (Foo f) diff --git a/testsuite/tests/polykinds/T7594.stderr b/testsuite/tests/polykinds/T7594.stderr index 5632e97707..ea5484d464 100644 --- a/testsuite/tests/polykinds/T7594.stderr +++ b/testsuite/tests/polykinds/T7594.stderr @@ -1,6 +1,8 @@ T7594.hs:37:12: error: • Couldn't match type ‘b’ with ‘IO ()’ + Expected: a -> b + Actual: a -> IO () ‘b’ is untouchable inside the constraints: (:&:) c0 Real a bound by a type expected by the context: @@ -10,8 +12,6 @@ T7594.hs:37:12: error: the inferred type of bar2 :: b at T7594.hs:37:1-19 Possible fix: add a type signature for ‘bar2’ - Expected type: a -> b - Actual type: a -> IO () • In the first argument of ‘app’, namely ‘print’ In the expression: app print q2 In an equation for ‘bar2’: bar2 = app print q2 diff --git a/testsuite/tests/polykinds/T7805.stderr b/testsuite/tests/polykinds/T7805.stderr index 9ca48645be..869ecc9200 100644 --- a/testsuite/tests/polykinds/T7805.stderr +++ b/testsuite/tests/polykinds/T7805.stderr @@ -1,6 +1,8 @@ T7805.hs:7:21: error: - Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’ - In the first argument of ‘HR’, namely ‘x’ - In the first argument of ‘F’, namely ‘(HR x)’ - In the type instance declaration for ‘F’ + • Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall a. a -> a + • In the first argument of ‘HR’, namely ‘x’ + In the first argument of ‘F’, namely ‘(HR x)’ + In the type instance declaration for ‘F’ diff --git a/testsuite/tests/polykinds/T8616.stderr b/testsuite/tests/polykinds/T8616.stderr index 2a8b6482aa..653f3beb1a 100644 --- a/testsuite/tests/polykinds/T8616.stderr +++ b/testsuite/tests/polykinds/T8616.stderr @@ -1,24 +1,15 @@ T8616.hs:8:16: error: • Couldn't match kind ‘k1’ with ‘*’ + When matching types + Any :: k1 + Proxy kproxy :: * ‘k1’ is a rigid type variable bound by the type signature for: withSomeSing :: forall k1 (kproxy :: k1). Proxy kproxy at T8616.hs:7:1-52 - When matching types - a0 :: * - Any :: k1 • In the expression: undefined :: (Any :: k) In an equation for ‘withSomeSing’: withSomeSing = undefined :: (Any :: k) • Relevant bindings include withSomeSing :: Proxy kproxy (bound at T8616.hs:8:1) - -T8616.hs:8:30: error: - • Expected a type, but ‘Any :: k’ has kind ‘k1’ - • In an expression type signature: (Any :: k) - In the expression: undefined :: (Any :: k) - In an equation for ‘withSomeSing’: - withSomeSing = undefined :: (Any :: k) - • Relevant bindings include - withSomeSing :: Proxy kproxy (bound at T8616.hs:8:1) diff --git a/testsuite/tests/polykinds/T9017.stderr b/testsuite/tests/polykinds/T9017.stderr index 8acf58c9b5..2fc5bb1792 100644 --- a/testsuite/tests/polykinds/T9017.stderr +++ b/testsuite/tests/polykinds/T9017.stderr @@ -1,17 +1,17 @@ T9017.hs:8:7: error: • Couldn't match kind ‘k2’ with ‘*’ + When matching types + a0 :: * -> * -> * + a :: k2 -> k3 -> * + Expected: a b (m b) + Actual: a0 b0 (m0 b0) ‘k2’ is a rigid type variable bound by the type signature for: foo :: forall {k2} {k3} (a :: k2 -> k3 -> *) (b :: k2) (m :: k2 -> k3). a b (m b) at T9017.hs:7:1-16 - When matching types - a0 :: * -> * -> * - a :: k2 -> k3 -> * - Expected type: a b (m b) - Actual type: a0 a1 (m0 a1) • In the expression: arr return In an equation for ‘foo’: foo = arr return • Relevant bindings include diff --git a/testsuite/tests/polykinds/T9144.stderr b/testsuite/tests/polykinds/T9144.stderr index f58a57254b..dc3e13ed11 100644 --- a/testsuite/tests/polykinds/T9144.stderr +++ b/testsuite/tests/polykinds/T9144.stderr @@ -1,8 +1,8 @@ T9144.hs:34:26: error: • Couldn't match type ‘Integer’ with ‘FooTerm’ - Expected type: DemoteRep @Nat ('KProxy @Nat) - Actual type: DemoteRep @Foo ('KProxy @Foo) + Expected: DemoteRep @Nat ('KProxy @Nat) + Actual: DemoteRep @Foo ('KProxy @Foo) • In the first argument of ‘toSing’, namely ‘n’ In the expression: toSing n In the expression: diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs index 3af1458427..d033b4016f 100644 --- a/testsuite/tests/polykinds/T9222.hs +++ b/testsuite/tests/polykinds/T9222.hs @@ -10,5 +10,8 @@ import Data.Proxy -- So this program is erroneous. (But the original ticket was -- a crash, and that's still fixed!) +-- Apr 2020: with simple subsumption (#17775), the type isn't +-- ambiguous any more + data Want :: (i,j) -> Type where Want :: (a ~ '(b,c) => Proxy b) -> Want a diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr deleted file mode 100644 index c8e98be09a..0000000000 --- a/testsuite/tests/polykinds/T9222.stderr +++ /dev/null @@ -1,17 +0,0 @@ - -T9222.hs:14:3: error: - • Couldn't match type ‘c0’ with ‘c’ - ‘c0’ is untouchable - inside the constraints: a ~ '(b0, c0) - bound by a type expected by the context: - (a ~ '(b0, c0)) => Proxy b0 - at T9222.hs:14:3-43 - ‘c’ is a rigid type variable bound by - the type of the constructor ‘Want’: - forall {k1} {j1} (a :: (k1, j1)) (b :: k1) (c :: j1). - ((a ~ '(b, c)) => Proxy b) -> Want a - at T9222.hs:14:3-43 - • In the ambiguity check for ‘Want’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the definition of data constructor ‘Want’ - In the data type declaration for ‘Want’ diff --git a/testsuite/tests/polykinds/T9569.hs b/testsuite/tests/polykinds/T9569.hs index 634d742803..112037461a 100644 --- a/testsuite/tests/polykinds/T9569.hs +++ b/testsuite/tests/polykinds/T9569.hs @@ -9,18 +9,42 @@ data Proxy (c :: Constraint) class Deferrable (c :: Constraint) where defer :: Proxy c -> (c => a) -> a -deferPair :: (Deferrable c1, Deferrable c2) => - Proxy (c1,c2) -> ((c1,c2) => a) -> a +deferPair :: (Deferrable c1, Deferrable c2) + => Proxy (c1,c2) -> (((c1,c2) :: Constraint) => a) -> a + -- NB: ((c1,c2) :: Constraint) => blah + -- is different form + -- (c1,c2) => blah + -- The former has dict, the latter has two deferPair _ _ = undefined instance (Deferrable c1, Deferrable c2) => Deferrable (c1,c2) where -- defer p f = deferPair p f -- Succeeds defer = deferPair -- Fails +{- Notes Apr 2020. +~~~~~~~~~~~~~~~~~ +Note the careful type for deferPair! You can also say + +deferPair :: (Deferrable c1, Deferrable c2, d ~ (c1,c2)) + => Proxy (c1,c2) -> (d => a) -> a + +but NOT + +deferPair :: (Deferrable c1, Deferrable c2) + => Proxy (c1,c2) -> ((c1,c2) => a) -> a + +The point is that + (c1,c2) => a +is short for + c1 => c2 => a +-} + {- [G] Deferrable c1, Deferrable c2 - [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a ~ Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax + [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a + ~ + Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax [w] Deferrable c1x [w] Deferrable c2x -} diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 87ee448e32..592c6b2fec 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -97,7 +97,7 @@ test('T8705', normal, compile, ['']) test('T8985', normal, compile, ['']) test('T9106', normal, compile_fail, ['']) test('T9144', normal, compile_fail, ['']) -test('T9222', normal, compile_fail, ['']) +test('T9222', normal, compile, ['']) test('T9264', normal, compile, ['']) test('T9263', normal, makefile_test, []) test('T9063', normal, compile, ['']) @@ -114,7 +114,7 @@ test('PolyInstances', normal, compile, ['']) test('T10041', normal, compile, ['']) test('T10451', normal, compile_fail, ['']) test('T10516', normal, compile_fail, ['']) -test('T10503', normal, compile_fail, ['']) +test('T10503', normal, compile, ['']) test('T10570', normal, compile_fail, ['']) test('T10670', normal, compile, ['']) test('T10670a', normal, compile, ['']) diff --git a/testsuite/tests/quantified-constraints/T15290a.stderr b/testsuite/tests/quantified-constraints/T15290a.stderr index 2efd784f31..7513fa4f9b 100644 --- a/testsuite/tests/quantified-constraints/T15290a.stderr +++ b/testsuite/tests/quantified-constraints/T15290a.stderr @@ -1,21 +1,19 @@ T15290a.hs:25:12: error: - • Couldn't match representation of type ‘m (Int, IntStateT m a1)’ - with that of ‘m (Int, StateT Int m a1)’ + • Couldn't match representation of type: m (Int, IntStateT m a1) + with that of: m (Int, StateT Int m a1) arising from a use of ‘coerce’ NB: We cannot know what roles the parameters to ‘m’ have; we must assume that the role is nominal • In the expression: coerce @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a) - @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) - join + @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) join In an equation for ‘join’: join = coerce @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a) - @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) - join + @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) join In the instance declaration for ‘Monad (IntStateT m)’ • Relevant bindings include join :: IntStateT m (IntStateT m a) -> IntStateT m a diff --git a/testsuite/tests/quantified-constraints/T15290b.stderr b/testsuite/tests/quantified-constraints/T15290b.stderr index 7dc1852c6d..1c96359d96 100644 --- a/testsuite/tests/quantified-constraints/T15290b.stderr +++ b/testsuite/tests/quantified-constraints/T15290b.stderr @@ -1,7 +1,7 @@ T15290b.hs:28:49: error: - • Couldn't match representation of type ‘f (m b)’ - with that of ‘f (T1 m b)’ + • Couldn't match representation of type: f (m b) + with that of: f (T1 m b) arising from the coercion of the method ‘traverse'’ from type ‘forall (f :: * -> *) a b. Applicative' f => diff --git a/testsuite/tests/quantified-constraints/T15918.stderr b/testsuite/tests/quantified-constraints/T15918.stderr index fa06b0e3f4..4ee54563c5 100644 --- a/testsuite/tests/quantified-constraints/T15918.stderr +++ b/testsuite/tests/quantified-constraints/T15918.stderr @@ -1,7 +1,7 @@ T15918.hs:19:19: error: - • Expected kind ‘(k0 -> *) -> Constraint’, - but ‘[]’ has kind ‘* -> *’ + • Couldn't match kind ‘*’ with ‘k0 -> *’ + Expected kind ‘(k0 -> *) -> Constraint’, but ‘[]’ has kind ‘* -> *’ • In the first argument of ‘Build’, namely ‘[]’ In an expression type signature: Build [] a In the expression: rev :: Build [] a diff --git a/testsuite/tests/rebindable/DoParamM.stderr b/testsuite/tests/rebindable/DoParamM.stderr index 8d3764067e..41b56ecb07 100644 --- a/testsuite/tests/rebindable/DoParamM.stderr +++ b/testsuite/tests/rebindable/DoParamM.stderr @@ -7,8 +7,8 @@ DoParamM.hs:146:25: error: DoParamM.hs:286:28: error: • Couldn't match type ‘Unlocked’ with ‘Locked’ - Expected type: LIO Locked Locked () - Actual type: LIO Unlocked Locked () + Expected: LIO Locked Locked () + Actual: LIO Unlocked Locked () • In a stmt of a 'do' block: tlock2_do In the expression: do tlock2_do @@ -20,8 +20,8 @@ DoParamM.hs:286:28: error: DoParamM.hs:302:37: error: • Couldn't match type ‘Locked’ with ‘Unlocked’ - Expected type: LIO Unlocked Unlocked () - Actual type: LIO Locked Unlocked () + Expected: LIO Unlocked Unlocked () + Actual: LIO Locked Unlocked () • In a stmt of a 'do' block: unlock In the expression: do tlock2_do diff --git a/testsuite/tests/rename/should_fail/T2993.stderr b/testsuite/tests/rename/should_fail/T2993.stderr index 4cae65ae88..4542ffeaf0 100644 --- a/testsuite/tests/rename/should_fail/T2993.stderr +++ b/testsuite/tests/rename/should_fail/T2993.stderr @@ -1,4 +1,4 @@ T2993.hs:7:13: error: - • Variable not in scope: (<**>) :: t -> (b -> b) -> t1 + • Variable not in scope: (<**>) :: t -> (a -> a) -> t1 • Perhaps you meant ‘<*>’ (imported from Prelude) diff --git a/testsuite/tests/saks/should_fail/saks007_fail.stderr b/testsuite/tests/saks/should_fail/saks007_fail.stderr index 431b5dede9..367cb8e022 100644 --- a/testsuite/tests/saks/should_fail/saks007_fail.stderr +++ b/testsuite/tests/saks/should_fail/saks007_fail.stderr @@ -1,8 +1,8 @@ saks007_fail.hs:15:10: error: • Couldn't match kind ‘'True’ with ‘'False’ - Expected kind: G (*) - Actual kind: F (*) + Expected: G (*) + Actual: F (*) • In the type ‘X Integer String’ In the definition of data constructor ‘MkX’ In the data declaration for ‘X’ diff --git a/testsuite/tests/saks/should_fail/saks_fail019.stderr b/testsuite/tests/saks/should_fail/saks_fail019.stderr index 5bdb26a933..30882c15ec 100644 --- a/testsuite/tests/saks/should_fail/saks_fail019.stderr +++ b/testsuite/tests/saks/should_fail/saks_fail019.stderr @@ -1,6 +1,6 @@ saks_fail019.hs:9:1: error: • Couldn't match kind ‘a’ with ‘*’ - Expected kind: a -> * - Actual kind: * -> * + Expected: a -> * + Actual: * -> * • In the data type declaration for ‘T’ diff --git a/testsuite/tests/saks/should_fail/saks_fail020.stderr b/testsuite/tests/saks/should_fail/saks_fail020.stderr index 7f4f33f631..c71b772786 100644 --- a/testsuite/tests/saks/should_fail/saks_fail020.stderr +++ b/testsuite/tests/saks/should_fail/saks_fail020.stderr @@ -1,6 +1,10 @@ saks_fail020.hs:9:49: error: • Expected kind ‘k’, but ‘a’ has kind ‘k0’ + because kind variable ‘k’ would escape its scope + This (rigid, skolem) kind variable is bound by + ‘forall (k :: Type) -> Proxy (a :: k)’ + at saks_fail020.hs:9:20-55 • In the first argument of ‘Proxy’, namely ‘(a :: k)’ In a standalone kind signature for ‘Foo2’: () -> forall (k :: Type) -> Proxy (a :: k) diff --git a/testsuite/tests/simplCore/should_compile/T17930.stderr b/testsuite/tests/simplCore/should_compile/T17930.stderr index 7b24d169f2..a9fe475265 100644 --- a/testsuite/tests/simplCore/should_compile/T17930.stderr +++ b/testsuite/tests/simplCore/should_compile/T17930.stderr @@ -1,2 +1,2 @@ -$sfoo :: (?b::Bool) => [Char] -> [Char] +$sfoo :: (?b::Bool) => String -> [Char] $sfoo diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr index 35bcec7835..7a27514454 100644 --- a/testsuite/tests/simplCore/should_compile/rule2.stderr +++ b/testsuite/tests/simplCore/should_compile/rule2.stderr @@ -10,13 +10,12 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 11 +Total ticks: 10 1 PreInlineUnconditionally 1 f 1 UnfoldingDone 1 Roman.bar 1 RuleFired 1 foo/bar 1 LetFloatFromLet 1 -1 EtaReduction 1 ds 6 BetaReduction 1 f 1 a diff --git a/testsuite/tests/simplCore/should_compile/simpl017.stderr b/testsuite/tests/simplCore/should_compile/simpl017.stderr index 5a82506164..96c8e1ea2d 100644 --- a/testsuite/tests/simplCore/should_compile/simpl017.stderr +++ b/testsuite/tests/simplCore/should_compile/simpl017.stderr @@ -1,9 +1,9 @@ simpl017.hs:50:15: error: - • Couldn't match type ‘[E m i] -> E' v0 m a’ - with ‘forall v. [E m i] -> E' v m a’ - Expected type: E m (forall v. [E m i] -> E' v m a) - Actual type: E' RValue m ([E m i] -> E' v0 m a) + • Couldn't match type: [E m i] -> E' v0 m a + with: forall v. [E m i] -> E' v m a + Expected: E m (forall v. [E m i] -> E' v m a) + Actual: E' RValue m ([E m i] -> E' v0 m a) • In the expression: E (do let ix :: [E m i] -> m i ix [i] = runE i diff --git a/testsuite/tests/simplCore/should_compile/spec004.stderr b/testsuite/tests/simplCore/should_compile/spec004.stderr index f140da9977..825319bcb6 100644 --- a/testsuite/tests/simplCore/should_compile/spec004.stderr +++ b/testsuite/tests/simplCore/should_compile/spec004.stderr @@ -5,7 +5,7 @@ Result size of Specialise -- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} $sfoo [InlPrag=NOINLINE[0]] :: Int -> [Char] -[LclId] +[LclId, Arity=1] $sfoo = \ (y :: Int) -> GHC.Base.build @@ -25,7 +25,7 @@ foo [InlPrag=NOINLINE[0]] :: forall a. () -> Show a => a -> String Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 30 0] 150 40}, RULES: "SPEC foo @Int" [0] - forall (dk :: ()) ($dShow :: Show Int). foo @Int dk $dShow = $sfoo] + forall (ds :: ()) ($dShow :: Show Int). foo @Int ds $dShow = $sfoo] foo = \ (@a) _ [Occ=Dead] ($dShow :: Show a) (y :: a) -> GHC.Base.build diff --git a/testsuite/tests/th/T10945.stderr b/testsuite/tests/th/T10945.stderr index 765be1fa80..09e1afa877 100644 --- a/testsuite/tests/th/T10945.stderr +++ b/testsuite/tests/th/T10945.stderr @@ -1,8 +1,9 @@ T10945.hs:7:4: error: - • Couldn't match type ‘[Dec]’ with ‘TExp DecsQ’ - Expected type: Q (TExp DecsQ) - Actual type: Q [Dec] + • Couldn't match type: [Dec] + with: TExp DecsQ + Expected: Q (TExp DecsQ) + Actual: Q [Dec] • In the expression: return [SigD diff --git a/testsuite/tests/th/T11452.stderr b/testsuite/tests/th/T11452.stderr index 0649997ff1..88e9af57fc 100644 --- a/testsuite/tests/th/T11452.stderr +++ b/testsuite/tests/th/T11452.stderr @@ -7,9 +7,13 @@ T11452.hs:6:12: error: In an equation for ‘impred’: impred = $$([|| \ _ -> () ||]) T11452.hs:6:14: error: - • Cannot instantiate unification variable ‘p0’ + • Couldn't match type ‘p0’ with ‘forall a. a -> a’ + Expected: Language.Haskell.TH.Syntax.Q + (Language.Haskell.TH.Syntax.TExp ((forall a. a -> a) -> ())) + Actual: Language.Haskell.TH.Syntax.Q + (Language.Haskell.TH.Syntax.TExp (p0 -> ())) + Cannot instantiate unification variable ‘p0’ with a type involving polytypes: forall a. a -> a - GHC doesn't yet support impredicative polymorphism • In the Template Haskell quotation [|| \ _ -> () ||] In the expression: [|| \ _ -> () ||] In the Template Haskell splice $$([|| \ _ -> () ||]) diff --git a/testsuite/tests/th/T15321.stderr b/testsuite/tests/th/T15321.stderr index 825e01b0f4..3054f02afc 100644 --- a/testsuite/tests/th/T15321.stderr +++ b/testsuite/tests/th/T15321.stderr @@ -1,6 +1,6 @@ T15321.hs:9:9: error: - • Found hole: _ :: [Char] -> Language.Haskell.TH.Lib.Internal.ExpQ + • Found hole: _ :: String -> Language.Haskell.TH.Lib.Internal.ExpQ • In the expression: _ In the expression: _ "baz" In the untyped splice: $(_ "baz") diff --git a/testsuite/tests/th/T16976.stderr b/testsuite/tests/th/T16976.stderr index 7fe46fb5eb..19584153c0 100644 --- a/testsuite/tests/th/T16976.stderr +++ b/testsuite/tests/th/T16976.stderr @@ -1,5 +1,5 @@ T16976.aNumber :: forall {p_0 :: *} . GHC.Num.Num p_0 => p_0 -T16976.aString :: [GHC.Types.Char] +T16976.aString :: GHC.Base.String T16976.MkT1 :: forall (s_0 :: *) . T16976.T s_0 T16976.MkT2 :: forall (s_0 :: *) . T16976.T s_0 T16976.T :: * -> * diff --git a/testsuite/tests/th/T17380.stderr b/testsuite/tests/th/T17380.stderr index 85724eb549..ac57cca5d5 100644 --- a/testsuite/tests/th/T17380.stderr +++ b/testsuite/tests/th/T17380.stderr @@ -1,39 +1,41 @@ T17380.hs:9:7: error: - • Couldn't match expected type ‘Unit (Maybe String)’ - with actual type ‘Maybe [Char]’ + • Couldn't match expected type: Unit (Maybe String) + with actual type: Maybe String • In the expression: Just "wat" In an equation for ‘foo’: foo = Just "wat" T17380.hs:12:8: error: - • Couldn't match expected type ‘Maybe String’ - with actual type ‘Unit (Maybe [Char])’ + • Couldn't match expected type: Maybe String + with actual type: Unit (Maybe String) • In the expression: Unit Just "wat" In an equation for ‘bar’: bar = (Unit Just "wat") T17380.hs:15:6: error: - • Couldn't match expected type ‘Unit (Maybe String)’ - with actual type ‘Maybe [Char]’ + • Couldn't match expected type: Unit (Maybe String) + with actual type: Maybe String • In the pattern: Just "wat" In an equation for ‘baz’: baz (Just "wat") = Just "frerf" T17380.hs:18:7: error: - • Couldn't match expected type ‘Maybe String’ - with actual type ‘Unit (Maybe [Char])’ + • Couldn't match expected type: Maybe String + with actual type: Unit (Maybe String) • In the pattern: Unit(Just "wat") In an equation for ‘quux’: quux (Unit(Just "wat")) = Just "frerf" T17380.hs:21:8: error: - • Couldn't match type ‘Maybe String’ with ‘'Unit (Maybe String)’ - Expected type: Proxy ('Unit (Maybe String)) - Actual type: Proxy (Maybe String) + • Couldn't match type: Maybe String + with: 'Unit (Maybe String) + Expected: Proxy ('Unit (Maybe String)) + Actual: Proxy (Maybe String) • In the expression: Proxy :: Proxy (Maybe String) In an equation for ‘quuz’: quuz = Proxy :: Proxy (Maybe String) T17380.hs:24:8: error: - • Couldn't match type ‘'Unit (Maybe String)’ with ‘Maybe String’ - Expected type: Proxy (Maybe String) - Actual type: Proxy ('Unit (Maybe String)) + • Couldn't match type: 'Unit (Maybe String) + with: Maybe String + Expected: Proxy (Maybe String) + Actual: Proxy ('Unit (Maybe String)) • In the expression: Proxy :: Proxy ('Unit Maybe String) In an equation for ‘fred’: fred = Proxy :: Proxy ('Unit Maybe String) diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr index 10a592f4a5..9ab73ad4cd 100644 --- a/testsuite/tests/th/T7276.stderr +++ b/testsuite/tests/th/T7276.stderr @@ -2,8 +2,8 @@ T7276.hs:6:8: error: • Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’ with ‘Language.Haskell.TH.Syntax.Exp’ - Expected type: Language.Haskell.TH.Lib.Internal.ExpQ - Actual type: Language.Haskell.TH.Syntax.Q - Language.Haskell.TH.Lib.Internal.Decs + Expected: Language.Haskell.TH.Lib.Internal.ExpQ + Actual: Language.Haskell.TH.Syntax.Q + Language.Haskell.TH.Lib.Internal.Decs • In the expression: [d| y = 3 |] In the untyped splice: $([d| y = 3 |]) diff --git a/testsuite/tests/th/T7276a.stdout b/testsuite/tests/th/T7276a.stdout index 048d305562..33b418477a 100644 --- a/testsuite/tests/th/T7276a.stdout +++ b/testsuite/tests/th/T7276a.stdout @@ -1,8 +1,8 @@ <interactive>:3:9: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘[Dec]’ with ‘Exp’ - Expected type: Q Exp - Actual type: Q Language.Haskell.TH.Lib.Internal.Decs + Expected: Q Exp + Actual: Q Language.Haskell.TH.Lib.Internal.Decs • In the expression: [d| a = () |] :: Q Exp In an equation for ‘x’: x = [d| a = () |] :: Q Exp @@ -10,8 +10,8 @@ • Exception when trying to run compile-time code: <interactive>:3:9: error: • Couldn't match type ‘[Dec]’ with ‘Exp’ - Expected type: Q Exp - Actual type: Q Language.Haskell.TH.Lib.Internal.Decs + Expected: Q Exp + Actual: Q Language.Haskell.TH.Lib.Internal.Decs • In the expression: [d| a = () |] :: Q Exp In an equation for ‘x’: x = [d| a = () |] :: Q Exp (deferred type error) diff --git a/testsuite/tests/th/T8577.stderr b/testsuite/tests/th/T8577.stderr index b6ff05a0a4..595338e07e 100644 --- a/testsuite/tests/th/T8577.stderr +++ b/testsuite/tests/th/T8577.stderr @@ -1,8 +1,8 @@ T8577.hs:9:11: error: • Couldn't match type ‘Int’ with ‘Bool’ - Expected type: Q (TExp (A Bool)) - Actual type: Q (TExp (A Int)) + Expected: Q (TExp (A Bool)) + Actual: Q (TExp (A Int)) • In the expression: y In the Template Haskell splice $$(y) In the expression: $$(y) diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr index d76db558c6..965b441735 100644 --- a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr +++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr @@ -1,8 +1,8 @@ TH_overloaded_constraints_fail.hs:20:14: error: • Couldn't match type ‘Identity’ with ‘Q’ - Expected type: Q Exp - Actual type: Identity Exp + Expected: Q Exp + Actual: Identity Exp • In the expression: idQ In the expression: [| $(idQ) $(qq) |] diff --git a/testsuite/tests/typecheck/bug1465/bug1465.stderr b/testsuite/tests/typecheck/bug1465/bug1465.stderr index 4e31c7f195..e4f5b10732 100644 --- a/testsuite/tests/typecheck/bug1465/bug1465.stderr +++ b/testsuite/tests/typecheck/bug1465/bug1465.stderr @@ -1,9 +1,9 @@ C.hs:6:11: error: - Couldn't match expected type ‘bug1465-1.0:A.T’ - with actual type ‘A.T’ - NB: ‘A.T’ is defined in ‘A’ in package ‘bug1465-2.0’ - ‘bug1465-1.0:A.T’ is defined in ‘A’ in package ‘bug1465-1.0’ - In the expression: B2.f - In the expression: [B1.f, B2.f] - In an equation for ‘x’: x = [B1.f, B2.f] + • Couldn't match expected type ‘bug1465-1.0:A.T’ + with actual type ‘A.T’ + NB: ‘bug1465-1.0:A.T’ is defined in ‘A’ in package ‘bug1465-1.0’ + ‘A.T’ is defined in ‘A’ in package ‘bug1465-2.0’ + • In the expression: B2.f + In the expression: [B1.f, B2.f] + In an equation for ‘x’: x = [B1.f, B2.f] diff --git a/testsuite/tests/typecheck/should_compile/FD3.stderr b/testsuite/tests/typecheck/should_compile/FD3.stderr index 85728da0a6..d7ac728b6c 100644 --- a/testsuite/tests/typecheck/should_compile/FD3.stderr +++ b/testsuite/tests/typecheck/should_compile/FD3.stderr @@ -1,9 +1,13 @@ FD3.hs:15:15: error: - • Occurs check: cannot construct the infinite type: a ~ (String, a) + • Couldn't match type ‘a’ with ‘(String, a)’ arising from a functional dependency between: constraint ‘MkA (String, a) a’ arising from a use of ‘mkA’ instance ‘MkA a1 a1’ at FD3.hs:12:10-16 + ‘a’ is a rigid type variable bound by + the type signature for: + translate :: forall a. (String, a) -> A a + at FD3.hs:14:1-31 • In the expression: mkA a In an equation for ‘translate’: translate a = mkA a • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_compile/T10072.stderr b/testsuite/tests/typecheck/should_compile/T10072.stderr index ad7fe2602a..71a93c9573 100644 --- a/testsuite/tests/typecheck/should_compile/T10072.stderr +++ b/testsuite/tests/typecheck/should_compile/T10072.stderr @@ -6,5 +6,5 @@ T10072.hs:3:31: error: at T10072.hs:3:1-47 To use the inferred type, enable PartialTypeSignatures • In the type ‘a -> _’ - In a RULE for ‘f’: a -> _ + In the type signature for ‘f’: a -> _ When checking the transformation rule "map/empty" diff --git a/testsuite/tests/typecheck/should_compile/T10283.hs b/testsuite/tests/typecheck/should_compile/T10283.hs index e623b1cb0a..8c5b8e2f5a 100644 --- a/testsuite/tests/typecheck/should_compile/T10283.hs +++ b/testsuite/tests/typecheck/should_compile/T10283.hs @@ -20,4 +20,4 @@ wrapIdComp f = runIdComp . f . liftOuter class Applicative p => ApplicativeFix p where afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a - afix = wrapIdComp + afix f = wrapIdComp f diff --git a/testsuite/tests/typecheck/should_compile/T10390.hs b/testsuite/tests/typecheck/should_compile/T10390.hs index e0648c9554..facb26a26d 100644 --- a/testsuite/tests/typecheck/should_compile/T10390.hs +++ b/testsuite/tests/typecheck/should_compile/T10390.hs @@ -6,7 +6,7 @@ class ApPair r where apPair :: (forall a . (ApPair a, Num a) => Maybe a) -> Maybe r instance (ApPair a, ApPair b) => ApPair (a,b) where - apPair = apPair' + apPair x = apPair' x apPair' :: (ApPair b, ApPair c) => (forall a . (Num a, ApPair a) => Maybe a) -> Maybe (b,c) diff --git a/testsuite/tests/typecheck/should_compile/T11254.stderr b/testsuite/tests/typecheck/should_compile/T11254.stderr index a7466b78b9..10132d2cb8 100644 --- a/testsuite/tests/typecheck/should_compile/T11254.stderr +++ b/testsuite/tests/typecheck/should_compile/T11254.stderr @@ -6,8 +6,8 @@ T11254.hs:16:10: warning: [-Wdeferred-type-errors (in -Wdefault)] T11254.hs:18:12: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘GHC.Real.Ratio Integer’ with ‘Int’ - Expected type: Rational -> Frac Rational - Actual type: Rational -> Rational + Expected: Rational -> Frac Rational + Actual: Rational -> Rational • When checking that instance signature for ‘embed’ is more general than its signature in the class Instance sig: Rational -> Rational diff --git a/testsuite/tests/typecheck/should_compile/T11305.hs b/testsuite/tests/typecheck/should_compile/T11305.hs index 14cb955ed5..ee138a017c 100644 --- a/testsuite/tests/typecheck/should_compile/T11305.hs +++ b/testsuite/tests/typecheck/should_compile/T11305.hs @@ -54,4 +54,5 @@ instance ProfunctorComonad Tambara where yon ~(x,~(y,z)) = ((x,y),z) instance Profunctor p => Strong (Tambara p) where - first' = runTambara . produplicate + first' = (\x -> runTambara x) . produplicate + -- Simple subsumption (#17775) requires eta expansion here diff --git a/testsuite/tests/typecheck/should_compile/T12082.hs b/testsuite/tests/typecheck/should_compile/T12082.hs index 7aa4196737..0f001beabb 100644 --- a/testsuite/tests/typecheck/should_compile/T12082.hs +++ b/testsuite/tests/typecheck/should_compile/T12082.hs @@ -6,4 +6,5 @@ import Data.Typeable (Typeable) import Control.Monad.ST (RealWorld) f :: forall a. (forall b. Typeable b => b -> a) -> a -f = undefined :: (RealWorld -> a) -> a +f x = (undefined :: (RealWorld -> a) -> a) x + -- Simple subsumption (#17775) requires eta expansion here diff --git a/testsuite/tests/typecheck/should_compile/T12427a.hs b/testsuite/tests/typecheck/should_compile/T12427a.hs index cffab89749..56c7513012 100644 --- a/testsuite/tests/typecheck/should_compile/T12427a.hs +++ b/testsuite/tests/typecheck/should_compile/T12427a.hs @@ -36,5 +36,6 @@ h2 y = case y of T1 _ v -> v -- Fails in 7.10 (head exploded) -- Fails in 8.0.1 (ditto) -- Succeeds in 8.2 +-- Fails in 8.12 (simple subsumption) x3 :: (forall a. a->a) -> Int T1 _ x3 = undefined diff --git a/testsuite/tests/typecheck/should_compile/T12427a.stderr b/testsuite/tests/typecheck/should_compile/T12427a.stderr index efc87a1fc3..b9c3969bf0 100644 --- a/testsuite/tests/typecheck/should_compile/T12427a.stderr +++ b/testsuite/tests/typecheck/should_compile/T12427a.stderr @@ -12,8 +12,19 @@ T12427a.hs:17:29: error: h11 :: T -> p (bound at T12427a.hs:17:1) T12427a.hs:28:6: error: - • Cannot instantiate unification variable ‘p0’ + • Couldn't match expected type ‘p0’ + with actual type ‘(forall b. [b] -> [b]) -> Int’ + Cannot instantiate unification variable ‘p0’ with a type involving polytypes: (forall b. [b] -> [b]) -> Int - GHC doesn't yet support impredicative polymorphism • In the pattern: T1 _ x1 In a pattern binding: T1 _ x1 = undefined + +T12427a.hs:41:6: error: + • Couldn't match type ‘b’ with ‘[b]’ + Expected: (forall b. [b] -> [b]) -> Int + Actual: (forall a. a -> a) -> Int + ‘b’ is a rigid type variable bound by + the type [b] -> [b] + at T12427a.hs:41:1-19 + • In the pattern: T1 _ x3 + In a pattern binding: T1 _ x3 = undefined diff --git a/testsuite/tests/typecheck/should_compile/T13381.stderr b/testsuite/tests/typecheck/should_compile/T13381.stderr index 9c8eab6e67..7f250eaec1 100644 --- a/testsuite/tests/typecheck/should_compile/T13381.stderr +++ b/testsuite/tests/typecheck/should_compile/T13381.stderr @@ -1,14 +1,8 @@ T13381.hs:21:23: error: • Couldn't match type ‘Exp Int’ with ‘Int’ - Expected type: Exp Int -> Iter (Exp Int) (Exp Char) - Actual type: Int -> Iter (Exp Int) (Exp Char) + Expected: Int -> Iter Int (Exp Char) + Actual: Int -> Iter (Exp Int) (Exp Char) • In the first argument of ‘iterLoop’, namely ‘f’ In the first argument of ‘fromExp’, namely ‘(iterLoop f init)’ In the expression: fromExp (iterLoop f init) - -T13381.hs:21:25: error: - • Couldn't match expected type ‘Exp Int’ with actual type ‘Int’ - • In the second argument of ‘iterLoop’, namely ‘init’ - In the first argument of ‘fromExp’, namely ‘(iterLoop f init)’ - In the expression: fromExp (iterLoop f init) diff --git a/testsuite/tests/typecheck/should_compile/T13585a.hs b/testsuite/tests/typecheck/should_compile/T13585a.hs index 0652ece370..3f72a45ea3 100644 --- a/testsuite/tests/typecheck/should_compile/T13585a.hs +++ b/testsuite/tests/typecheck/should_compile/T13585a.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE KindSignatures, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances,UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables, KindSignatures, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances,UndecidableInstances #-} module T13585a where @@ -78,5 +78,6 @@ au k = withIso k $ \ sa bt f -> fmap sa (f bt) {-# INLINE au #-} ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s) -ala = au . _Wrapping +ala = au . (\x -> _Wrapping x) + -- Simple subsumption (#17775) requires eta expansion here {-# INLINE ala #-} diff --git a/testsuite/tests/typecheck/should_compile/T13651.stderr b/testsuite/tests/typecheck/should_compile/T13651.stderr index 6b6c64302f..150291c210 100644 --- a/testsuite/tests/typecheck/should_compile/T13651.stderr +++ b/testsuite/tests/typecheck/should_compile/T13651.stderr @@ -8,6 +8,12 @@ T13651.hs:11:8: error: (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) at T13651.hs:(11,8)-(13,65) + Expected: forall cr cu h r u cs s. + (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => + Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) + Actual: forall cr cu h r u cs s. + (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => + Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) • In the ambiguity check for ‘foo’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: diff --git a/testsuite/tests/typecheck/should_compile/T14488.hs b/testsuite/tests/typecheck/should_compile/T14488.hs index a4a12841b7..04c295b706 100644 --- a/testsuite/tests/typecheck/should_compile/T14488.hs +++ b/testsuite/tests/typecheck/should_compile/T14488.hs @@ -7,4 +7,4 @@ type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s data T a = MkT { _tfield :: Eq a => a } tfield :: Eq a => Lens' (T a) a -tfield f t = MkT <$> f (_tfield t) +tfield f t = (\x -> MkT x) <$> f (_tfield t) diff --git a/testsuite/tests/typecheck/should_compile/T15368.stderr b/testsuite/tests/typecheck/should_compile/T15368.stderr index 693779e1f5..7f022744c4 100644 --- a/testsuite/tests/typecheck/should_compile/T15368.stderr +++ b/testsuite/tests/typecheck/should_compile/T15368.stderr @@ -15,9 +15,10 @@ T15368.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] 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)] - • Couldn't match type ‘F b a’ with ‘F b0 a0’ - Expected type: (F a b, F b a) - Actual type: (F a b, F b0 a0) + • Couldn't match type: F b a + with: F b0 a0 + Expected: (F a b, F b a) + Actual: (F a b, F b0 a0) NB: ‘F’ is a non-injective type family The type variables ‘b0’, ‘a0’ are ambiguous • In the expression: _ `transitive` trigger _ _ diff --git a/testsuite/tests/typecheck/should_compile/T15370.stderr b/testsuite/tests/typecheck/should_compile/T15370.stderr index ec0ff67482..f359155dbd 100644 --- a/testsuite/tests/typecheck/should_compile/T15370.stderr +++ b/testsuite/tests/typecheck/should_compile/T15370.stderr @@ -1,6 +1,8 @@ T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘n’ with ‘j’ + Expected: n :~: j + Actual: n :~: n ‘n’ is a rigid type variable bound by the type signature for: mkRefl :: forall {k} (n :: k) (j :: k). n :~: j @@ -9,8 +11,6 @@ T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)] the type signature for: mkRefl :: forall {k} (n :: k) (j :: k). n :~: j at T15370.hs:13:1-17 - Expected type: n :~: j - Actual type: n :~: n • In the expression: Refl In an equation for ‘mkRefl’: mkRefl = Refl • Relevant bindings include @@ -18,8 +18,8 @@ T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)] T15370.hs:20:13: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘S r’ with ‘()’ - Expected type: () - Actual type: S r + Expected: () + Actual: S r • In the expression: no + _ In a case alternative: Refl -> no + _ In the expression: case mkRefl @x @y of { Refl -> no + _ } diff --git a/testsuite/tests/typecheck/should_compile/T1634.hs b/testsuite/tests/typecheck/should_compile/T1634.hs index b4c6f2b561..a8fdd9f8eb 100644 --- a/testsuite/tests/typecheck/should_compile/T1634.hs +++ b/testsuite/tests/typecheck/should_compile/T1634.hs @@ -3,4 +3,4 @@ module T1634 where t1 :: a -> (forall b. b -> (a,b)) -t1 = (,) +t1 x = (,) x diff --git a/testsuite/tests/typecheck/should_compile/T17007.hs b/testsuite/tests/typecheck/should_compile/T17007.hs index 21b7639dd0..0b2b0f28a2 100644 --- a/testsuite/tests/typecheck/should_compile/T17007.hs +++ b/testsuite/tests/typecheck/should_compile/T17007.hs @@ -10,4 +10,4 @@ get (x :: ItemColID a b) = x :: ItemColID a b type family ItemColID' a b where ItemColID' a b = Int -- Discards a,b get' :: ItemColID' a b -> ItemColID' a b -get' (x :: ItemColID' a b) = x :: ItemColID' a b +get' (x :: ItemColID' p q) = x :: ItemColID' a b diff --git a/testsuite/tests/typecheck/should_compile/T2494.stderr b/testsuite/tests/typecheck/should_compile/T2494.stderr index 5cf4fde746..8e427c5ac8 100644 --- a/testsuite/tests/typecheck/should_compile/T2494.stderr +++ b/testsuite/tests/typecheck/should_compile/T2494.stderr @@ -1,14 +1,14 @@ T2494.hs:15:14: error: • Couldn't match type ‘b’ with ‘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" at T2494.hs:(12,1)-(15,33) ‘a’ is a rigid type variable bound by the RULE "foo/foo" at T2494.hs:(12,1)-(15,33) - Expected type: Maybe (m a) -> Maybe (m a) - Actual type: Maybe (m b) -> Maybe (m b) • In the first argument of ‘foo’, namely ‘g’ In the second argument of ‘foo’, namely ‘(foo g x)’ In the expression: foo f (foo g x) @@ -21,14 +21,14 @@ T2494.hs:15:14: error: T2494.hs:15:30: error: • Couldn't match type ‘b’ with ‘a’ + Expected: Maybe (m b) -> Maybe (m a) + Actual: Maybe (m b) -> Maybe (m b) ‘b’ is a rigid type variable bound by the RULE "foo/foo" at T2494.hs:(12,1)-(15,33) ‘a’ is a rigid type variable bound by the RULE "foo/foo" at T2494.hs:(12,1)-(15,33) - Expected type: Maybe (m b) -> Maybe (m a) - Actual type: Maybe (m b) -> Maybe (m b) • In the second argument of ‘(.)’, namely ‘g’ In the first argument of ‘foo’, namely ‘(f . g)’ In the expression: foo (f . g) x diff --git a/testsuite/tests/typecheck/should_compile/T3692.hs b/testsuite/tests/typecheck/should_compile/T3692.hs index 5be093f55f..4d5a61074f 100644 --- a/testsuite/tests/typecheck/should_compile/T3692.hs +++ b/testsuite/tests/typecheck/should_compile/T3692.hs @@ -7,5 +7,8 @@ type Foo a b = () -> (Bar a => a) class Bar a where {} +boo :: Foo p q +boo x = undefined + foo :: Foo a b -foo = id (undefined :: Foo p q) +foo y = id (\x -> boo x) y diff --git a/testsuite/tests/typecheck/should_compile/T4284.hs b/testsuite/tests/typecheck/should_compile/T4284.hs index 2d5164a487..5e1b9ceb5f 100644 --- a/testsuite/tests/typecheck/should_compile/T4284.hs +++ b/testsuite/tests/typecheck/should_compile/T4284.hs @@ -2,11 +2,11 @@ module Test where foo :: () -> forall b. b -foo = undefined +foo x = undefined -works = id foo +works = id (\x -> foo x) -fails = (id) foo +fails = (id) (\x -> foo x) -- works type checks, but fails fails with the following error -- message: diff --git a/testsuite/tests/typecheck/should_compile/T7220a.hs b/testsuite/tests/typecheck/should_compile/T7220a.hs index 4739626fa5..2ea0150f29 100644 --- a/testsuite/tests/typecheck/should_compile/T7220a.hs +++ b/testsuite/tests/typecheck/should_compile/T7220a.hs @@ -23,5 +23,7 @@ f :: (forall b. (C a b, TF b ~ Y) => b) -> X -- g = f -- Now we fail in all ways! -f _ = undefined +-- But with simple subsumption (#17775) we +-- no longer get an ambiguity check here +f _ = undefined diff --git a/testsuite/tests/typecheck/should_compile/T7220a.stderr b/testsuite/tests/typecheck/should_compile/T7220a.stderr deleted file mode 100644 index 2b311c1111..0000000000 --- a/testsuite/tests/typecheck/should_compile/T7220a.stderr +++ /dev/null @@ -1,14 +0,0 @@ - -T7220a.hs:17:6: error: - • Could not deduce (C a b) - from the context: (C a0 b, TF b ~ Y) - bound by a type expected by the context: - forall b. (C a0 b, TF b ~ Y) => b - at T7220a.hs:17:6-44 - Possible fix: - add (C a b) to the context of - a type expected by the context: - forall b. (C a0 b, TF b ~ Y) => b - • In the ambiguity check for ‘f’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: f :: (forall b. (C a b, TF b ~ Y) => b) -> X diff --git a/testsuite/tests/typecheck/should_compile/T9569a.hs b/testsuite/tests/typecheck/should_compile/T9569a.hs index 3205cb1b4e..0eeb4c40a7 100644 --- a/testsuite/tests/typecheck/should_compile/T9569a.hs +++ b/testsuite/tests/typecheck/should_compile/T9569a.hs @@ -5,7 +5,7 @@ g :: (Int -> Int) -> Int g f = f 4 f1 :: (forall a. a -> a) -> Int +-- Fails; needs eta-expansion +-- cf T9569b f1 = g -f2 :: (forall a. a -> a) -> Int -f2 x = g x diff --git a/testsuite/tests/typecheck/should_compile/T9569a.stderr b/testsuite/tests/typecheck/should_compile/T9569a.stderr new file mode 100644 index 0000000000..57d44a0f2a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9569a.stderr @@ -0,0 +1,8 @@ + +T9569a.hs:10:6: error: + • Couldn't match type: Int -> Int + with: forall a. a -> a + Expected: (forall a. a -> a) -> Int + Actual: (Int -> Int) -> Int + • In the expression: g + In an equation for ‘f1’: f1 = g diff --git a/testsuite/tests/typecheck/should_compile/T9569b.hs b/testsuite/tests/typecheck/should_compile/T9569b.hs new file mode 100644 index 0000000000..67ddf21d73 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9569b.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes #-} +module T9569a where + +g :: (Int -> Int) -> Int +g f = f 4 + +f2 :: (forall a. a -> a) -> Int +f2 f = g f diff --git a/testsuite/tests/typecheck/should_compile/T9834.hs b/testsuite/tests/typecheck/should_compile/T9834.hs index c16e395f8c..728de2b8ed 100644 --- a/testsuite/tests/typecheck/should_compile/T9834.hs +++ b/testsuite/tests/typecheck/should_compile/T9834.hs @@ -20,4 +20,4 @@ wrapIdComp f = runIdComp . f . liftOuter class Applicative p => ApplicativeFix p where afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a - afix = wrapIdComp
\ No newline at end of file + afix f = wrapIdComp f diff --git a/testsuite/tests/typecheck/should_compile/T9834.stderr b/testsuite/tests/typecheck/should_compile/T9834.stderr index 52f207d511..5963781325 100644 --- a/testsuite/tests/typecheck/should_compile/T9834.stderr +++ b/testsuite/tests/typecheck/should_compile/T9834.stderr @@ -1,40 +1,46 @@ -T9834.hs:23:10: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Occurs check: cannot construct the infinite type: p ~ (->) (p a0) - Expected type: (forall (q :: * -> *). - Applicative q => - Comp p q a -> Comp p q a) - -> p a - Actual type: (forall (q :: * -> *). - Applicative q => - Nat (Comp p q) (Comp p q)) - -> p a0 -> p a0 - • In the expression: wrapIdComp - In an equation for ‘afix’: afix = wrapIdComp +T9834.hs:23:12: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘p’ with ‘(->) (p a0)’ + Expected: p a + Actual: p a0 -> p a0 + ‘p’ is a rigid type variable bound by + the class declaration for ‘ApplicativeFix’ + at T9834.hs:21:39 + • In the expression: wrapIdComp f + In an equation for ‘afix’: afix f = wrapIdComp f • Relevant bindings include + f :: forall (q :: * -> *). + Applicative q => + Comp p q a -> Comp p q a + (bound at T9834.hs:23:8) afix :: (forall (q :: * -> *). Applicative q => Comp p q a -> Comp p q a) -> p a (bound at T9834.hs:23:3) -T9834.hs:23:10: warning: [-Wdeferred-type-errors (in -Wdefault)] +T9834.hs:23:23: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘a1’ with ‘a’ + Expected: Comp p q a1 -> Comp p q a1 + Actual: Comp p q a -> Comp p q a ‘a1’ is a rigid type variable bound by a type expected by the context: forall (q :: * -> *). Applicative q => Nat (Comp p q) (Comp p q) - at T9834.hs:23:10-19 + at T9834.hs:23:23 ‘a’ is a rigid type variable bound by the type signature for: afix :: forall a. (forall (q :: * -> *). Applicative q => Comp p q a -> Comp p q a) -> p a at T9834.hs:22:11-74 - Expected type: Comp p q a1 -> Comp p q a1 - Actual type: Comp p q a -> Comp p q a - • In the expression: wrapIdComp - In an equation for ‘afix’: afix = wrapIdComp + • In the first argument of ‘wrapIdComp’, namely ‘f’ + In the expression: wrapIdComp f + In an equation for ‘afix’: afix f = wrapIdComp f • Relevant bindings include + f :: forall (q :: * -> *). + Applicative q => + Comp p q a -> Comp p q a + (bound at T9834.hs:23:8) afix :: (forall (q :: * -> *). Applicative q => Comp p q a -> Comp p q a) diff --git a/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs b/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs index 9f5b984025..a7645a0b3e 100644 --- a/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs +++ b/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs @@ -14,7 +14,10 @@ import GHC.Exts (Int#,Word#,RuntimeRep(IntRep)) import GHC.Exts (TYPE) type KindOf (a :: TYPE k) = k + data family D (a :: TYPE r) :: TYPE r + newtype instance D a = MkWordD Word# + newtype instance D a :: TYPE (KindOf a) where MkIntD :: forall (a :: TYPE 'IntRep). Int# -> D a diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr index e422b8629e..119c6b91e5 100644 --- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr @@ -42,29 +42,29 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] where pure :: forall (f :: * -> *) a. Applicative f => a -> f a ($!) (_ :: [Integer] -> Integer) where ($!) :: forall a b. (a -> b) -> a -> b - curry (_ :: (a2, [Integer]) -> Integer) (_ :: a2) + curry (_ :: (t0, [Integer]) -> Integer) (_ :: t0) where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c (.) (_ :: b1 -> Integer) (_ :: [Integer] -> b1) where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c - flip (_ :: [Integer] -> b7 -> Integer) (_ :: b7) + flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0) where flip :: forall a b c. (a -> b -> c) -> b -> a -> c - (>>=) (_ :: [Integer] -> a11) (_ :: a11 -> [Integer] -> Integer) + (>>=) (_ :: [Integer] -> a8) (_ :: a8 -> [Integer] -> Integer) where (>>=) :: forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b - (>>) (_ :: [Integer] -> a10) (_ :: [Integer] -> Integer) + (>>) (_ :: [Integer] -> a7) (_ :: [Integer] -> Integer) where (>>) :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b - fmap (_ :: a12 -> Integer) (_ :: [Integer] -> a12) + fmap (_ :: a9 -> Integer) (_ :: [Integer] -> a9) where fmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b - (<*>) (_ :: [Integer] -> a8 -> Integer) (_ :: [Integer] -> a8) + (<*>) (_ :: [Integer] -> a5 -> Integer) (_ :: [Integer] -> a5) where (<*>) :: forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b - (*>) (_ :: [Integer] -> a7) (_ :: [Integer] -> Integer) + (*>) (_ :: [Integer] -> a4) (_ :: [Integer] -> Integer) where (*>) :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b @@ -72,7 +72,7 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] where (<$>) :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b - (=<<) (_ :: a9 -> [Integer] -> Integer) (_ :: [Integer] -> a9) + (=<<) (_ :: a6 -> [Integer] -> Integer) (_ :: [Integer] -> a6) where (=<<) :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b @@ -84,15 +84,15 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] where (<$) :: forall (f :: * -> *) a b. Functor f => a -> f b -> f a - id (_ :: t1 -> [Integer] -> Integer) (_ :: t1) + id (_ :: t0 -> [Integer] -> Integer) (_ :: t0) where id :: forall a. a -> a - head (_ :: [t1 -> [Integer] -> Integer]) (_ :: t1) + head (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0) where head :: forall a. [a] -> a - last (_ :: [t1 -> [Integer] -> Integer]) (_ :: t1) + last (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0) where last :: forall a. [a] -> a - fst (_ :: (t1 -> [Integer] -> Integer, b2)) (_ :: t1) + fst (_ :: (t0 -> [Integer] -> Integer, b2)) (_ :: t0) where fst :: forall a b. (a, b) -> a - snd (_ :: (a3, t1 -> [Integer] -> Integer)) (_ :: t1) + snd (_ :: (a2, t0 -> [Integer] -> Integer)) (_ :: t0) where snd :: forall a b. (a, b) -> b id (_ :: [Integer] -> Integer) where id :: forall a. a -> a @@ -108,19 +108,19 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] where fst :: forall a b. (a, b) -> a snd (_ :: (a0, [Integer] -> Integer)) where snd :: forall a b. (a, b) -> b - const (_ :: [Integer] -> Integer) (_ :: b6) + const (_ :: [Integer] -> Integer) (_ :: t0) where const :: forall a b. a -> b -> a - seq (_ :: a13) (_ :: [Integer] -> Integer) + seq (_ :: t2) (_ :: [Integer] -> Integer) where seq :: forall a b. a -> b -> b - ($) (_ :: a5 -> [Integer] -> Integer) (_ :: a5) + ($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0) where ($) :: forall a b. (a -> b) -> a -> b - return (_ :: [Integer] -> Integer) (_ :: t1) + return (_ :: [Integer] -> Integer) (_ :: t0) where return :: forall (m :: * -> *) a. Monad m => a -> m a - pure (_ :: [Integer] -> Integer) (_ :: t1) + pure (_ :: [Integer] -> Integer) (_ :: t0) where pure :: forall (f :: * -> *) a. Applicative f => a -> f a - uncurry (_ :: a4 -> b3 -> [Integer] -> Integer) (_ :: (a4, b3)) + uncurry (_ :: a3 -> b3 -> [Integer] -> Integer) (_ :: (a3, b3)) where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c - ($!) (_ :: a6 -> [Integer] -> Integer) (_ :: a6) + ($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0) where ($!) :: forall a b. (a -> b) -> a -> b abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] @@ -158,31 +158,31 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] where pure :: forall (f :: * -> *) a. Applicative f => a -> f a ($!) (_ :: Integer -> [Integer] -> Integer) where ($!) :: forall a b. (a -> b) -> a -> b - curry (_ :: (a2, Integer) -> [Integer] -> Integer) (_ :: a2) + curry (_ :: (t0, Integer) -> [Integer] -> Integer) (_ :: t0) where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c (.) (_ :: b1 -> [Integer] -> Integer) (_ :: Integer -> b1) where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c - flip (_ :: Integer -> b7 -> [Integer] -> Integer) (_ :: b7) + flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0) where flip :: forall a b c. (a -> b -> c) -> b -> a -> c - (>>=) (_ :: Integer -> a11) - (_ :: a11 -> Integer -> [Integer] -> Integer) + (>>=) (_ :: Integer -> a8) + (_ :: a8 -> Integer -> [Integer] -> Integer) where (>>=) :: forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b - (>>) (_ :: Integer -> a10) (_ :: Integer -> [Integer] -> Integer) + (>>) (_ :: Integer -> a7) (_ :: Integer -> [Integer] -> Integer) where (>>) :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b - fmap (_ :: a12 -> [Integer] -> Integer) (_ :: Integer -> a12) + fmap (_ :: a9 -> [Integer] -> Integer) (_ :: Integer -> a9) where fmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b - (<*>) (_ :: Integer -> a8 -> [Integer] -> Integer) - (_ :: Integer -> a8) + (<*>) (_ :: Integer -> a5 -> [Integer] -> Integer) + (_ :: Integer -> a5) where (<*>) :: forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b - (*>) (_ :: Integer -> a7) (_ :: Integer -> [Integer] -> Integer) + (*>) (_ :: Integer -> a4) (_ :: Integer -> [Integer] -> Integer) where (*>) :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b @@ -190,8 +190,8 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] where (<$>) :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b - (=<<) (_ :: a9 -> Integer -> [Integer] -> Integer) - (_ :: Integer -> a9) + (=<<) (_ :: a6 -> Integer -> [Integer] -> Integer) + (_ :: Integer -> a6) where (=<<) :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b @@ -203,15 +203,15 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] where (<$) :: forall (f :: * -> *) a b. Functor f => a -> f b -> f a - id (_ :: t1 -> Integer -> [Integer] -> Integer) (_ :: t1) + id (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0) where id :: forall a. a -> a - head (_ :: [t1 -> Integer -> [Integer] -> Integer]) (_ :: t1) + head (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0) where head :: forall a. [a] -> a - last (_ :: [t1 -> Integer -> [Integer] -> Integer]) (_ :: t1) + last (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0) where last :: forall a. [a] -> a - fst (_ :: (t1 -> Integer -> [Integer] -> Integer, b2)) (_ :: t1) + fst (_ :: (t0 -> Integer -> [Integer] -> Integer, b2)) (_ :: t0) where fst :: forall a b. (a, b) -> a - snd (_ :: (a3, t1 -> Integer -> [Integer] -> Integer)) (_ :: t1) + snd (_ :: (a2, t0 -> Integer -> [Integer] -> Integer)) (_ :: t0) where snd :: forall a b. (a, b) -> b id (_ :: Integer -> [Integer] -> Integer) where id :: forall a. a -> a @@ -228,18 +228,18 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] where fst :: forall a b. (a, b) -> a snd (_ :: (a0, Integer -> [Integer] -> Integer)) where snd :: forall a b. (a, b) -> b - const (_ :: Integer -> [Integer] -> Integer) (_ :: b6) + const (_ :: Integer -> [Integer] -> Integer) (_ :: t0) where const :: forall a b. a -> b -> a - seq (_ :: a13) (_ :: Integer -> [Integer] -> Integer) + seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer) where seq :: forall a b. a -> b -> b - ($) (_ :: a5 -> Integer -> [Integer] -> Integer) (_ :: a5) + ($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0) where ($) :: forall a b. (a -> b) -> a -> b - return (_ :: Integer -> [Integer] -> Integer) (_ :: t1) + return (_ :: Integer -> [Integer] -> Integer) (_ :: t0) where return :: forall (m :: * -> *) a. Monad m => a -> m a - pure (_ :: Integer -> [Integer] -> Integer) (_ :: t1) + pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0) where pure :: forall (f :: * -> *) a. Applicative f => a -> f a - uncurry (_ :: a4 -> b3 -> Integer -> [Integer] -> Integer) - (_ :: (a4, b3)) + uncurry (_ :: a3 -> b3 -> Integer -> [Integer] -> Integer) + (_ :: (a3, b3)) where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c - ($!) (_ :: a6 -> Integer -> [Integer] -> Integer) (_ :: a6) + ($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0) where ($!) :: forall a b. (a -> b) -> a -> b diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 9e19ba6d9b..ebce56c379 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -422,7 +422,8 @@ test('TcStaticPointers02', normal, compile, ['']) test('T8762', normal, compile, ['']) test('MutRec', normal, compile, ['']) test('T8856', normal, compile, ['']) -test('T9569a', normal, compile, ['']) +test('T9569a', normal, compile_fail, ['']) +test('T9569b', normal, compile, ['']) test('T9117', normal, compile, ['']) test('T9117_2', normal, compile, ['']) test('T9117_3', normal, compile, ['']) @@ -430,7 +431,7 @@ test('T9708', expect_broken(9708), compile, ['']) test('T9404', normal, compile, ['']) test('T9404b', normal, compile, ['']) test('T7220', normal, compile, ['']) -test('T7220a', normal, compile_fail, ['']) +test('T7220a', normal, compile, ['']) test('T9151', normal, compile, ['']) test('T9497a', normal, compile, ['-fdefer-typed-holes']) test('T9497b', normal, compile, ['-fdefer-typed-holes -fno-warn-typed-holes']) diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr index eb4b02f34e..8ea32fcde6 100644 --- a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr @@ -1,6 +1,6 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: [Char] -> [String] + • Found hole: _ :: String -> [String] • In the expression: _ In the expression: _ "hello, world" In an equation for ‘f’: f = _ "hello, world" @@ -22,7 +22,7 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 (and originally defined in ‘GHC.List’)) mempty :: forall a. Monoid a => a - with mempty @([Char] -> [String]) + with mempty @(String -> [String]) (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 (and originally defined in ‘GHC.Base’)) fail :: forall (m :: * -> *) a. MonadFail m => String -> m a diff --git a/testsuite/tests/typecheck/should_compile/tc145.hs b/testsuite/tests/typecheck/should_compile/tc145.hs index 8ab4a56321..9d1ada71a6 100644 --- a/testsuite/tests/typecheck/should_compile/tc145.hs +++ b/testsuite/tests/typecheck/should_compile/tc145.hs @@ -9,7 +9,7 @@ module ShouldCompile where -- implicit parameter to give -- r :: (?param::a) => a r :: Int -> ((?param :: a) => a) - r = error "urk" + r _ = error "urk" -- The unboxed tuple is OK because it is -- used on the right hand end of an arrow diff --git a/testsuite/tests/typecheck/should_compile/tc160.hs b/testsuite/tests/typecheck/should_compile/tc160.hs index 2425221aee..28e1b9e76b 100644 --- a/testsuite/tests/typecheck/should_compile/tc160.hs +++ b/testsuite/tests/typecheck/should_compile/tc160.hs @@ -7,8 +7,8 @@ module ShouldCompile where type Foo x = forall a. a -> x foo :: Foo (Foo ()) --- foo :: forall a b. a -> b -> () +-- foo :: forall a. a -> forall b. b -> () -- NOT forall a. a -> a -> () -foo = undefined +foo x = undefined baz = foo 'c' True diff --git a/testsuite/tests/typecheck/should_compile/tc208.hs b/testsuite/tests/typecheck/should_compile/tc208.hs index 8d9bb3636e..254eb82264 100644 --- a/testsuite/tests/typecheck/should_compile/tc208.hs +++ b/testsuite/tests/typecheck/should_compile/tc208.hs @@ -11,4 +11,4 @@ module ShouldCompile where type PPDoc = (?env :: Int) => Char f :: Char -> PPDoc -f = succ +f x = succ x diff --git a/testsuite/tests/typecheck/should_compile/tc210.hs b/testsuite/tests/typecheck/should_compile/tc210.hs index b4a377f761..9a0de89d4e 100644 --- a/testsuite/tests/typecheck/should_compile/tc210.hs +++ b/testsuite/tests/typecheck/should_compile/tc210.hs @@ -3,10 +3,10 @@ module ShouldCompile where f :: forall a. a -> forall b. b -> Int -f = error "urk" +f x = error "urk" -- Both these should be ok, but an early GHC 6.6 failed -g1 = [ (+) :: Int -> Int -> Int, f ] -g2 = [ f, (+) :: Int -> Int -> Int ] +g1 = [ (+) :: Int -> Int -> Int, \x -> f x ] +g2 = [ \x -> f x, (+) :: Int -> Int -> Int ] diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr index ccc3da6fb0..bbffa16943 100644 --- a/testsuite/tests/typecheck/should_compile/tc211.stderr +++ b/testsuite/tests/typecheck/should_compile/tc211.stderr @@ -1,10 +1,11 @@ -tc211.hs:20:8: error: - • Couldn't match expected type ‘forall a. a -> a’ - with actual type ‘a9 -> a9’ - • In the expression: - (:) :: - (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a] +tc211.hs:21:17: error: + • Couldn't match expected type: a -> a + with actual type: forall a. a -> a + • In the first argument of ‘(:) :: + (forall a. a -> a) + -> [forall a. a -> a] -> [forall a. a -> a]’, namely + ‘(head foo)’ In the expression: ((:) :: (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a]) @@ -14,77 +15,3 @@ tc211.hs:20:8: error: = ((:) :: (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a]) (head foo) foo - -tc211.hs:25:8: error: - • Couldn't match type ‘a1 -> a1’ with ‘forall a. a -> a’ - Expected type: [forall a. a -> a] - Actual type: [a1 -> a1] - • In the expression: (head foo) : (tail foo) - In an equation for ‘barr’: barr = (head foo) : (tail foo) - -tc211.hs:25:20: error: - • Couldn't match type ‘forall a. a -> a’ with ‘a1 -> a1’ - Expected type: [a1 -> a1] - Actual type: [forall a. a -> a] - • In the second argument of ‘(:)’, namely ‘(tail foo)’ - In the expression: (head foo) : (tail foo) - In an equation for ‘barr’: barr = (head foo) : (tail foo) - -tc211.hs:62:18: error: - • Couldn't match expected type ‘forall a. a -> a’ - with actual type ‘a6 -> a6’ - • In the expression: - Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) - In an equation for ‘cons’: - cons - = Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) - In the expression: - let - cons - = Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) - in cons (\ x -> x) Nil - -tc211.hs:68:8: error: - • Couldn't match expected type ‘forall a. a -> a’ - with actual type ‘a0 -> a0’ - • In the expression: - Cons :: - ((forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a)) - In the expression: - (Cons :: - ((forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a))) - (\ x -> x) Nil - In an equation for ‘xs2’: - xs2 - = (Cons :: - ((forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a))) - (\ x -> x) Nil - -tc211.hs:76:9: error: - • Couldn't match type ‘forall a11. a11 -> a11’ with ‘a10 -> a10’ - Expected type: List (forall a. a -> a) - -> (forall a. a -> a) -> a10 -> a10 - Actual type: List (a10 -> a10) -> (a10 -> a10) -> a10 -> a10 - • In the expression: - foo2 :: - List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a) - In the expression: - (foo2 :: - List (forall a. a -> a) - -> (forall a. a -> a) -> (forall a. a -> a)) - xs1 (\ x -> x) - In an equation for ‘bar4’: - bar4 - = (foo2 :: - List (forall a. a -> a) - -> (forall a. a -> a) -> (forall a. a -> a)) - xs1 (\ x -> x) diff --git a/testsuite/tests/typecheck/should_compile/twins.hs b/testsuite/tests/typecheck/should_compile/twins.hs index 99c77aa796..31d967aa59 100644 --- a/testsuite/tests/typecheck/should_compile/twins.hs +++ b/testsuite/tests/typecheck/should_compile/twins.hs @@ -22,7 +22,7 @@ gzip f x y else Nothing gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m) -gzipWithM _ = error "urk" +gzipWithM _ _ = error "urk" orElse :: Maybe a -> Maybe a -> Maybe a orElse = error "urk" diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr index 1c108f719b..116a18f42f 100644 --- a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr @@ -225,7 +225,7 @@ valid_hole_fits.hs:38:10: warning: [-Wtyped-holes (in -Wdefault)] (and originally defined in ‘GHC.Base’)) valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: [Char] -> IO () + • Found hole: _ :: String -> IO () • In the expression: _ In the expression: _ "hello, world" In an equation for ‘main’: main = _ "hello, world" @@ -242,7 +242,7 @@ valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 (and originally defined in ‘System.IO’)) print :: forall a. Show a => a -> IO () - with print @[Char] + with print @String (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 (and originally defined in ‘System.IO’)) fail :: forall (m :: * -> *) a. MonadFail m => String -> m a @@ -250,6 +250,6 @@ valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 (and originally defined in ‘Control.Monad.Fail’)) mempty :: forall a. Monoid a => a - with mempty @([Char] -> IO ()) + with mempty @(String -> IO ()) (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr index 0d5a9109a4..f592741d6f 100644 --- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr +++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr @@ -1,11 +1,12 @@ + ExpandSynsFail1.hs:4:31: error: - Couldn't match type ‘Bool’ with ‘Int’ - Expected type: Foo - Actual type: Bar - Type synonyms expanded: - Expected type: Int - Actual type: Bool - In the second argument of ‘(==)’, namely ‘(False :: Bar)’ - In the second argument of ‘($)’, namely - ‘(1 :: Foo) == (False :: Bar)’ - In the expression: print $ (1 :: Foo) == (False :: Bar) + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Foo + Actual: Bar + Type synonyms expanded: + Expected type: Int + Actual type: Bool + • In the second argument of ‘(==)’, namely ‘(False :: Bar)’ + In the second argument of ‘($)’, namely + ‘(1 :: Foo) == (False :: Bar)’ + In the expression: print $ (1 :: Foo) == (False :: Bar) diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr index 49e262cd3c..24aca978e3 100644 --- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr +++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr @@ -1,8 +1,8 @@ ExpandSynsFail2.hs:19:37: error: • Couldn't match type ‘Int’ with ‘Bool’ - Expected type: ST s Foo - Actual type: MyBarST s + Expected: ST s Foo + Actual: MyBarST s Type synonyms expanded: Expected type: ST s Int Actual type: ST s Bool diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr index 65d91351f5..5179c4ddc1 100644 --- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr +++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr @@ -1,11 +1,12 @@ + ExpandSynsFail3.hs:21:8: error: - Couldn't match type ‘Int’ with ‘Bool’ - Expected type: T (T3, T5, Int) - Actual type: T (T5, T3, Bool) - Type synonyms expanded: - Expected type: T (T3, T3, Int) - Actual type: T (T3, T3, Bool) - In the first argument of ‘f’, namely - ‘(undefined :: T (T5, T3, Bool))’ - In the expression: f (undefined :: T (T5, T3, Bool)) - In an equation for ‘a’: a = f (undefined :: T (T5, T3, Bool)) + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: T (T3, T5, Int) + Actual: T (T5, T3, Bool) + Type synonyms expanded: + Expected type: T (T3, T3, Int) + Actual type: T (T3, T3, Bool) + • In the first argument of ‘f’, namely + ‘(undefined :: T (T5, T3, Bool))’ + In the expression: f (undefined :: T (T5, T3, Bool)) + In an equation for ‘a’: a = f (undefined :: T (T5, T3, Bool)) diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr index bae53ce104..d11f72a758 100644 --- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr +++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr @@ -1,7 +1,8 @@ + ExpandSynsFail4.hs:11:22: error: - Couldn't match type ‘Bool’ with ‘Int’ - Expected type: T Int - Actual type: T Bool - In the first argument of ‘f’, namely ‘(undefined :: T Bool)’ - In the second argument of ‘($)’, namely ‘f (undefined :: T Bool)’ - In the expression: putStrLn $ f (undefined :: T Bool) + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: T Int + Actual: T Bool + • In the first argument of ‘f’, namely ‘(undefined :: T Bool)’ + In the second argument of ‘($)’, namely ‘f (undefined :: T Bool)’ + In the expression: putStrLn $ f (undefined :: T Bool) diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr index 613d92b837..255b3ad702 100644 --- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr +++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr @@ -1,7 +1,6 @@ FrozenErrorTests.hs:26:9: error: - • Occurs check: cannot construct the infinite type: a ~ [a] - arising from a use of ‘goo1’ + • Couldn't match type ‘a’ with ‘[a]’ arising from a use of ‘goo1’ • In the expression: goo1 False undefined In an equation for ‘test1’: test1 = goo1 False undefined • Relevant bindings include @@ -21,7 +20,8 @@ FrozenErrorTests.hs:30:9: error: In an equation for ‘test3’: test3 = goo1 False (goo2 undefined) FrozenErrorTests.hs:45:15: error: - • Couldn't match type ‘T2 c c’ with ‘M (T2 (T2 c c) c)’ + • Couldn't match type: T2 c c + with: M (T2 (T2 c c) c) arising from a use of ‘goo3’ • In the first argument of ‘goo4’, namely ‘(goo3 False undefined)’ In the expression: goo4 (goo3 False undefined) @@ -30,7 +30,8 @@ FrozenErrorTests.hs:45:15: error: test4 :: T2 (T2 c c) c (bound at FrozenErrorTests.hs:45:1) FrozenErrorTests.hs:46:9: error: - • Couldn't match type ‘T2 c c’ with ‘M (T2 (T2 c c) c)’ + • Couldn't match type: T2 c c + with: M (T2 (T2 c c) c) arising from a use of ‘goo3’ • In the expression: goo3 False (goo4 undefined) In an equation for ‘test5’: test5 = goo3 False (goo4 undefined) diff --git a/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr b/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr index afa8330765..114d3e962d 100644 --- a/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr +++ b/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr @@ -1,10 +1,16 @@ LevPolyBounded.hs:10:15: error: • Expected a type, but ‘a’ has kind ‘TYPE r’ + ‘r’ is a rigid type variable bound by + the class declaration for ‘XBounded’ + at LevPolyBounded.hs:9:27 • In the type signature: LevPolyBounded.minBound :: a In the class declaration for ‘XBounded’ LevPolyBounded.hs:11:15: error: • Expected a type, but ‘a’ has kind ‘TYPE r’ + ‘r’ is a rigid type variable bound by + the class declaration for ‘XBounded’ + at LevPolyBounded.hs:9:27 • In the type signature: LevPolyBounded.maxBound :: a In the class declaration for ‘XBounded’ diff --git a/testsuite/tests/typecheck/should_fail/T10194.stderr b/testsuite/tests/typecheck/should_fail/T10194.stderr index aeaad79440..60374ffe16 100644 --- a/testsuite/tests/typecheck/should_fail/T10194.stderr +++ b/testsuite/tests/typecheck/should_fail/T10194.stderr @@ -1,7 +1,9 @@ T10194.hs:7:8: error: - • Cannot instantiate unification variable ‘b0’ + • Couldn't match type ‘b0’ with ‘X’ + Expected: (X -> c) -> (a -> X) -> a -> c + Actual: (b0 -> c) -> (a -> b0) -> a -> c + Cannot instantiate unification variable ‘b0’ with a type involving polytypes: X - GHC doesn't yet support impredicative polymorphism • In the expression: (.) In an equation for ‘comp’: comp = (.) diff --git a/testsuite/tests/typecheck/should_fail/T10619.stderr b/testsuite/tests/typecheck/should_fail/T10619.stderr index 9d34750675..481a08a20c 100644 --- a/testsuite/tests/typecheck/should_fail/T10619.stderr +++ b/testsuite/tests/typecheck/should_fail/T10619.stderr @@ -1,8 +1,11 @@ T10619.hs:9:15: error: - • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’ - Expected type: (b -> b) -> b -> b - Actual type: (forall a. a -> a) -> b -> b + • Couldn't match type ‘p’ with ‘forall b. b -> b’ + Expected: p -> p + Actual: (forall a. a -> a) -> forall b. b -> b + ‘p’ is a rigid type variable bound by + the inferred type of foo :: p1 -> p -> p + at T10619.hs:(8,1)-(10,20) • In the expression: (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b In the expression: @@ -17,12 +20,15 @@ T10619.hs:9:15: error: else \ y -> y • Relevant bindings include - foo :: p -> (b -> b) -> b -> b (bound at T10619.hs:8:1) + foo :: p1 -> p -> p (bound at T10619.hs:8:1) T10619.hs:14:15: error: - • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’ - Expected type: (b -> b) -> b -> b - Actual type: (forall a. a -> a) -> b -> b + • Couldn't match type ‘p’ with ‘forall a. a -> a’ + Expected: p -> p + Actual: (forall a. a -> a) -> forall b. b -> b + ‘p’ is a rigid type variable bound by + the inferred type of bar :: p1 -> p -> p + at T10619.hs:(12,1)-(14,66) • In the expression: (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b In the expression: @@ -37,26 +43,32 @@ T10619.hs:14:15: error: else ((\ x -> x) :: (forall a. a -> a) -> forall b. b -> b) • Relevant bindings include - bar :: p -> (b -> b) -> b -> b (bound at T10619.hs:12:1) + bar :: p1 -> p -> p (bound at T10619.hs:12:1) T10619.hs:16:13: error: - • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’ - Expected type: (b -> b) -> b -> b - Actual type: (forall a. a -> a) -> b -> b + • Couldn't match type ‘p’ with ‘forall b. b -> b’ + Expected: p -> p + Actual: (forall a. a -> a) -> forall b. b -> b + ‘p’ is a rigid type variable bound by + the inferred type of baz :: Bool -> p -> p + at T10619.hs:(16,1)-(17,19) • In the expression: (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b In an equation for ‘baz’: baz True = (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b • Relevant bindings include - baz :: Bool -> (b -> b) -> b -> b (bound at T10619.hs:16:1) + baz :: Bool -> p -> p (bound at T10619.hs:16:1) T10619.hs:20:14: error: - • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’ - Expected type: (b -> b) -> b -> b - Actual type: (forall a. a -> a) -> b -> b + • Couldn't match type ‘p’ with ‘forall a. a -> a’ + Expected: p -> p + Actual: (forall a. a -> a) -> forall b. b -> b + ‘p’ is a rigid type variable bound by + the inferred type of quux :: Bool -> p -> p + at T10619.hs:(19,1)-(20,64) • In the expression: (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b In an equation for ‘quux’: quux True = (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b • Relevant bindings include - quux :: Bool -> (b -> b) -> b -> b (bound at T10619.hs:19:1) + quux :: Bool -> p -> p (bound at T10619.hs:19:1) diff --git a/testsuite/tests/typecheck/should_fail/T10715b.stderr b/testsuite/tests/typecheck/should_fail/T10715b.stderr index 8c7f370273..99875bbcf5 100644 --- a/testsuite/tests/typecheck/should_fail/T10715b.stderr +++ b/testsuite/tests/typecheck/should_fail/T10715b.stderr @@ -1,8 +1,12 @@ T10715b.hs:7:7: error: - Occurs check: cannot construct the infinite type: b ~ [b] - arising from a use of ‘coerce’ - In the first argument of ‘asTypeOf’, namely ‘coerce’ - In the expression: coerce `asTypeOf` head - In an equation for ‘foo’: foo = coerce `asTypeOf` head - Relevant bindings include foo :: [b] -> b (bound at T10715b.hs:7:1) + • Couldn't match representation of type ‘b’ with that of ‘[b]’ + arising from a use of ‘coerce’ + ‘b’ is a rigid type variable bound by + the inferred type of foo :: [b] -> b + at T10715b.hs:7:1-28 + • In the first argument of ‘asTypeOf’, namely ‘coerce’ + In the expression: coerce `asTypeOf` head + In an equation for ‘foo’: foo = coerce `asTypeOf` head + • Relevant bindings include + foo :: [b] -> b (bound at T10715b.hs:7:1) diff --git a/testsuite/tests/typecheck/should_fail/T10971d.stderr b/testsuite/tests/typecheck/should_fail/T10971d.stderr index 5cf339bd8d..93dce724d0 100644 --- a/testsuite/tests/typecheck/should_fail/T10971d.stderr +++ b/testsuite/tests/typecheck/should_fail/T10971d.stderr @@ -1,18 +1,21 @@ T10971d.hs:4:14: error: - • Couldn't match expected type ‘[a0]’ with actual type ‘Maybe a2’ + • Couldn't match expected type: [a0] + with actual type: Maybe a3 • In the first argument of ‘f’, namely ‘(Just 1)’ In the second argument of ‘($)’, namely ‘f (Just 1)’ In a stmt of a 'do' block: print $ f (Just 1) T10971d.hs:5:19: error: - • Couldn't match expected type ‘[b1]’ with actual type ‘Maybe a3’ + • Couldn't match expected type: [b0] + with actual type: Maybe a4 • In the second argument of ‘g’, namely ‘(Just 5)’ In the second argument of ‘($)’, namely ‘g (+ 1) (Just 5)’ In a stmt of a 'do' block: print $ g (+ 1) (Just 5) T10971d.hs:6:23: error: - • Couldn't match expected type ‘[b0]’ with actual type ‘Maybe a1’ + • Couldn't match expected type: [a2] + with actual type: Maybe a1 • In the second argument of ‘h’, namely ‘Nothing’ In the second argument of ‘($)’, namely ‘h (const 5) Nothing’ In a stmt of a 'do' block: print $ h (const 5) Nothing diff --git a/testsuite/tests/typecheck/should_fail/T11514.stderr b/testsuite/tests/typecheck/should_fail/T11514.stderr index 62acf15b73..dd940a36b1 100644 --- a/testsuite/tests/typecheck/should_fail/T11514.stderr +++ b/testsuite/tests/typecheck/should_fail/T11514.stderr @@ -1,8 +1,9 @@ T11514.hs:6:7: error: - • Cannot instantiate unification variable ‘a0’ + • Couldn't match expected type ‘(Show a => a -> a) -> ()’ + with actual type ‘a0’ + Cannot instantiate unification variable ‘a0’ with a type involving polytypes: (Show a => a -> a) -> () - GHC doesn't yet support impredicative polymorphism • In the expression: undefined In an equation for ‘foo’: foo = undefined • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T11672.stderr b/testsuite/tests/typecheck/should_fail/T11672.stderr index 16eb31042f..a0f8d7e36c 100644 --- a/testsuite/tests/typecheck/should_fail/T11672.stderr +++ b/testsuite/tests/typecheck/should_fail/T11672.stderr @@ -4,8 +4,8 @@ T11672.hs:9:10: error: When matching types a0 :: Symbol Int -> Bool :: * - Expected type: Proxy a0 - Actual type: Proxy (Int -> Bool) + Expected: Proxy a0 + Actual: Proxy (Int -> Bool) • In the first argument of ‘f’, namely ‘(Proxy :: Proxy (Int -> Bool))’ In the expression: f (Proxy :: Proxy (Int -> Bool)) diff --git a/testsuite/tests/typecheck/should_fail/T12170a.stderr b/testsuite/tests/typecheck/should_fail/T12170a.stderr index c1e4bdcecb..a8f349df43 100644 --- a/testsuite/tests/typecheck/should_fail/T12170a.stderr +++ b/testsuite/tests/typecheck/should_fail/T12170a.stderr @@ -1,9 +1,9 @@ -T12170a.hs:20:7: error: +T12170a.hs:20:35: error: • Couldn't match type ‘Ref m0’ with ‘IORef’ - Expected type: IO (Ref m0 (f0 ())) - Actual type: IO (Ref IO (f0 ())) + Expected: IORef (f0 ()) -> m0 (f0 ()) + Actual: Ref m0 (f0 ()) -> m0 (f0 ()) The type variable ‘m0’ is ambiguous - • In the first argument of ‘(>>=)’, namely ‘newRef (pure ())’ + • In the second argument of ‘(.)’, namely ‘readRef’ + In the second argument of ‘(>>=)’, namely ‘join . readRef’ In the expression: newRef (pure ()) >>= join . readRef - In an equation for ‘foo’: foo = newRef (pure ()) >>= join . readRef
\ No newline at end of file diff --git a/testsuite/tests/typecheck/should_fail/T12373.stderr b/testsuite/tests/typecheck/should_fail/T12373.stderr index a2568d75f9..20137fbdad 100644 --- a/testsuite/tests/typecheck/should_fail/T12373.stderr +++ b/testsuite/tests/typecheck/should_fail/T12373.stderr @@ -4,8 +4,8 @@ T12373.hs:10:19: error: When matching types a0 :: * MVar# RealWorld a1 :: TYPE 'UnliftedRep - Expected type: (# State# RealWorld, a0 #) - Actual type: (# State# RealWorld, MVar# RealWorld a1 #) + Expected: (# State# RealWorld, a0 #) + Actual: (# State# RealWorld, MVar# RealWorld a1 #) • In the expression: newMVar# rw In the first argument of ‘IO’, namely ‘(\ rw -> newMVar# rw)’ In the first argument of ‘(>>)’, namely ‘IO (\ rw -> newMVar# rw)’ diff --git a/testsuite/tests/typecheck/should_fail/T12563.stderr b/testsuite/tests/typecheck/should_fail/T12563.stderr index e6619aa1da..f141a23e96 100644 --- a/testsuite/tests/typecheck/should_fail/T12563.stderr +++ b/testsuite/tests/typecheck/should_fail/T12563.stderr @@ -1,8 +1,9 @@ T12563.hs:7:15: error: - • Cannot instantiate unification variable ‘p0’ + • Couldn't match expected type ‘(forall a. f0 a) -> f0 r0’ + with actual type ‘p0’ + Cannot instantiate unification variable ‘p0’ with a type involving polytypes: (forall a. f0 a) -> f0 r0 - GHC doesn't yet support impredicative polymorphism • In the first argument of ‘foo’, namely ‘g’ In the expression: foo g In the expression: \ g -> foo g diff --git a/testsuite/tests/typecheck/should_fail/T12589.stderr b/testsuite/tests/typecheck/should_fail/T12589.stderr index 80ea5edb80..5f359090d9 100644 --- a/testsuite/tests/typecheck/should_fail/T12589.stderr +++ b/testsuite/tests/typecheck/should_fail/T12589.stderr @@ -2,10 +2,11 @@ T12589.hs:13:3: error: Variable not in scope: (&) :: t0 -> t1 -> t T12589.hs:13:5: error: - • Cannot instantiate unification variable ‘t1’ + • Couldn't match expected type ‘t1’ + with actual type ‘(forall a. Bounded a => f0 a) -> h0 f0 xs0’ + Cannot instantiate unification variable ‘t1’ with a type involving polytypes: (forall a. Bounded a => f0 a) -> h0 f0 xs0 - GHC doesn't yet support impredicative polymorphism • In the second argument of ‘(&)’, namely ‘hcpure (Proxy @Bounded)’ In the expression: minBound & hcpure (Proxy @Bounded) In an equation for ‘a’: a = minBound & hcpure (Proxy @Bounded) diff --git a/testsuite/tests/typecheck/should_fail/T12648.stderr b/testsuite/tests/typecheck/should_fail/T12648.stderr index 227bc6773e..f13b6c1cd0 100644 --- a/testsuite/tests/typecheck/should_fail/T12648.stderr +++ b/testsuite/tests/typecheck/should_fail/T12648.stderr @@ -1,12 +1,12 @@ T12648.hs:76:2: error: • Couldn't match type ‘a’ with ‘()’ + Expected: m a + Actual: m () ‘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 - Expected type: m a - Actual type: m () • In a stmt of a 'do' block: return () In the expression: do _ <- askUnliftBase diff --git a/testsuite/tests/typecheck/should_fail/T12906.stderr b/testsuite/tests/typecheck/should_fail/T12906.stderr index c74fd97bbc..f1f245c912 100644 --- a/testsuite/tests/typecheck/should_fail/T12906.stderr +++ b/testsuite/tests/typecheck/should_fail/T12906.stderr @@ -3,8 +3,9 @@ T12906.hs:1:1: error: The IO action ‘main’ is not defined in module ‘Main’ T12906.hs:2:7: error: - • Couldn't match type ‘IO ()’ with ‘[Char]’ - Expected type: String - Actual type: IO () + • Couldn't match type: IO () + with: [Char] + Expected: String + Actual: IO () • In the expression: print (reverse s + 1) In an equation for ‘x’: x s = print (reverse s + 1) diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr index d38ccf22b9..f10faf2751 100644 --- a/testsuite/tests/typecheck/should_fail/T12921.stderr +++ b/testsuite/tests/typecheck/should_fail/T12921.stderr @@ -10,7 +10,7 @@ T12921.hs:4:1: error: instance Data.Data.Data Ordering -- Defined in ‘Data.Data’ instance Data.Data.Data Integer -- Defined in ‘Data.Data’ ...plus 15 others - ...plus 47 instances involving out-of-scope types + ...plus 50 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN module "HLint: ignore Reduce duplication" #-} diff --git a/testsuite/tests/typecheck/should_fail/T13292.stderr b/testsuite/tests/typecheck/should_fail/T13292.stderr index adb2738e69..217c5d4a39 100644 --- a/testsuite/tests/typecheck/should_fail/T13292.stderr +++ b/testsuite/tests/typecheck/should_fail/T13292.stderr @@ -17,7 +17,7 @@ T13292a.hs:4:12: warning: [-Wdeferred-type-errors (in -Wdefault)] T13292.hs:6:1: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘GHC.Types.Any’ with ‘IO’ - Expected type: IO () - Actual type: GHC.Types.Any () + Expected: IO () + Actual: GHC.Types.Any () • In the expression: main When checking the type of the IO action ‘main’ diff --git a/testsuite/tests/typecheck/should_fail/T13311.stderr b/testsuite/tests/typecheck/should_fail/T13311.stderr index d739d2173c..e858a6037e 100644 --- a/testsuite/tests/typecheck/should_fail/T13311.stderr +++ b/testsuite/tests/typecheck/should_fail/T13311.stderr @@ -1,7 +1,7 @@ T13311.hs:9:3: error: - • Couldn't match expected type ‘IO a0’ - with actual type ‘Maybe a1 -> Maybe b0’ + • Couldn't match expected type: IO a0 + with actual type: Maybe a1 -> Maybe b0 • Probable cause: ‘f’ is applied to too few arguments In a stmt of a 'do' block: f In the expression: diff --git a/testsuite/tests/typecheck/should_fail/T13320.stderr b/testsuite/tests/typecheck/should_fail/T13320.stderr index afafdb3074..4442069d15 100644 --- a/testsuite/tests/typecheck/should_fail/T13320.stderr +++ b/testsuite/tests/typecheck/should_fail/T13320.stderr @@ -1,6 +1,7 @@ T13320.hs:32:21: error: - • Couldn't match type ‘X_Var ξ’ with ‘TermX ξ’ + • Couldn't match type: X_Var ξ + with: TermX ξ arising from a use of ‘genTerm’ • In the first argument of ‘sized’, namely ‘genTerm’ In the expression: sized genTerm diff --git a/testsuite/tests/typecheck/should_fail/T13530.stderr b/testsuite/tests/typecheck/should_fail/T13530.stderr index 139c1b0f34..4b540f297c 100644 --- a/testsuite/tests/typecheck/should_fail/T13530.stderr +++ b/testsuite/tests/typecheck/should_fail/T13530.stderr @@ -4,7 +4,7 @@ T13530.hs:11:7: error: When matching types a0 :: * Int# :: TYPE 'IntRep - Expected type: (# Int#, Int# #) - Actual type: (# Int#, a0 #) + Expected: (# Int#, Int# #) + Actual: (# Int#, a0 #) • In the expression: g x In an equation for ‘f’: f x = g x diff --git a/testsuite/tests/typecheck/should_fail/T13610.stderr b/testsuite/tests/typecheck/should_fail/T13610.stderr index 0755ce9371..c04687988c 100644 --- a/testsuite/tests/typecheck/should_fail/T13610.stderr +++ b/testsuite/tests/typecheck/should_fail/T13610.stderr @@ -4,8 +4,8 @@ T13610.hs:11:15: error: When matching types a :: * Weak# () :: TYPE 'UnliftedRep - Expected type: (# State# RealWorld, a #) - Actual type: (# State# RealWorld, Weak# () #) + Expected: (# State# RealWorld, a #) + Actual: (# State# RealWorld, Weak# () #) • In the expression: mkWeakNoFinalizer# double () s In the first argument of ‘IO’, namely ‘(\ s -> mkWeakNoFinalizer# double () s)’ diff --git a/testsuite/tests/typecheck/should_fail/T13909.stderr b/testsuite/tests/typecheck/should_fail/T13909.stderr index 599be5a445..0cbae70733 100644 --- a/testsuite/tests/typecheck/should_fail/T13909.stderr +++ b/testsuite/tests/typecheck/should_fail/T13909.stderr @@ -1,5 +1,7 @@ T13909.hs:11:18: error: • Expected kind ‘k0’, but ‘Hm’ has kind ‘forall k -> k -> *’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall k -> k -> * • In the first argument of ‘HasName’, namely ‘Hm’ In the instance declaration for ‘HasName Hm’ diff --git a/testsuite/tests/typecheck/should_fail/T14605.stderr b/testsuite/tests/typecheck/should_fail/T14605.stderr index 09181c6ee8..04d8b5a67d 100644 --- a/testsuite/tests/typecheck/should_fail/T14605.stderr +++ b/testsuite/tests/typecheck/should_fail/T14605.stderr @@ -1,8 +1,8 @@ T14605.hs:14:13: error: - • Couldn't match representation of type ‘x1’ with that of ‘()’ + • Couldn't match representation of type ‘x’ with that of ‘()’ arising from a use of ‘coerce’ - ‘x1’ is a rigid type variable bound by + ‘x’ is a rigid type variable bound by the type () at T14605.hs:14:1-49 • In the expression: coerce @(forall x. ()) @(forall x. x) diff --git a/testsuite/tests/typecheck/should_fail/T14618.stderr b/testsuite/tests/typecheck/should_fail/T14618.stderr index 8faa64c25e..2faf4a925b 100644 --- a/testsuite/tests/typecheck/should_fail/T14618.stderr +++ b/testsuite/tests/typecheck/should_fail/T14618.stderr @@ -1,16 +1,12 @@ T14618.hs:6:14: error: - • Couldn't match type ‘a’ with ‘b’ - ‘a’ is a rigid type variable bound by - the type signature for: - safeCoerce :: forall a b. a -> b - at T14618.hs:5:1-20 + • Couldn't match type ‘b’ with ‘forall c. a’ + Expected: a -> b + Actual: a -> forall c. a ‘b’ is a rigid type variable bound by the type signature for: safeCoerce :: forall a b. a -> b at T14618.hs:5:1-20 - Expected type: a -> b - Actual type: b -> b • In the expression: f' In an equation for ‘safeCoerce’: safeCoerce diff --git a/testsuite/tests/typecheck/should_fail/T14884.stderr b/testsuite/tests/typecheck/should_fail/T14884.stderr index cb85da14a5..f454bb5625 100644 --- a/testsuite/tests/typecheck/should_fail/T14884.stderr +++ b/testsuite/tests/typecheck/should_fail/T14884.stderr @@ -1,6 +1,6 @@ T14884.hs:4:5: error: - • Found hole: _ :: (a0 -> IO ()) -> [Char] -> IO () + • Found hole: _ :: (a0 -> IO ()) -> String -> IO () Where: ‘a0’ is an ambiguous type variable • In the expression: _ In the expression: _ print "abc" @@ -20,15 +20,15 @@ T14884.hs:4:5: error: (imported from ‘Prelude’ at T14884.hs:1:8-13 (and originally defined in ‘Data.Foldable’)) ($) :: forall a b. (a -> b) -> a -> b - with ($) @'GHC.Types.LiftedRep @[Char] @(IO ()) + with ($) @'GHC.Types.LiftedRep @String @(IO ()) (imported from ‘Prelude’ at T14884.hs:1:8-13 (and originally defined in ‘GHC.Base’)) ($!) :: forall a b. (a -> b) -> a -> b - with ($!) @'GHC.Types.LiftedRep @[Char] @(IO ()) + with ($!) @'GHC.Types.LiftedRep @String @(IO ()) (imported from ‘Prelude’ at T14884.hs:1:8-13 (and originally defined in ‘GHC.Base’)) id :: forall a. a -> a - with id @([Char] -> IO ()) + with id @(String -> IO ()) (imported from ‘Prelude’ at T14884.hs:1:8-13 (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_fail/T14904a.stderr b/testsuite/tests/typecheck/should_fail/T14904a.stderr index ea92de3465..c0e2b84a80 100644 --- a/testsuite/tests/typecheck/should_fail/T14904a.stderr +++ b/testsuite/tests/typecheck/should_fail/T14904a.stderr @@ -1,5 +1,7 @@ T14904a.hs:9:6: error: • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall (a :: k1). g a • In the first argument of ‘F’, namely ‘(f :: forall a. g a)’ In the type family declaration for ‘F’ diff --git a/testsuite/tests/typecheck/should_fail/T14904b.stderr b/testsuite/tests/typecheck/should_fail/T14904b.stderr index fff6942af1..83a9ec15fa 100644 --- a/testsuite/tests/typecheck/should_fail/T14904b.stderr +++ b/testsuite/tests/typecheck/should_fail/T14904b.stderr @@ -1,6 +1,8 @@ T14904b.hs:9:7: error: • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall (a :: k1). g a • In the first argument of ‘F’, namely ‘((f :: forall a. g a) :: forall a. g a)’ In the type family declaration for ‘F’ diff --git a/testsuite/tests/typecheck/should_fail/T15330.stderr b/testsuite/tests/typecheck/should_fail/T15330.stderr index cef80452a1..c2bf2447cc 100644 --- a/testsuite/tests/typecheck/should_fail/T15330.stderr +++ b/testsuite/tests/typecheck/should_fail/T15330.stderr @@ -1,13 +1,17 @@ T15330.hs:11:6: error: - • Couldn't match expected type ‘Proxy (T 'True)’ - with actual type ‘[Char]’ + • Couldn't match type: [Char] + with: Proxy (T 'True) + Expected: Proxy (T 'True) + Actual: String • In the expression: "foo" In an equation for ‘f1’: f1 = "foo" T15330.hs:15:6: error: - • Couldn't match expected type ‘Proxy (t 'True)’ - with actual type ‘[Char]’ + • Couldn't match type: [Char] + with: Proxy (t 'True) + Expected: Proxy (t 'True) + Actual: String • In the expression: "foo" In an equation for ‘f2’: f2 = "foo" • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T15361.stderr b/testsuite/tests/typecheck/should_fail/T15361.stderr index 4b8c23ebf2..1520bc3982 100644 --- a/testsuite/tests/typecheck/should_fail/T15361.stderr +++ b/testsuite/tests/typecheck/should_fail/T15361.stderr @@ -6,6 +6,8 @@ T15361.hs:13:13: error: HRefl :: forall {k1} (a :: k1). a :~~: a, in an equation for ‘foo’ at T15361.hs:13:5-9 + Expected: a :~~: c + Actual: a :~~: a ‘a’ is a rigid type variable bound by the type signature for: foo :: forall a b c. (a :~~: b) -> a :~~: c @@ -14,8 +16,6 @@ T15361.hs:13:13: error: the type signature for: foo :: forall a b c. (a :~~: b) -> a :~~: c at T15361.hs:(11,1)-(12,27) - Expected type: a :~~: c - Actual type: a :~~: a • In the expression: HRefl In an equation for ‘foo’: foo HRefl = HRefl • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T15438.hs b/testsuite/tests/typecheck/should_fail/T15438.hs index 0f995389a0..975afa3e9e 100644 --- a/testsuite/tests/typecheck/should_fail/T15438.hs +++ b/testsuite/tests/typecheck/should_fail/T15438.hs @@ -4,5 +4,7 @@ module T15438 where class C a b +-- With simple subsumption (#17775) we +-- no longer get an ambiguity check here foo :: (forall a b. C a b => b -> b) -> Int -foo = error "urk" +foo x = error "urk" diff --git a/testsuite/tests/typecheck/should_fail/T15438.stderr b/testsuite/tests/typecheck/should_fail/T15438.stderr deleted file mode 100644 index 473d5dcc98..0000000000 --- a/testsuite/tests/typecheck/should_fail/T15438.stderr +++ /dev/null @@ -1,11 +0,0 @@ - -T15438.hs:7:8: error: - • Could not deduce (C a0 b) - from the context: C a b - bound by a type expected by the context: - forall a b. C a b => b -> b - at T15438.hs:7:8-43 - The type variable ‘a0’ is ambiguous - • In the ambiguity check for ‘foo’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: foo :: (forall a b. C a b => b -> b) -> Int diff --git a/testsuite/tests/typecheck/should_fail/T15629.stderr b/testsuite/tests/typecheck/should_fail/T15629.stderr index ac307ed9d5..09d59fdf62 100644 --- a/testsuite/tests/typecheck/should_fail/T15629.stderr +++ b/testsuite/tests/typecheck/should_fail/T15629.stderr @@ -1,39 +1,19 @@ T15629.hs:26:37: error: - • Expected kind ‘x1 ~> F x1 ab1’, - but ‘F1Sym :: x ~> F x z’ has kind ‘x1 ~> F x1 z1’ + • Couldn't match kind ‘z’ with ‘ab’ + Expected kind ‘x ~> F x ab’, + but ‘F1Sym :: x ~> F x z’ has kind ‘x ~> F x z’ + ‘z’ is a rigid type variable bound by + ‘forall z ab. + Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’ + at T15629.hs:26:17 + ‘ab’ is a rigid type variable bound by + ‘forall z ab. + Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’ + at T15629.hs:26:19-20 • In the first argument of ‘Comp’, namely ‘(F1Sym :: x ~> F x z)’ In the first argument of ‘Proxy’, namely ‘((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’ In the type signature: g :: forall z ab. Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab) - -T15629.hs:27:9: error: - • Couldn't match kind ‘z1’ with ‘ab1’ - ‘z1’ is a rigid type variable bound by - the type signature for: - g :: forall z1 ab1. Proxy (Comp F1Sym F2Sym) - at T15629.hs:26:5-84 - ‘ab1’ is a rigid type variable bound by - the type signature for: - g :: forall z1 ab1. Proxy (Comp F1Sym F2Sym) - at T15629.hs:26:5-84 - When matching types - f0 :: x ~> F x ab - F1Sym :: TyFun x1 (F x1 z1) -> * - Expected type: Proxy (Comp F1Sym F2Sym) - Actual type: Proxy (Comp f0 F2Sym) - • In the expression: sg Proxy Proxy - In an equation for ‘g’: g = sg Proxy Proxy - In an equation for ‘f’: - f _ - = () - where - g :: - forall z ab. - Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab) - g = sg Proxy Proxy - • Relevant bindings include - g :: Proxy (Comp F1Sym F2Sym) (bound at T15629.hs:27:5) - f :: Proxy x1 -> () (bound at T15629.hs:24:1) diff --git a/testsuite/tests/typecheck/should_fail/T15648.stderr b/testsuite/tests/typecheck/should_fail/T15648.stderr index 192d8d15e8..7de4bc9e18 100644 --- a/testsuite/tests/typecheck/should_fail/T15648.stderr +++ b/testsuite/tests/typecheck/should_fail/T15648.stderr @@ -1,9 +1,9 @@ T15648.hs:23:21: error: - • Couldn't match type ‘(a0 GHC.Prim.~# b0) -> JankyEquality a0 b0’ - with ‘JankyEquality a a’ - Expected type: JankyEquality a b - Actual type: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0 + • Couldn't match type: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0 + with: JankyEquality a a + Expected: JankyEquality a b + Actual: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0 • Probable cause: ‘Jank’ is applied to too few arguments In the expression: Jank In an equation for ‘legitToJank’: legitToJank Legit = Jank @@ -12,9 +12,9 @@ T15648.hs:23:21: error: (bound at T15648.hs:23:1) T15648.hs:30:10: error: - • Couldn't match expected type ‘(a GHC.Prim.~# b) - -> b GHC.Prim.~# a’ - with actual type ‘b GHC.Prim.~# a’ + • Couldn't match expected type: (a GHC.Prim.~# b) + -> b GHC.Prim.~# a + with actual type: b GHC.Prim.~# a • In the expression: unJank $ legitToJank $ mkLegit @b @a In an equation for ‘ueqSym’: ueqSym = unJank $ legitToJank $ mkLegit @b @a diff --git a/testsuite/tests/typecheck/should_fail/T15801.stderr b/testsuite/tests/typecheck/should_fail/T15801.stderr index e74972332c..2209d72ab8 100644 --- a/testsuite/tests/typecheck/should_fail/T15801.stderr +++ b/testsuite/tests/typecheck/should_fail/T15801.stderr @@ -1,6 +1,6 @@ T15801.hs:52:10: error: - • Couldn't match representation of type ‘UnOp op_a -> UnOp b’ - with that of ‘op_a --> b’ + • Couldn't match representation of type: UnOp op_a -> UnOp b + with that of: op_a --> b arising from the superclasses of an instance declaration • In the instance declaration for ‘OpRíki (Op (*))’ diff --git a/testsuite/tests/typecheck/should_fail/T16074.stderr b/testsuite/tests/typecheck/should_fail/T16074.stderr index cd04542641..10b263efcb 100644 --- a/testsuite/tests/typecheck/should_fail/T16074.stderr +++ b/testsuite/tests/typecheck/should_fail/T16074.stderr @@ -1,6 +1,8 @@ T16074.hs:10:7: error: • Couldn't match type ‘a’ with ‘b’ + Expected: TYPE a :~: TYPE b + Actual: TYPE a :~: TYPE a ‘a’ is a rigid type variable bound by the type signature for: foo :: * :~: * @@ -9,8 +11,6 @@ T16074.hs:10:7: error: the type signature for: foo :: * :~: * at T16074.hs:9:1-24 - Expected type: TYPE a :~: TYPE b - Actual type: TYPE a :~: TYPE a • In the expression: Refl In an equation for ‘foo’: foo = Refl • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T16204c.stderr b/testsuite/tests/typecheck/should_fail/T16204c.stderr index 48d63785ad..6ad532a4ea 100644 --- a/testsuite/tests/typecheck/should_fail/T16204c.stderr +++ b/testsuite/tests/typecheck/should_fail/T16204c.stderr @@ -4,8 +4,8 @@ T16204c.hs:16:8: error: When matching types a0 :: Rep a :: * - Expected type: Sing a - Actual type: Sing a0 + Expected: Sing a + Actual: Sing a0 • In the first argument of ‘id’, namely ‘sTo’ In the expression: id sTo In an equation for ‘x’: x = id sTo diff --git a/testsuite/tests/typecheck/should_fail/T16517.stderr b/testsuite/tests/typecheck/should_fail/T16517.stderr index 8d20665afc..1e17286cff 100644 --- a/testsuite/tests/typecheck/should_fail/T16517.stderr +++ b/testsuite/tests/typecheck/should_fail/T16517.stderr @@ -1,6 +1,10 @@ T16517.hs:5:29: error: • Expected kind ‘k’, but ‘a’ has kind ‘k0’ + because kind variable ‘k’ would escape its scope + This (rigid, skolem) kind variable is bound by + the class declaration for ‘C’ + at T16517.hs:5:22-35 • In the first argument of ‘Proxy’, namely ‘(a :: k)’ In the type signature: m :: Proxy (a :: k) In the class declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T17077.stderr b/testsuite/tests/typecheck/should_fail/T17077.stderr index 3d05adc3c3..3f27d19c70 100644 --- a/testsuite/tests/typecheck/should_fail/T17077.stderr +++ b/testsuite/tests/typecheck/should_fail/T17077.stderr @@ -1,5 +1,7 @@ T17077.hs:7:13: error: • Expected kind ‘forall (k :: k1). a’, but ‘z’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall (k2 :: k1). a • In the first argument of ‘Proxy’, namely ‘(z :: forall k. a)’ In the type signature: t :: Proxy (z :: forall k. a) diff --git a/testsuite/tests/typecheck/should_fail/T17775.hs b/testsuite/tests/typecheck/should_fail/T17775.hs new file mode 100644 index 0000000000..b10f0725f5 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T17775.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +module T1 where + + + +g :: Int -> Char + +g _ = 'a' + + + +f :: Int -> Show Int => () +f = g diff --git a/testsuite/tests/typecheck/should_fail/T17775.stderr b/testsuite/tests/typecheck/should_fail/T17775.stderr new file mode 100644 index 0000000000..2dc0448ab8 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T17775.stderr @@ -0,0 +1,7 @@ + +T17775.hs:15:5: error: + • Couldn't match type ‘Char’ with ‘Show Int => ()’ + Expected: Int -> Show Int => () + Actual: Int -> Char + • In the expression: g + In an equation for ‘f’: f = g diff --git a/testsuite/tests/typecheck/should_fail/T18127a.stderr b/testsuite/tests/typecheck/should_fail/T18127a.stderr index ee354f7467..60dcb3e121 100644 --- a/testsuite/tests/typecheck/should_fail/T18127a.stderr +++ b/testsuite/tests/typecheck/should_fail/T18127a.stderr @@ -1,31 +1,33 @@ T18127a.hs:5:5: error: - • Cannot instantiate unification variable ‘a1’ + • Couldn't match expected type ‘(forall a. a) -> ()’ + with actual type ‘a1’ + Cannot instantiate unification variable ‘a1’ with a type involving polytypes: (forall a. a) -> () - GHC doesn't yet support impredicative polymorphism • In the expression: undefined In an equation for ‘a’: a = undefined T18127a.hs:8:5: error: - • Cannot instantiate unification variable ‘a3’ + • Couldn't match expected type ‘(Show a => a) -> ()’ + with actual type ‘a3’ + Cannot instantiate unification variable ‘a3’ with a type involving polytypes: (Show a => a) -> () - GHC doesn't yet support impredicative polymorphism • In the expression: undefined In an equation for ‘b’: b = undefined • Relevant bindings include b :: (Show a => a) -> () (bound at T18127a.hs:8:1) T18127a.hs:12:5: error: - • Cannot instantiate unification variable ‘a0’ + • Couldn't match expected type ‘C -> ()’ with actual type ‘a0’ + Cannot instantiate unification variable ‘a0’ with a type involving polytypes: C -> () - GHC doesn't yet support impredicative polymorphism • In the expression: undefined In an equation for ‘c’: c = undefined T18127a.hs:16:5: error: - • Cannot instantiate unification variable ‘a2’ + • Couldn't match expected type ‘D a -> ()’ with actual type ‘a2’ + Cannot instantiate unification variable ‘a2’ with a type involving polytypes: D a -> () - GHC doesn't yet support impredicative polymorphism • In the expression: undefined In an equation for ‘d’: d = undefined • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T1899.stderr b/testsuite/tests/typecheck/should_fail/T1899.stderr index 9fe71027c0..eb84cba7b4 100644 --- a/testsuite/tests/typecheck/should_fail/T1899.stderr +++ b/testsuite/tests/typecheck/should_fail/T1899.stderr @@ -1,12 +1,12 @@ T1899.hs:14:36: error: • Couldn't match type ‘a’ with ‘Proposition a0’ + Expected: [Proposition a0] + Actual: [a] ‘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 - Expected type: [Proposition a0] - Actual type: [a] • In the first argument of ‘Auxiliary’, namely ‘varSet’ In the first argument of ‘Prop’, namely ‘(Auxiliary varSet)’ In the expression: Prop (Auxiliary varSet) diff --git a/testsuite/tests/typecheck/should_fail/T2414.stderr b/testsuite/tests/typecheck/should_fail/T2414.stderr index bbbf5fce6a..1d89247489 100644 --- a/testsuite/tests/typecheck/should_fail/T2414.stderr +++ b/testsuite/tests/typecheck/should_fail/T2414.stderr @@ -1,8 +1,8 @@ T2414.hs:9:13: error: - • Occurs check: cannot construct the infinite type: b0 ~ (Bool, b0) - Expected type: b0 -> Maybe (Bool, b0) - Actual type: (Bool, b0) -> Maybe (Bool, b0) + • Couldn't match type ‘b0’ with ‘(Bool, b0)’ + Expected: b0 -> Maybe (Bool, b0) + Actual: b0 -> Maybe b0 • In the first argument of ‘unfoldr’, namely ‘Just’ In the expression: unfoldr Just In an equation for ‘f’: f = unfoldr Just diff --git a/testsuite/tests/typecheck/should_fail/T2534.stderr b/testsuite/tests/typecheck/should_fail/T2534.stderr index 4e469f3cfd..24cee873c8 100644 --- a/testsuite/tests/typecheck/should_fail/T2534.stderr +++ b/testsuite/tests/typecheck/should_fail/T2534.stderr @@ -1,9 +1,9 @@ -T2534.hs:3:13: error: - • Couldn't match type ‘[b]’ with ‘a0 -> [b]’ - Expected type: [a0] -> [b] -> [b] - Actual type: [a0] -> (a0 -> [b]) -> [b] - • In the first argument of ‘foldr’, namely ‘(>>=)’ +T2534.hs:3:19: error: + • Couldn't match expected type: a -> a -> b + with actual type: [a0] + • In the second argument of ‘foldr’, namely ‘[]’ In the expression: foldr (>>=) [] [] In an equation for ‘foo’: foo = foldr (>>=) [] [] - • Relevant bindings include foo :: [b] (bound at T2534.hs:3:1) + • Relevant bindings include + foo :: a -> a -> b (bound at T2534.hs:3:1) diff --git a/testsuite/tests/typecheck/should_fail/T2714.hs b/testsuite/tests/typecheck/should_fail/T2714.hs index 52d67e38ec..7f6a12fb2c 100644 --- a/testsuite/tests/typecheck/should_fail/T2714.hs +++ b/testsuite/tests/typecheck/should_fail/T2714.hs @@ -5,7 +5,7 @@ module T2714 where f :: ((a -> b) -> b) -> (forall c. c -> a) -f = ffmap +f x = ffmap x ffmap :: Functor f => (p->q) -> f p -> f q ffmap = error "urk" diff --git a/testsuite/tests/typecheck/should_fail/T2714.stderr b/testsuite/tests/typecheck/should_fail/T2714.stderr index 9b3fc34c52..215ad495cf 100644 --- a/testsuite/tests/typecheck/should_fail/T2714.stderr +++ b/testsuite/tests/typecheck/should_fail/T2714.stderr @@ -1,13 +1,14 @@ -T2714.hs:8:5: error: +T2714.hs:8:7: error: • Couldn't match type ‘c’ with ‘f0 (a -> b)’ + Expected: c -> a + Actual: f0 (a -> b) -> f0 b ‘c’ is a rigid type variable bound by - the type signature for: - f :: ((a -> b) -> b) -> forall c. c -> a - at T2714.hs:8:1-9 - Expected type: ((a -> b) -> b) -> c -> a - Actual type: ((a -> b) -> b) -> f0 (a -> b) -> f0 b - • In the expression: ffmap - In an equation for ‘f’: f = ffmap + a type expected by the context: + forall c. c -> a + at T2714.hs:8:1-13 + • In the expression: ffmap x + In an equation for ‘f’: f x = ffmap x • Relevant bindings include + x :: (a -> b) -> b (bound at T2714.hs:8:3) f :: ((a -> b) -> b) -> forall c. c -> a (bound at T2714.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/T3102.hs b/testsuite/tests/typecheck/should_fail/T3102.hs index 910ac06ee9..f7d9dad344 100644 --- a/testsuite/tests/typecheck/should_fail/T3102.hs +++ b/testsuite/tests/typecheck/should_fail/T3102.hs @@ -8,8 +8,8 @@ f :: (forall a. a -> String) -> Int f _ = 3 result :: Int -result = f t - +result = f (\x -> t x) + -- Simple subsumption (#17775) requires eta expansion here -- This should work. -- Elaborated result = f (/\a. \x:a. t @a (\p::Int. x)) diff --git a/testsuite/tests/typecheck/should_fail/T3406.stderr b/testsuite/tests/typecheck/should_fail/T3406.stderr index 69834d15f6..70fffee3ac 100644 --- a/testsuite/tests/typecheck/should_fail/T3406.stderr +++ b/testsuite/tests/typecheck/should_fail/T3406.stderr @@ -1,8 +1,8 @@ T3406.hs:11:28: error: • Couldn't match type ‘Int’ with ‘a -> ItemColID a b’ - Expected type: a -> ItemColID a b - Actual type: ItemColID a1 b1 + Expected: a -> ItemColID a b + Actual: ItemColID a1 b1 • In the expression: x :: ItemColID a b In an equation for ‘get’: get (x :: ItemColID a b) = x :: ItemColID a b diff --git a/testsuite/tests/typecheck/should_fail/T3592.stderr b/testsuite/tests/typecheck/should_fail/T3592.stderr index ab03985faa..bc3f774ecc 100644 --- a/testsuite/tests/typecheck/should_fail/T3592.stderr +++ b/testsuite/tests/typecheck/should_fail/T3592.stderr @@ -1,12 +1,14 @@ T3592.hs:8:5: error: - • No instance for (Show a) arising from a use of ‘show’ - Possible fix: - add (Show a) to the context of - the type signature for: - f :: forall a. T a -> String + • Couldn't match type ‘a0’ with ‘T a’ + Expected: T a -> String + Actual: a0 -> String + Cannot instantiate unification variable ‘a0’ + with a type involving polytypes: T a • In the expression: show In an equation for ‘f’: f = show + • Relevant bindings include + f :: T a -> String (bound at T3592.hs:8:1) T3592.hs:11:7: error: • No instance for (Show a) arising from a use of ‘show’ diff --git a/testsuite/tests/typecheck/should_fail/T3613.stderr b/testsuite/tests/typecheck/should_fail/T3613.stderr index a221a95c17..8183ff981e 100644 --- a/testsuite/tests/typecheck/should_fail/T3613.stderr +++ b/testsuite/tests/typecheck/should_fail/T3613.stderr @@ -1,8 +1,8 @@ T3613.hs:14:20: error: • Couldn't match type ‘IO’ with ‘Maybe’ - Expected type: Maybe b - Actual type: IO b + Expected: Maybe b + Actual: IO b • In the first argument of ‘fooThen’, namely ‘(bar >> undefined)’ In the expression: fooThen (bar >> undefined) In the expression: @@ -10,8 +10,8 @@ T3613.hs:14:20: error: T3613.hs:17:24: error: • Couldn't match type ‘IO’ with ‘Maybe’ - Expected type: Maybe () - Actual type: IO () + Expected: Maybe () + Actual: IO () • In a stmt of a 'do' block: bar In the first argument of ‘fooThen’, namely ‘(do bar diff --git a/testsuite/tests/typecheck/should_fail/T3950.stderr b/testsuite/tests/typecheck/should_fail/T3950.stderr index e0a3526000..f71fd5d501 100644 --- a/testsuite/tests/typecheck/should_fail/T3950.stderr +++ b/testsuite/tests/typecheck/should_fail/T3950.stderr @@ -4,8 +4,8 @@ T3950.hs:15:8: error: When matching types w :: (* -> * -> *) -> * Sealed :: (* -> *) -> * - Expected type: Maybe (w (Id p)) - Actual type: Maybe (Sealed (Id p0 x0)) + Expected: Maybe (w (Id p)) + Actual: Maybe (Sealed (Id p0 x0)) • In the expression: Just rp' In an equation for ‘rp’: rp _ diff --git a/testsuite/tests/typecheck/should_fail/T502.stderr b/testsuite/tests/typecheck/should_fail/T502.stderr index ba5f6d157a..dd6b97d132 100644 --- a/testsuite/tests/typecheck/should_fail/T502.stderr +++ b/testsuite/tests/typecheck/should_fail/T502.stderr @@ -1,7 +1,7 @@ T502.hs:8:11: error: - • Couldn't match expected type ‘(a0, Int)’ - with actual type ‘(# Int, Int #)’ + • Couldn't match expected type: (a0, Int) + with actual type: (# Int, Int #) • In the first argument of ‘snd’, namely ‘foo’ In the expression: snd foo In an equation for ‘bar’: diff --git a/testsuite/tests/typecheck/should_fail/T5246.stderr b/testsuite/tests/typecheck/should_fail/T5246.stderr index 54d340cc5e..ea4185af33 100644 --- a/testsuite/tests/typecheck/should_fail/T5246.stderr +++ b/testsuite/tests/typecheck/should_fail/T5246.stderr @@ -1,11 +1,10 @@ T5246.hs:11:10: error: - Couldn't match type ‘[Char]’ with ‘Int’ - arising from a functional dependency between constraints: - ‘?x::Int’ arising from a use of ‘foo’ at T5246.hs:11:10-12 - ‘?x::[Char]’ - arising from the implicit-parameter binding for ?x - at T5246.hs:(10,7)-(11,12) - In the expression: foo - In the expression: let ?x = "hello" in foo - In an equation for ‘bar’: bar = let ?x = "hello" in foo + • Couldn't match type ‘[Char]’ with ‘Int’ + arising from a functional dependency between constraints: + ‘?x::Int’ arising from a use of ‘foo’ at T5246.hs:11:10-12 + ‘?x::String’ + arising from the implicit-parameter binding for ?x at T5246.hs:(10,7)-(11,12) + • In the expression: foo + In the expression: let ?x = "hello" in foo + In an equation for ‘bar’: bar = let ?x = "hello" in foo diff --git a/testsuite/tests/typecheck/should_fail/T6001.stderr b/testsuite/tests/typecheck/should_fail/T6001.stderr index 57d55dc336..a7a8274923 100644 --- a/testsuite/tests/typecheck/should_fail/T6001.stderr +++ b/testsuite/tests/typecheck/should_fail/T6001.stderr @@ -1,10 +1,10 @@ -T6001.hs:8:18: - Couldn't match type ‘Integer’ with ‘Int’ - Expected type: Integer -> DayKind - Actual type: Int -> DayKind - When checking that instance signature for ‘fromInteger’ - is more general than its signature in the class - Instance sig: Int -> DayKind - Class sig: Integer -> DayKind - In the instance declaration for ‘Num DayKind’ +T6001.hs:8:18: error: + • Couldn't match type ‘Int’ with ‘Integer’ + Expected: Integer -> DayKind + Actual: Int -> DayKind + • When checking that instance signature for ‘fromInteger’ + is more general than its signature in the class + Instance sig: Int -> DayKind + Class sig: Integer -> DayKind + In the instance declaration for ‘Num DayKind’ diff --git a/testsuite/tests/typecheck/should_fail/T6069.stderr b/testsuite/tests/typecheck/should_fail/T6069.stderr index e2d3ef4d91..c70939fee5 100644 --- a/testsuite/tests/typecheck/should_fail/T6069.stderr +++ b/testsuite/tests/typecheck/should_fail/T6069.stderr @@ -1,24 +1,27 @@ T6069.hs:13:15: error: - • Couldn't match type ‘ST s0 Int’ with ‘forall s. ST s a0’ - Expected type: ST s0 Int -> a0 - Actual type: (forall s. ST s a0) -> a0 + • Couldn't match type: forall s. ST s b0 + with: ST s0 Int + Expected: ST s0 Int -> b0 + Actual: (forall s. ST s b0) -> b0 • In the second argument of ‘(.)’, namely ‘runST’ In the expression: print . runST In the expression: (print . runST) fourty_two T6069.hs:14:15: error: - • Couldn't match type ‘ST s1 Int’ with ‘forall s. ST s a1’ - Expected type: ST s1 Int -> a1 - Actual type: (forall s. ST s a1) -> a1 + • Couldn't match type: forall s. ST s b1 + with: ST s1 Int + Expected: ST s1 Int -> b1 + Actual: (forall s. ST s b1) -> b1 • In the second argument of ‘(.)’, namely ‘runST’ In the first argument of ‘($)’, namely ‘(print . runST)’ In the expression: (print . runST) $ fourty_two T6069.hs:15:16: error: - • Couldn't match type ‘ST s2 Int’ with ‘forall s. ST s a2’ - Expected type: ST s2 Int -> a2 - Actual type: (forall s. ST s a2) -> a2 + • Couldn't match type: forall s. ST s b2 + with: ST s2 Int + Expected: ST s2 Int -> b2 + Actual: (forall s. ST s b2) -> b2 • In the second argument of ‘(.)’, namely ‘runST’ In the first argument of ‘($)’, namely ‘(print . runST)’ In the expression: (print . runST) $ diff --git a/testsuite/tests/typecheck/should_fail/T7264.stderr b/testsuite/tests/typecheck/should_fail/T7264.stderr index 71c99c5614..4d2a153306 100644 --- a/testsuite/tests/typecheck/should_fail/T7264.stderr +++ b/testsuite/tests/typecheck/should_fail/T7264.stderr @@ -1,10 +1,11 @@ T7264.hs:13:19: error: • Couldn't match type ‘a’ with ‘forall r. r -> String’ + Expected: a -> Foo + Actual: (forall r. r -> String) -> Foo ‘a’ is a rigid type variable bound by - the inferred type of mkFoo2 :: a -> Maybe Foo at T7264.hs:13:1-32 - Expected type: a -> Foo - Actual type: (forall r. r -> String) -> Foo + the inferred type of mkFoo2 :: a -> Maybe Foo + at T7264.hs:13:1-32 • In the first argument of ‘mmap’, namely ‘Foo’ In the expression: mmap Foo (Just val) In an equation for ‘mkFoo2’: mkFoo2 val = mmap Foo (Just val) diff --git a/testsuite/tests/typecheck/should_fail/T7368.stderr b/testsuite/tests/typecheck/should_fail/T7368.stderr index 54c12f76f7..ef100b1fa4 100644 --- a/testsuite/tests/typecheck/should_fail/T7368.stderr +++ b/testsuite/tests/typecheck/should_fail/T7368.stderr @@ -4,8 +4,8 @@ T7368.hs:3:10: error: When matching types b0 :: * Maybe :: * -> * - Expected type: a0 -> b0 - Actual type: c0 Maybe + Expected: a0 -> b0 + Actual: c0 Maybe • In the first argument of ‘b’, namely ‘(l Nothing)’ In the expression: b (l Nothing) In an equation for ‘f’: f = b (l Nothing) diff --git a/testsuite/tests/typecheck/should_fail/T7368a.stderr b/testsuite/tests/typecheck/should_fail/T7368a.stderr index 93b8b04378..2fcb92f209 100644 --- a/testsuite/tests/typecheck/should_fail/T7368a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7368a.stderr @@ -4,8 +4,8 @@ T7368a.hs:8:6: error: When matching types f :: * -> * Bad :: (* -> *) -> * - Expected type: f (Bad f) - Actual type: Bad w0 + Expected: f (Bad f) + Actual: Bad w0 • In the pattern: Bad x In an equation for ‘fun’: fun (Bad x) = True • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T7696.stderr b/testsuite/tests/typecheck/should_fail/T7696.stderr index 41f2296797..945312094d 100644 --- a/testsuite/tests/typecheck/should_fail/T7696.stderr +++ b/testsuite/tests/typecheck/should_fail/T7696.stderr @@ -1,7 +1,7 @@ T7696.hs:7:6: error: • Couldn't match type ‘m0 a0’ with ‘()’ - Expected type: ((), w ()) - Actual type: (m0 a0, t0 m0) + Expected: ((), w ()) + Actual: (m0 a0, t0 m0) • In the expression: f1 In an equation for ‘f2’: f2 = f1 diff --git a/testsuite/tests/typecheck/should_fail/T7734.stderr b/testsuite/tests/typecheck/should_fail/T7734.stderr index 05002109ab..bf199cb4c2 100644 --- a/testsuite/tests/typecheck/should_fail/T7734.stderr +++ b/testsuite/tests/typecheck/should_fail/T7734.stderr @@ -1,6 +1,6 @@ T7734.hs:4:13: error: - • Occurs check: cannot construct the infinite type: t ~ t -> t1 + • Couldn't match expected type ‘t’ with actual type ‘t -> t1’ • In the first argument of ‘x’, namely ‘x’ In the expression: x x In an equation for ‘f’: x `f` y = x x @@ -9,7 +9,7 @@ T7734.hs:4:13: error: f :: (t -> t1) -> p -> t1 (bound at T7734.hs:4:3) T7734.hs:5:13: error: - • Occurs check: cannot construct the infinite type: t ~ t -> t1 + • Couldn't match expected type ‘t’ with actual type ‘t -> t1’ • In the first argument of ‘x’, namely ‘x’ In the expression: x x In an equation for ‘&’: (&) x y = x x diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr index 0e1964e35c..289df8ad40 100644 --- a/testsuite/tests/typecheck/should_fail/T7851.stderr +++ b/testsuite/tests/typecheck/should_fail/T7851.stderr @@ -1,7 +1,7 @@ T7851.hs:5:10: error: - • Couldn't match expected type ‘IO a0’ - with actual type ‘a1 -> IO ()’ + • Couldn't match expected type: IO a0 + with actual type: a1 -> IO () • Probable cause: ‘print’ is applied to too few arguments In a stmt of a 'do' block: print In the expression: diff --git a/testsuite/tests/typecheck/should_fail/T7856.stderr b/testsuite/tests/typecheck/should_fail/T7856.stderr index e6fe2bd42f..a5a3a4bff1 100644 --- a/testsuite/tests/typecheck/should_fail/T7856.stderr +++ b/testsuite/tests/typecheck/should_fail/T7856.stderr @@ -1,11 +1,11 @@ -T7856.hs:4:7: - Couldn't match expected type ‘String -> IO ()’ - with actual type ‘IO ()’ - Possible cause: ‘sequence_’ is applied to too many arguments - In the expression: sequence_ lst - In an equation for ‘tmp’: - tmp - = sequence_ lst - where - lst = [putStrLn "hi"] +T7856.hs:4:7: error: + • Couldn't match expected type: String -> IO () + with actual type: IO () + • Possible cause: ‘sequence_’ is applied to too many arguments + In the expression: sequence_ lst + In an equation for ‘tmp’: + tmp + = sequence_ lst + where + lst = [putStrLn "hi"] diff --git a/testsuite/tests/typecheck/should_fail/T7869.stderr b/testsuite/tests/typecheck/should_fail/T7869.stderr index 7e01868526..15e9cc4658 100644 --- a/testsuite/tests/typecheck/should_fail/T7869.stderr +++ b/testsuite/tests/typecheck/should_fail/T7869.stderr @@ -1,6 +1,8 @@ T7869.hs:3:12: error: • Couldn't match type ‘b1’ with ‘b’ + Expected: [a1] -> b1 + Actual: [a] -> b ‘b1’ is a rigid type variable bound by an expression type signature: forall a1 b1. [a1] -> b1 @@ -8,8 +10,6 @@ T7869.hs:3:12: error: ‘b’ is a rigid type variable bound by the inferred type of f :: [a] -> b at T7869.hs:3:1-27 - Expected type: [a1] -> b1 - Actual type: [a] -> b • In the expression: f x In the expression: (\ x -> f x) :: [a] -> b In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b diff --git a/testsuite/tests/typecheck/should_fail/T8030.stderr b/testsuite/tests/typecheck/should_fail/T8030.stderr index c1ff38b685..623eabbdbc 100644 --- a/testsuite/tests/typecheck/should_fail/T8030.stderr +++ b/testsuite/tests/typecheck/should_fail/T8030.stderr @@ -1,6 +1,7 @@ T8030.hs:9:3: error: - • Couldn't match expected type ‘Pr a’ with actual type ‘Pr a0’ + • Couldn't match expected type: Pr a + with actual type: Pr a0 NB: ‘Pr’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘op1’ @@ -10,9 +11,10 @@ T8030.hs:9:3: error: In the class declaration for ‘C’ T8030.hs:10:3: error: - • Couldn't match type ‘Pr a0’ with ‘Pr a’ - Expected type: Pr a -> Pr a -> Pr a - Actual type: Pr a0 -> Pr a0 -> Pr a0 + • Couldn't match type: Pr a0 + with: Pr a + Expected: Pr a -> Pr a -> Pr a + Actual: Pr a0 -> Pr a0 -> Pr a0 NB: ‘Pr’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘op2’ diff --git a/testsuite/tests/typecheck/should_fail/T8034.stderr b/testsuite/tests/typecheck/should_fail/T8034.stderr index cce73f355a..8f64538554 100644 --- a/testsuite/tests/typecheck/should_fail/T8034.stderr +++ b/testsuite/tests/typecheck/should_fail/T8034.stderr @@ -1,8 +1,9 @@ T8034.hs:6:3: error: - • Couldn't match type ‘F a0’ with ‘F a’ - Expected type: F a -> F a - Actual type: F a0 -> F a0 + • Couldn't match type: F a0 + with: F a + Expected: F a -> F a + Actual: F a0 -> F a0 NB: ‘F’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘foo’ diff --git a/testsuite/tests/typecheck/should_fail/T8044.stderr b/testsuite/tests/typecheck/should_fail/T8044.stderr index 78ef035af8..2069f5f281 100644 --- a/testsuite/tests/typecheck/should_fail/T8044.stderr +++ b/testsuite/tests/typecheck/should_fail/T8044.stderr @@ -1,9 +1,9 @@ -T8044.hs:16:13: - Couldn't match type ‘Frob a’ with ‘Char’ - Expected type: X (Frob a) - Actual type: X Char - In the expression: XChar - In an equation for ‘frob’: frob _ = XChar - Relevant bindings include - frob :: X a -> X (Frob a) (bound at T8044.hs:15:1) +T8044.hs:16:13: error: + • Couldn't match type ‘Frob a’ with ‘Char’ + Expected: X (Frob a) + Actual: X Char + • In the expression: XChar + In an equation for ‘frob’: frob _ = XChar + • Relevant bindings include + frob :: X a -> X (Frob a) (bound at T8044.hs:15:1) diff --git a/testsuite/tests/typecheck/should_fail/T8142.stderr b/testsuite/tests/typecheck/should_fail/T8142.stderr index 25d60d1aff..a9f4590e44 100644 --- a/testsuite/tests/typecheck/should_fail/T8142.stderr +++ b/testsuite/tests/typecheck/should_fail/T8142.stderr @@ -1,8 +1,9 @@ T8142.hs:6:10: error: - • Couldn't match type ‘Nu ((,) a0)’ with ‘c -> f c’ - Expected type: (c -> f c) -> c -> f c - Actual type: Nu ((,) a0) -> Nu g0 + • Couldn't match type: Nu ((,) a0) + with: c -> f c + Expected: (c -> f c) -> c -> f c + Actual: Nu ((,) a0) -> Nu f0 The type variable ‘a0’ is ambiguous • In the expression: h In an equation for ‘tracer’: @@ -14,11 +15,12 @@ T8142.hs:6:10: error: tracer :: (c -> f c) -> c -> f c (bound at T8142.hs:6:1) T8142.hs:6:57: error: - • Couldn't match type ‘Nu ((,) a)’ with ‘g (Nu ((,) a))’ - Expected type: Nu ((,) a) -> (a, g (Nu ((,) a))) - Actual type: Nu ((,) a) -> (a, Nu ((,) a)) + • Couldn't match type: Nu ((,) a) + with: f1 (Nu ((,) a)) + Expected: Nu ((,) a) -> (a, f1 (Nu ((,) a))) + Actual: Nu ((,) a) -> (a, Nu ((,) a)) • In the second argument of ‘(.)’, namely ‘out’ In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out In an equation for ‘h’: h = (\ (_, b) -> ((outI . fmap h) b)) . out • Relevant bindings include - h :: Nu ((,) a) -> Nu g (bound at T8142.hs:6:18) + h :: Nu ((,) a) -> Nu f1 (bound at T8142.hs:6:18) diff --git a/testsuite/tests/typecheck/should_fail/T8428.stderr b/testsuite/tests/typecheck/should_fail/T8428.stderr index ce83c3efe5..2668bb45fd 100644 --- a/testsuite/tests/typecheck/should_fail/T8428.stderr +++ b/testsuite/tests/typecheck/should_fail/T8428.stderr @@ -1,8 +1,9 @@ T8428.hs:11:19: error: - • Couldn't match type ‘(forall s. ST s) a’ with ‘forall s. ST s a’ - Expected type: IdentityT (forall s. ST s) a -> forall s. ST s a - Actual type: IdentityT (forall s. ST s) a -> (forall s. ST s) a + • Couldn't match type: (forall s. ST s) a + with: forall s. ST s a + Expected: IdentityT (forall s. ST s) a -> forall s. ST s a + Actual: IdentityT (forall s. ST s) a -> (forall s. ST s) a • In the second argument of ‘(.)’, namely ‘runIdentityT’ In the expression: runST . runIdentityT In an equation for ‘runIdST’: runIdST = runST . runIdentityT diff --git a/testsuite/tests/typecheck/should_fail/T8450.stderr b/testsuite/tests/typecheck/should_fail/T8450.stderr index 7503f4d37e..a75d0703c6 100644 --- a/testsuite/tests/typecheck/should_fail/T8450.stderr +++ b/testsuite/tests/typecheck/should_fail/T8450.stderr @@ -1,12 +1,12 @@ T8450.hs:8:20: error: • Couldn't match type ‘a’ with ‘Bool’ + Expected: Either Bool () + Actual: Either a () ‘a’ is a rigid type variable bound by the type signature for: run :: forall a. a at T8450.hs:7:1-18 - Expected type: Either Bool () - Actual type: Either a () • In the second argument of ‘($)’, namely ‘(undefined :: Either a ())’ In the expression: runEffect $ (undefined :: Either a ()) diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr index 29c5d9df12..4776253f52 100644 --- a/testsuite/tests/typecheck/should_fail/T8603.stderr +++ b/testsuite/tests/typecheck/should_fail/T8603.stderr @@ -1,8 +1,9 @@ T8603.hs:33:17: error: - • Couldn't match type ‘RV a1’ with ‘StateT s RV a0’ - Expected type: [a2] -> StateT s RV a0 - Actual type: t0 ((->) [a1]) (RV a1) + • Couldn't match type: RV a1 + with: StateT s RV a0 + Expected: [a2] -> StateT s RV a0 + Actual: t0 ((->) [a1]) (RV a1) • The function ‘lift’ is applied to two value arguments, but its type ‘([a1] -> RV a1) -> t0 ((->) [a1]) (RV a1)’ has only one diff --git a/testsuite/tests/typecheck/should_fail/T9201.stderr b/testsuite/tests/typecheck/should_fail/T9201.stderr index 5e8f0173c5..16a183bef0 100644 --- a/testsuite/tests/typecheck/should_fail/T9201.stderr +++ b/testsuite/tests/typecheck/should_fail/T9201.stderr @@ -1,6 +1,12 @@ T9201.hs:6:17: error: • Expected kind ‘x’, but ‘a’ has kind ‘y’ + ‘y’ is a rigid type variable bound by + the class declaration for ‘MonoidalCCC’ + at T9201.hs:5:30 + ‘x’ is a rigid type variable bound by + the class declaration for ‘MonoidalCCC’ + at T9201.hs:5:25 • In the first argument of ‘f’, namely ‘a’ In the second argument of ‘d’, namely ‘(f a)’ In the type signature: ret :: d a (f a) diff --git a/testsuite/tests/typecheck/should_fail/T9260.stderr b/testsuite/tests/typecheck/should_fail/T9260.stderr index f55f474904..2a6c0ac16c 100644 --- a/testsuite/tests/typecheck/should_fail/T9260.stderr +++ b/testsuite/tests/typecheck/should_fail/T9260.stderr @@ -1,8 +1,8 @@ T9260.hs:12:14: error: • Couldn't match type ‘1’ with ‘0’ - Expected type: Fin 0 - Actual type: Fin (0 + 1) + 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/T9318.stderr b/testsuite/tests/typecheck/should_fail/T9318.stderr index c637788a7e..0a87c4a1e2 100644 --- a/testsuite/tests/typecheck/should_fail/T9318.stderr +++ b/testsuite/tests/typecheck/should_fail/T9318.stderr @@ -1,7 +1,7 @@ T9318.hs:12:5: error: • Couldn't match type ‘Bool’ with ‘Char’ - Expected type: F Int - Actual type: Char + Expected: F Int + Actual: Char • In the pattern: 'x' In an equation for ‘bar’: bar 'x' = () diff --git a/testsuite/tests/typecheck/should_fail/T9605.stderr b/testsuite/tests/typecheck/should_fail/T9605.stderr index 683265c26b..6132c9538e 100644 --- a/testsuite/tests/typecheck/should_fail/T9605.stderr +++ b/testsuite/tests/typecheck/should_fail/T9605.stderr @@ -1,8 +1,8 @@ T9605.hs:7:6: error: • Couldn't match type ‘Bool’ with ‘m Bool’ - Expected type: t0 -> m Bool - Actual type: t0 -> Bool + Expected: t0 -> m Bool + Actual: t0 -> Bool • In the result of a function call In the expression: f1 undefined In an equation for ‘f2’: f2 = f1 undefined diff --git a/testsuite/tests/typecheck/should_fail/T9612.stderr b/testsuite/tests/typecheck/should_fail/T9612.stderr index 462edc3e2d..26cea79487 100644 --- a/testsuite/tests/typecheck/should_fail/T9612.stderr +++ b/testsuite/tests/typecheck/should_fail/T9612.stderr @@ -1,20 +1,21 @@ T9612.hs:16:9: error: - Couldn't match type ‘[(Int, a)]’ with ‘(Int, a)’ - arising from a functional dependency between: - constraint ‘MonadWriter (Int, a) (WriterT [(Int, a)] Identity)’ - arising from a use of ‘tell’ - instance ‘MonadWriter w (WriterT w m)’ at T9612.hs:20:10-59 - In a stmt of a 'do' block: tell (n, x) - In the expression: - do tell (n, x) - return (1, y) - In an equation for ‘f’: - f y (n, x) - = do tell (n, x) - return (1, y) - Relevant bindings include - x :: a (bound at T9612.hs:14:8) - y :: a (bound at T9612.hs:14:3) - f :: a -> (Int, a) -> Writer [(Int, a)] (Int, a) - (bound at T9612.hs:14:1) + • Couldn't match type: [(Int, a)] + with: (Int, a) + arising from a functional dependency between: + constraint ‘MonadWriter (Int, a) (WriterT [(Int, a)] Identity)’ + arising from a use of ‘tell’ + instance ‘MonadWriter w (WriterT w m)’ at T9612.hs:20:10-59 + • In a stmt of a 'do' block: tell (n, x) + In the expression: + do tell (n, x) + return (1, y) + In an equation for ‘f’: + f y (n, x) + = do tell (n, x) + return (1, y) + • Relevant bindings include + x :: a (bound at T9612.hs:14:8) + y :: a (bound at T9612.hs:14:3) + f :: a -> (Int, a) -> Writer [(Int, a)] (Int, a) + (bound at T9612.hs:14:1) diff --git a/testsuite/tests/typecheck/should_fail/T9774.stderr b/testsuite/tests/typecheck/should_fail/T9774.stderr index 28b1b58c4c..da75c339b8 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: • Couldn't match type ‘Char’ with ‘[Char]’ - Expected type: String - Actual type: Char + Expected: String + Actual: Char • 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/T9858e.stderr b/testsuite/tests/typecheck/should_fail/T9858e.stderr index 04e08000ca..f397723a02 100644 --- a/testsuite/tests/typecheck/should_fail/T9858e.stderr +++ b/testsuite/tests/typecheck/should_fail/T9858e.stderr @@ -1,9 +1,10 @@ T9858e.hs:9:8: error: - Couldn't match type ‘Eq Int => Int’ with ‘a0 b0’ - Expected type: Proxy (a0 b0) - Actual type: Proxy (Eq Int => Int) - In the first argument of ‘i’, namely - ‘(Proxy :: Proxy (Eq Int => Int))’ - In the expression: i (Proxy :: Proxy (Eq Int => Int)) - In an equation for ‘j’: j = i (Proxy :: Proxy (Eq Int => Int)) + • Couldn't match type: Eq Int => Int + with: a0 b0 + Expected: Proxy (a0 b0) + Actual: Proxy (Eq Int => Int) + • In the first argument of ‘i’, namely + ‘(Proxy :: Proxy (Eq Int => Int))’ + In the expression: i (Proxy :: Proxy (Eq Int => Int)) + In an equation for ‘j’: j = i (Proxy :: Proxy (Eq Int => Int)) diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr index f4e1d02eee..4370b606ca 100644 --- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr +++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr @@ -7,8 +7,8 @@ TcCoercibleFail.hs:11:8: error: In an equation for ‘foo1’: foo1 = coerce $ one :: () TcCoercibleFail.hs:14:8: error: - • Couldn't match representation of type ‘m Int’ - with that of ‘m Age’ + • Couldn't match representation of type: m Int + with that of: m Age arising from a use of ‘coerce’ NB: We cannot know what roles the parameters to ‘m’ have; we must assume that the role is nominal diff --git a/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr b/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr index 70ac94f060..487cfee88f 100644 --- a/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr +++ b/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr @@ -1,16 +1,28 @@ -TcMultiWayIfFail.hs:6:24: - Couldn't match expected type ‘Int’ with actual type ‘[Char]’ - In the expression: "2" - In the expression: - if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int] - In an equation for ‘x1’: - x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int] +TcMultiWayIfFail.hs:6:24: error: + • Couldn't match type ‘[Char]’ with ‘Int’ + Expected: Int + Actual: String + • In the expression: "2" + In the expression: + if | True -> 1 :: Int + | False -> "2" + | otherwise -> [3 :: Int] + In an equation for ‘x1’: + x1 + = if | True -> 1 :: Int + | False -> "2" + | otherwise -> [3 :: Int] -TcMultiWayIfFail.hs:7:24: - Couldn't match expected type ‘Int’ with actual type ‘[Int]’ - In the expression: [3 :: Int] - In the expression: - if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int] - In an equation for ‘x1’: - x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int] +TcMultiWayIfFail.hs:7:24: error: + • Couldn't match expected type ‘Int’ with actual type ‘[Int]’ + • In the expression: [3 :: Int] + In the expression: + if | True -> 1 :: Int + | False -> "2" + | otherwise -> [3 :: Int] + In an equation for ‘x1’: + x1 + = if | True -> 1 :: Int + | False -> "2" + | otherwise -> [3 :: Int] diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr index bf50beed5e..9725a779e7 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr @@ -1,7 +1,10 @@ UnliftedNewtypesInfinite.hs:9:20: error: - • Occurs check: cannot construct the infinite kind: - t0 ~ 'GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0] + • Couldn't match kind ‘t0’ + with ‘'GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0]’ + Expected kind ‘TYPE t0’, + but ‘(# Int#, Foo #)’ has kind ‘TYPE + ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0])’ • In the type ‘(# Int#, Foo #)’ In the definition of data constructor ‘FooC’ In the newtype declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr index 3fb2814dab..0a49414c33 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr @@ -1,5 +1,7 @@ -UnliftedNewtypesInstanceFail.hs:13:3: - Expected kind ‘TYPE 'WordRep’, + +UnliftedNewtypesInstanceFail.hs:13:3: error: + • Couldn't match kind ‘'IntRep’ with ‘'WordRep’ + Expected kind ‘TYPE 'WordRep’, but ‘Bar Bool’ has kind ‘TYPE 'IntRep’ - In the newtype instance declaration for ‘Bar’ + • In the newtype instance declaration for ‘Bar’ In the instance declaration for ‘Foo Bool’ diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr index c8386e663f..f30d8b8fe8 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr @@ -1,7 +1,7 @@ UnliftedNewtypesMismatchedKindRecord.hs:11:23: error: - • Expected kind ‘TYPE 'IntRep’, - but ‘Word#’ has kind ‘TYPE 'WordRep’ + • Couldn't match kind ‘'WordRep’ with ‘'IntRep’ + Expected kind ‘TYPE 'IntRep’, but ‘Word#’ has kind ‘TYPE 'WordRep’ • In the type ‘Word#’ In the definition of data constructor ‘FooC’ In the newtype declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.hs b/testsuite/tests/typecheck/should_fail/VtaFail.hs index 250f9e273e..42e584ce0a 100644 --- a/testsuite/tests/typecheck/should_fail/VtaFail.hs +++ b/testsuite/tests/typecheck/should_fail/VtaFail.hs @@ -14,7 +14,9 @@ answer_constraint_fail = addOne @Bool 5 answer_lambda = (\x -> x) @Int 12 pair :: forall a. a -> forall b. b -> (a, b) -pair = (,) +pair x = (,) x +-- Without this eta-expansion, the two have +-- different types under simple subsumption (#17775) a = pair 3 @Int @Bool True diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.stderr b/testsuite/tests/typecheck/should_fail/VtaFail.stderr index a9958016ce..87a2bea3fe 100644 --- a/testsuite/tests/typecheck/should_fail/VtaFail.stderr +++ b/testsuite/tests/typecheck/should_fail/VtaFail.stderr @@ -13,66 +13,67 @@ VtaFail.hs:14:17: error: In an equation for ‘answer_lambda’: answer_lambda = (\ x -> x) @Int 12 -VtaFail.hs:19:5: error: +VtaFail.hs:21:5: error: • Cannot apply expression of type ‘Int -> (a0, Int)’ to a visible type argument ‘Bool’ • In the expression: pair 3 @Int @Bool True In an equation for ‘a’: a = pair 3 @Int @Bool True -VtaFail.hs:26:15: error: +VtaFail.hs:28:15: error: • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ • In the type ‘Int’ In the expression: first @Int F In an equation for ‘fInt’: fInt = first @Int F -VtaFail.hs:33:18: error: +VtaFail.hs:35:18: error: • Couldn't match type ‘Int’ with ‘Bool’ - Expected type: Proxy Bool - Actual type: Proxy Int + Expected: Proxy Bool + Actual: Proxy Int • In the second argument of ‘foo’, namely ‘(P :: Proxy Int)’ In the expression: foo @Bool (P :: Proxy Int) In an equation for ‘baz’: baz = foo @Bool (P :: Proxy Int) -VtaFail.hs:40:17: error: - • Expected kind ‘* -> k0 -> *’, but ‘Maybe’ has kind ‘* -> *’ +VtaFail.hs:42:17: error: + • Couldn't match kind ‘*’ with ‘k0 -> *’ + Expected kind ‘* -> k0 -> *’, but ‘Maybe’ has kind ‘* -> *’ • In the type ‘Maybe’ In the expression: too @Maybe T In an equation for ‘threeBad’: threeBad = too @Maybe T -VtaFail.hs:41:27: error: +VtaFail.hs:43:27: error: • Couldn't match type ‘Either’ with ‘(->)’ - Expected type: Three (->) - Actual type: Three Either + Expected: Three (->) + Actual: Three Either • In the second argument of ‘too’, namely ‘(T :: Three Either)’ In the expression: too @(->) (T :: Three Either) In an equation for ‘threeWorse’: threeWorse = too @(->) (T :: Three Either) -VtaFail.hs:46:5: error: +VtaFail.hs:48:5: error: • Cannot apply expression of type ‘Int -> Int -> Int’ to a visible type argument ‘Int’ • In the expression: plus @Int 5 7 In an equation for ‘b’: b = plus @Int 5 7 -VtaFail.hs:47:5: error: +VtaFail.hs:49:5: error: • Cannot apply expression of type ‘Int -> Int -> Int’ to a visible type argument ‘Rational’ • In the expression: plus @Rational 5 10 In an equation for ‘c’: c = plus @Rational 5 10 -VtaFail.hs:48:5: error: +VtaFail.hs:50:5: error: • Cannot apply expression of type ‘Int -> Int -> Int’ to a visible type argument ‘Int’ • In the expression: (+) @Int @Int @Int 12 14 In an equation for ‘d’: d = (+) @Int @Int @Int 12 14 -VtaFail.hs:51:5: error: +VtaFail.hs:53:5: error: • Cannot apply expression of type ‘Int -> String’ to a visible type argument ‘Float’ • In the expression: show @Int @Float (read "5") In an equation for ‘e’: e = show @Int @Float (read "5") -VtaFail.hs:52:11: error: +VtaFail.hs:54:11: error: • Cannot apply expression of type ‘String -> Int’ to a visible type argument ‘Bool’ • In the first argument of ‘show’, namely @@ -80,7 +81,7 @@ VtaFail.hs:52:11: error: In the expression: show (read @Int @Bool @Float "3") In an equation for ‘f’: f = show (read @Int @Bool @Float "3") -VtaFail.hs:57:12: error: +VtaFail.hs:59:12: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ • In the type ‘Maybe’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index d97c6f96e1..0b4e6b70d7 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -483,7 +483,7 @@ test('T14904b', normal, compile_fail, ['']) test('T15067', normal, compile_fail, ['']) test('T15330', normal, compile_fail, ['']) test('T15361', normal, compile_fail, ['']) -test('T15438', normal, compile_fail, ['']) +test('T15438', normal, compile, ['']) test('T15515', normal, compile_fail, ['']) test('T15523', normal, compile_fail, ['-O']) test('T15527', normal, compile_fail, ['']) @@ -561,6 +561,7 @@ test('T17566c', normal, compile_fail, ['']) test('T17773', normal, compile_fail, ['']) test('T17021', normal, compile_fail, ['']) test('T17021b', normal, compile_fail, ['']) +test('T17775', normal, compile_fail, ['']) test('T17955', normal, compile_fail, ['']) test('T17173', normal, compile_fail, ['']) test('T18127a', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/mc19.stderr b/testsuite/tests/typecheck/should_fail/mc19.stderr index 1b9682e6c8..5d19a388af 100644 --- a/testsuite/tests/typecheck/should_fail/mc19.stderr +++ b/testsuite/tests/typecheck/should_fail/mc19.stderr @@ -1,8 +1,12 @@ mc19.hs:10:31: error: - • Occurs check: cannot construct the infinite type: a ~ [a] - Expected type: [a] -> [a] - Actual type: [a] -> [[a]] + • Couldn't match type ‘a’ with ‘[a]’ + Expected: [a] -> [a] + Actual: [a] -> [[a]] + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall {a}. [a] -> [a] + at mc19.hs:10:31-35 • In the expression: inits In a stmt of a monad comprehension: then inits In the expression: [x | x <- [3, 2, 1], then inits] diff --git a/testsuite/tests/typecheck/should_fail/mc21.stderr b/testsuite/tests/typecheck/should_fail/mc21.stderr index 014628f94a..abad9f6a20 100644 --- a/testsuite/tests/typecheck/should_fail/mc21.stderr +++ b/testsuite/tests/typecheck/should_fail/mc21.stderr @@ -1,8 +1,12 @@ mc21.hs:12:26: error: - • Occurs check: cannot construct the infinite type: a ~ [a] - Expected type: [a] -> [[a]] - Actual type: [[a]] -> [[a]] + • Couldn't match type ‘a’ with ‘[a]’ + Expected: [a] -> [[a]] + Actual: [a] -> [a] + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall {a}. [a] -> [[a]] + at mc21.hs:12:26-31 • In the expression: take 5 In a stmt of a monad comprehension: then group using take 5 In the expression: diff --git a/testsuite/tests/typecheck/should_fail/mc22.stderr b/testsuite/tests/typecheck/should_fail/mc22.stderr index 40a754a9c5..50dbf5425b 100644 --- a/testsuite/tests/typecheck/should_fail/mc22.stderr +++ b/testsuite/tests/typecheck/should_fail/mc22.stderr @@ -1,11 +1,15 @@ mc22.hs:10:26: error: - • Occurs check: cannot construct the infinite type: a ~ t a - Expected type: [a] -> [t a] - Actual type: [t a] -> [t a] + • Couldn't match type ‘a’ with ‘t a’ + Expected: [a] -> [t a] + Actual: [a] -> [a] + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall {a}. [a] -> [t a] + at mc22.hs:10:26-31 • In the expression: take 5 In a stmt of a monad comprehension: then group using take 5 In the expression: [x + 1 | x <- ["Hello", "World"], then group using take 5] • Relevant bindings include - foo :: [t [Char]] (bound at mc22.hs:8:1) + foo :: [t String] (bound at mc22.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/mc23.stderr b/testsuite/tests/typecheck/should_fail/mc23.stderr index 2f3ae27a98..b9029f1635 100644 --- a/testsuite/tests/typecheck/should_fail/mc23.stderr +++ b/testsuite/tests/typecheck/should_fail/mc23.stderr @@ -1,8 +1,9 @@ mc23.hs:9:29: error: - • Couldn't match type ‘[a0]’ with ‘[a] -> m a’ - Expected type: (a -> b) -> [a] -> m a - Actual type: [a0] -> [a0] + • Couldn't match type: [a0] + with: a -> b + Expected: (a -> b) -> [a] -> m a + Actual: [a0] -> [a0] • Possible cause: ‘take’ is applied to too many arguments In the expression: take 5 In a stmt of a monad comprehension: then take 5 by x diff --git a/testsuite/tests/typecheck/should_fail/mc24.stderr b/testsuite/tests/typecheck/should_fail/mc24.stderr index 06a9c51690..e40a0c6e72 100644 --- a/testsuite/tests/typecheck/should_fail/mc24.stderr +++ b/testsuite/tests/typecheck/should_fail/mc24.stderr @@ -1,11 +1,11 @@ mc24.hs:10:31: error: - • Couldn't match type ‘[a1]’ with ‘[a] -> m [a]’ - Expected type: (a -> a0) -> [a] -> m [a] - Actual type: [a1] -> [a1] + • Couldn't match type: [a1] + with: a -> a0 + Expected: (a -> a0) -> [a] -> m [a] + Actual: [a1] -> [a1] • Possible cause: ‘take’ is applied to too many arguments In the expression: take 2 In a stmt of a monad comprehension: then group by x using take 2 In the expression: [GHC.List.length x | x <- [1 .. 10], then group by x using take 2] - • Relevant bindings include foo :: m Int (bound at mc24.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/mc25.stderr b/testsuite/tests/typecheck/should_fail/mc25.stderr index 5c29197f04..f4e992f9e7 100644 --- a/testsuite/tests/typecheck/should_fail/mc25.stderr +++ b/testsuite/tests/typecheck/should_fail/mc25.stderr @@ -1,8 +1,8 @@ mc25.hs:9:46: error: - • Couldn't match type ‘a -> t1’ with ‘Int’ - Expected type: (a -> t1) -> [a] -> [t a] - Actual type: Int -> [t a] -> [t a] + • Couldn't match type ‘Int’ with ‘a -> t1’ + Expected: (a -> t1) -> [a] -> [t a] + Actual: Int -> [a] -> [a] • In the expression: take In a stmt of a monad comprehension: then group by x using take In the expression: [x | x <- [1 .. 10], then group by x using take] diff --git a/testsuite/tests/typecheck/should_fail/tcfail001.stderr b/testsuite/tests/typecheck/should_fail/tcfail001.stderr index 2d4caf2ac7..7f49c869ee 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail001.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail001.stderr @@ -1,7 +1,7 @@ tcfail001.hs:9:2: error: - • Couldn't match expected type ‘[a]’ - with actual type ‘[a0] -> [a1]’ + • Couldn't match expected type: [a] + with actual type: [a0] -> [a1] • The equation(s) for ‘op’ have one value argument, but its type ‘[a]’ has none In the instance declaration for ‘A [a]’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail002.stderr b/testsuite/tests/typecheck/should_fail/tcfail002.stderr index d72a34065e..664c910533 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail002.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail002.stderr @@ -1,6 +1,6 @@ tcfail002.hs:4:7: error: - • Occurs check: cannot construct the infinite type: p ~ [p] + • Couldn't match expected type ‘p’ with actual type ‘[p]’ • In the expression: z In an equation for ‘c’: c z = z • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/tcfail004.stderr b/testsuite/tests/typecheck/should_fail/tcfail004.stderr index 9d6657e651..0d4f700910 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail004.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail004.stderr @@ -1,7 +1,7 @@ tcfail004.hs:3:9: error: - • Couldn't match expected type ‘(a, b)’ - with actual type ‘(a0, b0, c0)’ + • Couldn't match expected type: (a, b) + with actual type: (a0, b0, c0) • In the expression: (1, 2, 3) In a pattern binding: (f, g) = (1, 2, 3) • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/tcfail005.stderr b/testsuite/tests/typecheck/should_fail/tcfail005.stderr index d206505cdc..8da93af1e2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail005.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail005.stderr @@ -1,6 +1,7 @@ tcfail005.hs:3:9: error: - • Couldn't match expected type ‘[a]’ with actual type ‘(a0, Char)’ + • Couldn't match expected type: [a] + with actual type: (a0, Char) • In the expression: (1, 'a') In a pattern binding: (h : i) = (1, 'a') • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/tcfail014.stderr b/testsuite/tests/typecheck/should_fail/tcfail014.stderr index f506bff6f8..65b217ef1f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail014.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail014.stderr @@ -1,6 +1,6 @@ tcfail014.hs:5:33: error: - • Occurs check: cannot construct the infinite type: t4 ~ t4 -> t5 + • Couldn't match expected type ‘t4’ with actual type ‘t4 -> t5’ • In the first argument of ‘z’, namely ‘z’ In the expression: z z In an equation for ‘h’: h z = z z diff --git a/testsuite/tests/typecheck/should_fail/tcfail016.stderr b/testsuite/tests/typecheck/should_fail/tcfail016.stderr index 20b9e0fa36..9f38cd6461 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail016.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail016.stderr @@ -1,7 +1,8 @@ tcfail016.hs:8:1: error: - • Couldn't match type ‘Expr a’ with ‘(a, Expr a)’ - Expected type: AnnExpr a -> [[Char]] - Actual type: Expr a -> [[Char]] + • Couldn't match type: Expr a + with: (a, Expr a) + Expected: AnnExpr a -> [[Char]] + Actual: Expr a -> [[Char]] • Relevant bindings include g :: AnnExpr a -> [[Char]] (bound at tcfail016.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail033.stderr b/testsuite/tests/typecheck/should_fail/tcfail033.stderr index bc346c2aac..a1c5e7d7d0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail033.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail033.stderr @@ -1,6 +1,6 @@ tcfail033.hs:4:12: error: - • Occurs check: cannot construct the infinite type: a ~ (a, b) + • Couldn't match expected type ‘(a, b)’ with actual type ‘a’ • In the expression: x In the expression: [x | (x, y) <- buglet] In an equation for ‘buglet’: buglet = [x | (x, y) <- buglet] diff --git a/testsuite/tests/typecheck/should_fail/tcfail065.stderr b/testsuite/tests/typecheck/should_fail/tcfail065.stderr index c1f3283daa..9be21918cb 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail065.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail065.stderr @@ -1,14 +1,15 @@ tcfail065.hs:29:18: error: • Couldn't match type ‘x1’ with ‘x’ + Expected: X x + Actual: X x1 ‘x1’ is a rigid type variable bound by the type signature for: setX :: forall x1. x1 -> X x -> X x at tcfail065.hs:29:3-6 ‘x’ is a rigid type variable bound by - the instance declaration at tcfail065.hs:28:10-19 - Expected type: X x - Actual type: X x1 + the instance declaration + at tcfail065.hs:28:10-19 • In the expression: X x In an equation for ‘setX’: setX x (X _) = X x In the instance declaration for ‘HasX (X x)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr index 299fc7b8a7..c7b7630e04 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr @@ -1,6 +1,8 @@ tcfail068.hs:14:9: error: • Couldn't match type ‘s1’ with ‘s’ + Expected: GHC.ST.ST s1 (IndTree s a) + Actual: GHC.ST.ST s1 (STArray s1 (Int, Int) a) ‘s1’ is a rigid type variable bound by a type expected by the context: forall s1. GHC.ST.ST s1 (IndTree s a) @@ -11,8 +13,6 @@ tcfail068.hs:14:9: error: Constructed a => (Int, Int) -> a -> IndTree s a at tcfail068.hs:11:1-55 - Expected type: GHC.ST.ST s1 (IndTree s a) - Actual type: GHC.ST.ST s1 (STArray s1 (Int, Int) a) • In the first argument of ‘runST’, namely ‘(newSTArray ((1, 1), n) x)’ In the expression: runST (newSTArray ((1, 1), n) x) @@ -24,6 +24,8 @@ tcfail068.hs:14:9: error: tcfail068.hs:19:9: error: • Couldn't match type ‘s1’ with ‘s’ + Expected: GHC.ST.ST s1 (IndTree s a) + Actual: GHC.ST.ST s (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) @@ -34,8 +36,6 @@ tcfail068.hs:19:9: error: Constructed a => (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a at tcfail068.hs:16:1-75 - Expected type: GHC.ST.ST s1 (IndTree s a) - Actual type: GHC.ST.ST s (IndTree s a) • In the first argument of ‘runST’, namely ‘(readSTArray arr i >>= \ val -> writeSTArray arr i (f val) >> return arr)’ @@ -55,6 +55,8 @@ tcfail068.hs:19:9: error: tcfail068.hs:24:36: error: • Couldn't match type ‘s1’ with ‘s’ + Expected: GHC.ST.ST s1 (IndTree s a) + Actual: GHC.ST.ST s (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) @@ -65,8 +67,6 @@ tcfail068.hs:24:36: error: Constructed a => ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a at tcfail068.hs:23:1-87 - Expected type: GHC.ST.ST s1 (IndTree s a) - Actual type: GHC.ST.ST s (IndTree s a) • In the first argument of ‘runST’, namely ‘(itrap' i k)’ In the expression: runST (itrap' i k) In an equation for ‘itrap’: @@ -92,6 +92,8 @@ tcfail068.hs:24:36: error: tcfail068.hs:36:46: error: • Couldn't match type ‘s1’ with ‘s’ + Expected: GHC.ST.ST s1 (c, IndTree s b) + Actual: GHC.ST.ST s (c, IndTree s b) ‘s1’ is a rigid type variable bound by a type expected by the context: forall s1. GHC.ST.ST s1 (c, IndTree s b) @@ -108,8 +110,6 @@ tcfail068.hs:36:46: error: -> IndTree s b -> (c, IndTree s b) at tcfail068.hs:(34,1)-(35,62) - Expected type: GHC.ST.ST s1 (c, IndTree s b) - Actual type: GHC.ST.ST s (c, IndTree s b) • In the first argument of ‘runST’, namely ‘(itrapstate' i k s)’ In the expression: runST (itrapstate' i k s) In an equation for ‘itrapstate’: diff --git a/testsuite/tests/typecheck/should_fail/tcfail069.stderr b/testsuite/tests/typecheck/should_fail/tcfail069.stderr index fcaf3e9542..a7c996ce84 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail069.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail069.stderr @@ -1,7 +1,7 @@ tcfail069.hs:21:7: error: - • Couldn't match expected type ‘([Int], [Int])’ - with actual type ‘[a0]’ + • Couldn't match expected type: ([Int], [Int]) + with actual type: [a0] • In the pattern: [] In a case alternative: [] -> error "foo" In the expression: case (list1, list2) of { [] -> error "foo" } diff --git a/testsuite/tests/typecheck/should_fail/tcfail076.stderr b/testsuite/tests/typecheck/should_fail/tcfail076.stderr index 52fcebb927..47432ae851 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail076.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail076.stderr @@ -1,6 +1,8 @@ tcfail076.hs:18:82: error: • Couldn't match type ‘res1’ with ‘res’ + Expected: m res1 + Actual: m res ‘res1’ is a rigid type variable bound by a type expected by the context: forall res1. (b -> m res1) -> m res1 @@ -9,8 +11,6 @@ tcfail076.hs:18:82: error: a type expected by the context: forall res. (a -> m res) -> m res at tcfail076.hs:18:35-96 - Expected type: m res1 - Actual type: m res • In the expression: cont a In the first argument of ‘KContT’, namely ‘(\ cont' -> cont a)’ In the expression: KContT (\ cont' -> cont a) diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr index 2192d8a7f6..84c9c8b0b6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr @@ -1,6 +1,8 @@ tcfail103.hs:15:13: error: • Couldn't match type ‘s’ with ‘t’ + Expected: ST s Int + Actual: ST t Int ‘s’ is a rigid type variable bound by the type signature for: g :: forall s. ST s Int @@ -9,8 +11,6 @@ tcfail103.hs:15:13: error: the type signature for: f :: forall t. ST t Int at tcfail103.hs:10:1-12 - Expected type: ST s Int - Actual type: ST t Int • In the expression: readSTRef v In an equation for ‘g’: g = readSTRef v In the expression: diff --git a/testsuite/tests/typecheck/should_fail/tcfail104.stderr b/testsuite/tests/typecheck/should_fail/tcfail104.stderr index 6516dcbd3a..9844b53268 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail104.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail104.stderr @@ -1,8 +1,9 @@ tcfail104.hs:14:12: error: - • Couldn't match type ‘forall a. a -> a’ with ‘Char -> Char’ - Expected type: (Char -> Char) -> Char -> Char - Actual type: (forall a. a -> a) -> Char -> Char + • Couldn't match type: forall a. a -> a + with: Char -> Char + Expected: (Char -> Char) -> Char -> Char + Actual: (forall a. a -> a) -> Char -> Char • In the expression: \ (x :: forall a. a -> a) -> x In the expression: if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x) @@ -10,8 +11,8 @@ tcfail104.hs:14:12: error: (if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x)) id 'c' tcfail104.hs:22:15: error: - • Couldn't match expected type ‘Char -> Char’ - with actual type ‘forall a. a -> a’ + • Couldn't match expected type: Char -> Char + with actual type: forall a. a -> a • When checking that the pattern signature: forall a. a -> a fits the type of its context: Char -> Char In the pattern: x :: forall a. a -> a diff --git a/testsuite/tests/typecheck/should_fail/tcfail119.stderr b/testsuite/tests/typecheck/should_fail/tcfail119.stderr index 5c22aefc4e..d23ab1f537 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail119.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail119.stderr @@ -1,5 +1,7 @@ -tcfail119.hs:11:8: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the pattern: "Foo" - In an equation for ‘b’: b x "Foo" = () +tcfail119.hs:11:8: error: + • Couldn't match type ‘Bool’ with ‘[Char]’ + Expected: Bool + Actual: String + • In the pattern: "Foo" + In an equation for ‘b’: b x "Foo" = () diff --git a/testsuite/tests/typecheck/should_fail/tcfail122.stderr b/testsuite/tests/typecheck/should_fail/tcfail122.stderr index 0ac1419e7d..39507bdbeb 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail122.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail122.stderr @@ -4,8 +4,8 @@ tcfail122.hs:8:9: error: When matching types c0 :: (* -> *) -> * a :: * -> * - Expected type: a b - Actual type: c0 d0 + Expected: a b + Actual: c0 d0 • In the expression: undefined :: forall (c :: (* -> *) -> *) (d :: * -> *). c d In the expression: diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.stderr b/testsuite/tests/typecheck/should_fail/tcfail132.stderr index 2e0a13c844..92f7c2ab52 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail132.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail132.stderr @@ -1,13 +1,15 @@ tcfail132.hs:17:37: error: - • Expected kind ‘* -> * -> * -> *’, + • Couldn't match kind ‘*’ with ‘* -> *’ + Expected kind ‘* -> * -> * -> *’, but ‘Object f' f t’ has kind ‘* -> * -> *’ • In the first argument of ‘T’, namely ‘(Object f' f t)’ In the type ‘T (Object f' f t) (DUnit t)’ In the type declaration for ‘LiftObject’ tcfail132.hs:17:53: error: - • Expected kind ‘* -> * -> * -> *’, + • Couldn't match kind ‘*’ with ‘* -> *’ + Expected kind ‘* -> * -> * -> *’, but ‘DUnit t’ has kind ‘* -> * -> *’ • In the second argument of ‘T’, namely ‘(DUnit t)’ In the type ‘T (Object f' f t) (DUnit t)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr index c0049d0e19..8de86280e1 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr @@ -17,14 +17,14 @@ tcfail140.hs:12:10: error: rot :: p -> t (bound at tcfail140.hs:12:1) tcfail140.hs:14:15: error: - • Couldn't match expected type ‘t -> b’ with actual type ‘Int’ + • Couldn't match expected type ‘a -> b’ with actual type ‘Int’ • The operator ‘f’ takes two value arguments, - but its type ‘Int -> Int’ has only one + but its type ‘Int -> Int’ has only one In the first argument of ‘map’, namely ‘(3 `f`)’ In the expression: map (3 `f`) xs • Relevant bindings include - xs :: [t] (bound at tcfail140.hs:14:5) - bot :: [t] -> [b] (bound at tcfail140.hs:14:1) + xs :: [a] (bound at tcfail140.hs:14:5) + bot :: [a] -> [b] (bound at tcfail140.hs:14:1) tcfail140.hs:16:8: error: • The constructor ‘Just’ should have 1 argument, but has been given none diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.stderr b/testsuite/tests/typecheck/should_fail/tcfail165.stderr index 19fe79bb78..b1f173f447 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail165.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail165.stderr @@ -1,7 +1,7 @@ tcfail165.hs:19:23: error: - • Couldn't match expected type ‘forall a. Show a => a -> String’ - with actual type ‘b0 -> String’ + • Couldn't match expected type: forall a. Show a => a -> String + with actual type: b0 -> String • In the second argument of ‘putMVar’, namely ‘(show :: forall b. Show b => b -> String)’ In a stmt of a 'do' block: diff --git a/testsuite/tests/typecheck/should_fail/tcfail168.stderr b/testsuite/tests/typecheck/should_fail/tcfail168.stderr index 4ec71aaa1d..59972c2aa4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail168.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail168.stderr @@ -1,7 +1,7 @@ tcfail168.hs:7:11: error: - • Couldn't match expected type ‘IO a0’ - with actual type ‘Char -> IO ()’ + • Couldn't match expected type: IO a0 + with actual type: Char -> IO () • Probable cause: ‘putChar’ is applied to too few arguments In a stmt of a 'do' block: putChar In the expression: diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr index 724535145c..5747a270ef 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr @@ -1,21 +1,22 @@ tcfail174.hs:9:5: error: - • Couldn't match type ‘a0 -> a0’ with ‘forall a. a -> a’ - Expected type: Capture (forall a. a -> a) - Actual type: Capture (a0 -> a0) + • Couldn't match type: a0 -> a0 + with: forall a. a -> a + Expected: Capture (forall a. a -> a) + Actual: Capture (a0 -> a0) • In the expression: Base id In an equation for ‘g’: g = Base id tcfail174.hs:16:14: error: • Couldn't match type ‘a1’ with ‘a’ + Expected: Capture (forall x. x -> a) + Actual: Capture (forall a. a -> a) ‘a1’ is a rigid type variable bound by the type a -> a at tcfail174.hs:16:1-14 ‘a’ is a rigid type variable bound by the inferred type of h1 :: Capture a at tcfail174.hs:16:1-14 - Expected type: Capture (forall x. x -> a) - Actual type: Capture (forall a. a -> a) • In the first argument of ‘Capture’, namely ‘g’ In the expression: Capture g In an equation for ‘h1’: h1 = Capture g @@ -24,6 +25,8 @@ tcfail174.hs:16:14: error: tcfail174.hs:19:14: error: • Couldn't match type ‘a’ with ‘b’ + Expected: Capture (forall x. x -> b) + Actual: Capture (forall a. a -> a) ‘a’ is a rigid type variable bound by the type a -> a at tcfail174.hs:1:1 @@ -31,8 +34,6 @@ tcfail174.hs:19:14: error: the type signature for: h2 :: forall b. Capture b at tcfail174.hs:18:1-15 - Expected type: Capture (forall x. x -> b) - Actual type: Capture (forall a. a -> a) • In the first argument of ‘Capture’, namely ‘g’ In the expression: Capture g In an equation for ‘h2’: h2 = Capture g diff --git a/testsuite/tests/typecheck/should_fail/tcfail178.stderr b/testsuite/tests/typecheck/should_fail/tcfail178.stderr index 98df425424..d9f1b455c0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail178.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail178.stderr @@ -1,8 +1,8 @@ tcfail178.hs:15:7: error: • Couldn't match type ‘()’ with ‘[a]’ - Expected type: Bool -> [a] - Actual type: Bool -> () + Expected: Bool -> [a] + Actual: Bool -> () • In the first argument of ‘a’, namely ‘y’ In the expression: a y In an equation for ‘c’: c = a y diff --git a/testsuite/tests/typecheck/should_fail/tcfail179.stderr b/testsuite/tests/typecheck/should_fail/tcfail179.stderr index 7d16288b1f..a0c124590f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail179.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail179.stderr @@ -1,6 +1,8 @@ tcfail179.hs:14:41: error: • Couldn't match type ‘x’ with ‘s’ + Expected: x -> s + Actual: x -> 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, @@ -10,8 +12,6 @@ tcfail179.hs:14:41: error: the type signature for: run :: forall s. T s -> Int at tcfail179.hs:12:1-17 - Expected type: x -> s - Actual type: s -> s • In the second argument of ‘g’, namely ‘id’ In the expression: g x id In a pattern binding: (x, _, b) = g x id diff --git a/testsuite/tests/typecheck/should_fail/tcfail182.stderr b/testsuite/tests/typecheck/should_fail/tcfail182.stderr index e57c3c1672..12dbb6efa8 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail182.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail182.stderr @@ -1,10 +1,10 @@ tcfail182.hs:9:3: error: - • Couldn't match expected type ‘Prelude.Maybe a’ - with actual type ‘Maybe a0’ - NB: ‘Maybe’ is defined at tcfail182.hs:6:1-18 - ‘Prelude.Maybe’ - is defined in ‘GHC.Maybe’ in package ‘base-4.13.0.0’ + • Couldn't match expected type: Prelude.Maybe a + with actual type: Maybe a0 + NB: ‘Prelude.Maybe’ + is defined in ‘GHC.Maybe’ in package ‘base-4.14.0.0’ + ‘Maybe’ is defined at tcfail182.hs:6:1-18 • In the pattern: Foo In an equation for ‘f’: f Foo = 3 • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/tcfail186.stderr b/testsuite/tests/typecheck/should_fail/tcfail186.stderr index 9b38bca915..5d931076f7 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail186.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail186.stderr @@ -1,8 +1,8 @@ tcfail186.hs:7:9: error: • Couldn't match type ‘[Char]’ with ‘Int’ - Expected type: PhantomSyn a0 - Actual type: [Char] + Expected: PhantomSyn a0 + Actual: String • In the first argument of ‘f’, namely ‘"hoo"’ In the expression: f "hoo" In an equation for ‘foo’: foo = f "hoo" diff --git a/testsuite/tests/typecheck/should_fail/tcfail189.stderr b/testsuite/tests/typecheck/should_fail/tcfail189.stderr index f33d1e37f6..108a7ad973 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail189.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail189.stderr @@ -1,8 +1,9 @@ tcfail189.hs:10:31: error: - • Couldn't match type ‘[a1]’ with ‘[a] -> [[a]]’ - Expected type: (a -> a0) -> [a] -> [[a]] - Actual type: [a1] -> [a1] + • Couldn't match type: [a1] + with: a -> a0 + Expected: (a -> a0) -> [a] -> [[a]] + Actual: [a1] -> [a1] • Possible cause: ‘take’ is applied to too many arguments In the expression: take 2 In a stmt of a list comprehension: then group by x using take 2 diff --git a/testsuite/tests/typecheck/should_fail/tcfail191.stderr b/testsuite/tests/typecheck/should_fail/tcfail191.stderr index 125c2d8393..fd874653b0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail191.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail191.stderr @@ -1,8 +1,12 @@ tcfail191.hs:11:26: error: - • Occurs check: cannot construct the infinite type: a ~ [a] - Expected type: [a] -> [[a]] - Actual type: [[a]] -> [[a]] + • Couldn't match type ‘a’ with ‘[a]’ + Expected: [a] -> [[a]] + Actual: [a] -> [a] + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall {a}. [a] -> [[a]] + at tcfail191.hs:11:26-31 • In the expression: take 5 In a stmt of a list comprehension: then group using take 5 In the expression: diff --git a/testsuite/tests/typecheck/should_fail/tcfail193.stderr b/testsuite/tests/typecheck/should_fail/tcfail193.stderr index 028e2f0232..cf4813c9f2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail193.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail193.stderr @@ -1,8 +1,12 @@ tcfail193.hs:10:31: error: - • Occurs check: cannot construct the infinite type: a ~ [a] - Expected type: [a] -> [a] - Actual type: [a] -> [[a]] + • Couldn't match type ‘a’ with ‘[a]’ + Expected: [a] -> [a] + Actual: [a] -> [[a]] + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall {a}. [a] -> [a] + at tcfail193.hs:10:31-35 • In the expression: inits In a stmt of a list comprehension: then inits In the expression: [x | x <- [3, 2, 1], then inits] diff --git a/testsuite/tests/typecheck/should_fail/tcfail199.stderr b/testsuite/tests/typecheck/should_fail/tcfail199.stderr index 4833c769f9..50fc8e5f44 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail199.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail199.stderr @@ -1,5 +1,8 @@ -tcfail199.hs:5:1: - Couldn't match expected type ‘IO t0’ with actual type ‘[Char]’ - In the expression: main - When checking the type of the IO action ‘main’ +tcfail199.hs:5:1: error: + • Couldn't match type: [Char] + with: IO t0 + Expected: IO t0 + Actual: String + • In the expression: main + When checking the type of the IO action ‘main’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.stderr b/testsuite/tests/typecheck/should_fail/tcfail201.stderr index 77349e29f4..dd1385fc90 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail201.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail201.stderr @@ -1,14 +1,14 @@ tcfail201.hs:17:56: error: • Couldn't match type ‘a’ with ‘HsDoc id0’ + Expected: c a + Actual: c (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 - Expected type: c a - Actual type: c (HsDoc id0) • In the expression: z DocEmpty In a case alternative: DocEmpty -> z DocEmpty In the expression: case hsDoc of { DocEmpty -> z DocEmpty } diff --git a/testsuite/tests/typecheck/should_fail/tcfail206.stderr b/testsuite/tests/typecheck/should_fail/tcfail206.stderr index 7c97fc02af..cfb5161100 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail206.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail206.stderr @@ -1,26 +1,27 @@ tcfail206.hs:5:5: error: • Couldn't match type ‘Bool’ with ‘Int’ - Expected type: Bool -> (Int, Bool) - Actual type: Int -> (Int, Bool) + Expected: Bool -> (Int, Bool) + Actual: Bool -> (Bool, Bool) • In the expression: (, True) In an equation for ‘a’: a = (, True) tcfail206.hs:8:5: error: - • Couldn't match type ‘(t1, Int)’ with ‘Bool -> (Int, Bool)’ - Expected type: Int -> Bool -> (Int, Bool) - Actual type: Int -> (t1, Int) + • Couldn't match type: (t1, Int) + with: Bool -> (Int, Bool) + Expected: Int -> Bool -> (Int, Bool) + Actual: Int -> (t1, Int) • In the expression: (1,) In an equation for ‘b’: b = (1,) tcfail206.hs:11:5: error: • Couldn't match type ‘a’ with ‘Bool’ + Expected: a -> (a, Bool) + Actual: a -> (Bool, a) ‘a’ is a rigid type variable bound by the type signature for: c :: forall a. a -> (a, Bool) at tcfail206.hs:10:1-19 - Expected type: a -> (a, Bool) - Actual type: Bool -> (a, Bool) • In the expression: (True || False,) In an equation for ‘c’: c = (True || False,) • Relevant bindings include @@ -28,27 +29,27 @@ tcfail206.hs:11:5: error: tcfail206.hs:14:5: error: • Couldn't match type ‘Bool’ with ‘Int’ - Expected type: Bool -> (# Int, Bool #) - Actual type: Int -> (# Int, Bool #) + Expected: Bool -> (# Int, Bool #) + Actual: Bool -> (# Bool, Bool #) • In the expression: (# , True #) In an equation for ‘d’: d = (# , True #) tcfail206.hs:17:5: error: - • Couldn't match type ‘(# t0, Int #)’ - with ‘Bool -> (# Int, Bool #)’ - Expected type: Int -> Bool -> (# Int, Bool #) - Actual type: Int -> (# t0, Int #) + • Couldn't match type: (# t0, Int #) + with: Bool -> (# Int, Bool #) + Expected: Int -> Bool -> (# Int, Bool #) + Actual: Int -> (# t0, Int #) • In the expression: (# 1, #) In an equation for ‘e’: e = (# 1, #) tcfail206.hs:20:5: error: • Couldn't match type ‘a’ with ‘Bool’ + Expected: a -> (# a, Bool #) + Actual: a -> (# Bool, a #) ‘a’ is a rigid type variable bound by the type signature for: f :: forall a. a -> (# a, Bool #) at tcfail206.hs:19:1-21 - Expected type: a -> (# a, Bool #) - Actual type: Bool -> (# a, Bool #) • In the expression: (# True || False, #) In an equation for ‘f’: f = (# True || False, #) • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/tcfail207.stderr b/testsuite/tests/typecheck/should_fail/tcfail207.stderr index 986d7d5740..eb6fb1db15 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail207.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail207.stderr @@ -1,14 +1,14 @@ -tcfail207.hs:5:7: - Couldn't match expected type ‘[Int] -> [Int]’ - with actual type ‘[a1]’ - Possible cause: ‘take’ is applied to too many arguments - In the expression: take x [] - In an equation for ‘f’: f x = take x [] +tcfail207.hs:5:7: error: + • Couldn't match expected type: [Int] -> [Int] + with actual type: [a1] + • Possible cause: ‘take’ is applied to too many arguments + In the expression: take x [] + In an equation for ‘f’: f x = take x [] -tcfail207.hs:9:5: - Couldn't match expected type ‘[Int]’ - with actual type ‘[a0] -> [a0]’ - Probable cause: ‘take’ is applied to too few arguments - In the expression: take 3 - In an equation for ‘g’: g = take 3 +tcfail207.hs:9:5: error: + • Couldn't match expected type: [Int] + with actual type: [a0] -> [a0] + • Probable cause: ‘take’ is applied to too few arguments + In the expression: take 3 + In an equation for ‘g’: g = take 3 diff --git a/testsuite/tests/typecheck/should_fail/tcfail225.stderr b/testsuite/tests/typecheck/should_fail/tcfail225.stderr index 5a3ba3681f..8bfca4cb48 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail225.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail225.stderr @@ -1,6 +1,7 @@ tcfail225.hs:9:19: error: - • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’ + • Couldn't match kind ‘k’ with ‘*’ + Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’ • In the first argument of ‘T’, namely ‘Maybe’ In the type ‘T Maybe (m a)’ In the definition of data constructor ‘MkT’ diff --git a/testsuite/tests/typecheck/should_run/IPRun.hs b/testsuite/tests/typecheck/should_run/IPRun.hs index 0d2a8d76c6..6c3c88ff95 100644 --- a/testsuite/tests/typecheck/should_run/IPRun.hs +++ b/testsuite/tests/typecheck/should_run/IPRun.hs @@ -15,7 +15,7 @@ f2 () = let ?x = 5 in \() -> ?x -- should always return 5 f3 :: () -> ((?x :: Int) => Int) --- Deep skolemisation means that the local x=5 still wins +-- Simple subsumption means that the x=0 from main wins f3 = let ?x = 5 in \() -> ?x main = let ?x = 0 in diff --git a/testsuite/tests/typecheck/should_run/IPRun.stdout b/testsuite/tests/typecheck/should_run/IPRun.stdout index e558e3cc3a..978f5752d6 100644 --- a/testsuite/tests/typecheck/should_run/IPRun.stdout +++ b/testsuite/tests/typecheck/should_run/IPRun.stdout @@ -1,4 +1,4 @@ 5 5 5 -5 +0 diff --git a/testsuite/tests/typecheck/should_run/KindInvariant.stderr b/testsuite/tests/typecheck/should_run/KindInvariant.stderr index 4f6cfffb7f..9d404ae088 100644 --- a/testsuite/tests/typecheck/should_run/KindInvariant.stderr +++ b/testsuite/tests/typecheck/should_run/KindInvariant.stderr @@ -1,6 +1,7 @@ <interactive>:1:3: error: - • Expected kind ‘* -> *’, + • Couldn't match a lifted type with an unlifted type + Expected kind ‘* -> *’, but ‘State#’ has kind ‘* -> TYPE ('TupleRep '[])’ • In the first argument of ‘T’, namely ‘State#’ In the type ‘T State#’ diff --git a/testsuite/tests/typecheck/should_run/T13838.stderr b/testsuite/tests/typecheck/should_run/T13838.stderr index b2129f7d13..a8de8b16d3 100644 --- a/testsuite/tests/typecheck/should_run/T13838.stderr +++ b/testsuite/tests/typecheck/should_run/T13838.stderr @@ -1,5 +1,6 @@ -T13838.exe: T13838.hs:6:1: error: - • Couldn't match expected type ‘IO t0’ with actual type ‘() -> ()’ +T13838: T13838.hs:6:1: error: + • Couldn't match expected type: IO t0 + with actual type: () -> () • Probable cause: ‘main’ is applied to too few arguments In the expression: main When checking the type of the IO action ‘main’ diff --git a/testsuite/tests/typecheck/should_run/T7861.stderr b/testsuite/tests/typecheck/should_run/T7861.stderr index 4a1c030d7c..f65b01e217 100644 --- a/testsuite/tests/typecheck/should_run/T7861.stderr +++ b/testsuite/tests/typecheck/should_run/T7861.stderr @@ -1,7 +1,11 @@ T7861: T7861.hs:10:5: error: - • Occurs check: cannot construct the infinite type: a ~ [a] - Expected type: (forall b. a) -> a - Actual type: (forall b. a) -> [a] + • Couldn't match type ‘a’ with ‘[a]’ + Expected: (forall b. a) -> a + Actual: (forall b. a) -> [a] + ‘a’ is a rigid type variable bound by + the type signature for: + f :: forall a. (forall b. a) -> a + at T7861.hs:9:1-23 • In the expression: doA In an equation for ‘f’: f = doA • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr index ec16681592..3ded9c03ed 100644 --- a/testsuite/tests/typecheck/should_run/Typeable1.stderr +++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr @@ -1,6 +1,7 @@ Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code] - • Couldn't match type ‘ComposeK’ with ‘a3 b3’ + • Couldn't match type: ComposeK + with: a3 b3 Inaccessible code in a pattern with pattern synonym: App :: forall k2 (t :: k2). diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 4cd7a1b73c..5afc7e3725 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -58,7 +58,7 @@ test('tcrun038', [extra_files(['TcRun038_B.hs'])], multimod_compile_and_run, ['t test('tcrun039', normal, compile_and_run, ['']) test('tcrun040', normal, compile_and_run, ['']) test('tcrun041', omit_ways(['ghci']), compile_and_run, ['']) -test('tcrun042', normal, compile_fail, ['']) +test('tcrun042', normal, compile, ['']) test('tcrun043', normal, compile_and_run, ['']) test('tcrun044', normal, compile_and_run, ['']) test('tcrun045', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_run/tcrun035.hs b/testsuite/tests/typecheck/should_run/tcrun035.hs index ee9f27bb7b..9106557ede 100644 --- a/testsuite/tests/typecheck/should_run/tcrun035.hs +++ b/testsuite/tests/typecheck/should_run/tcrun035.hs @@ -6,11 +6,15 @@ -- Now it breaks the impredicativity story -- (id {a}) . (id {a}) :: a -> a -- And (forall m. Monad m => m a) /~ IO a +-- +-- Apr 20: with simple subsumption this fails. So I +-- I eta-expanded foo, but leaving the (id . id) +-- composition. module Main(main) where foo :: (forall m. Monad m => m a) -> IO a -foo = id . id +foo x = (id . id) x main :: IO () main = foo (return ()) diff --git a/testsuite/tests/typecheck/should_run/tcrun042.hs b/testsuite/tests/typecheck/should_run/tcrun042.hs index 3b51d36c22..ba809a16ba 100644 --- a/testsuite/tests/typecheck/should_run/tcrun042.hs +++ b/testsuite/tests/typecheck/should_run/tcrun042.hs @@ -5,6 +5,8 @@ -- failing, which is OK. We don't really support impredicative -- polymorphism! -- +-- Apr 20: Works again. NB: the ImpredicativeTypes flag +-- -- The test was added by Max in 5e8ff849, apparently to test tuple sections module Main where diff --git a/testsuite/tests/typecheck/should_run/tcrun042.stderr b/testsuite/tests/typecheck/should_run/tcrun042.stderr deleted file mode 100644 index 52d9b29693..0000000000 --- a/testsuite/tests/typecheck/should_run/tcrun042.stderr +++ /dev/null @@ -1,6 +0,0 @@ - -tcrun042.hs:13:5: error: - • Couldn't match expected type ‘forall c. c -> c -> c’ - with actual type ‘b0 -> b0 -> b0’ - • In the expression: (, "Hello" ++ "World",) - In an equation for ‘e’: e = (, "Hello" ++ "World",) diff --git a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr index 6d02807207..aa02b8655a 100644 --- a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr +++ b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr @@ -18,8 +18,8 @@ CaretDiagnostics1.hs:(5,3)-(7,16): error: CaretDiagnostics1.hs:8:3-45: error: • Couldn't match type ‘[Char]’ with ‘()’ - Expected type: IO () - Actual type: IO [Char] + 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) @@ -35,7 +35,9 @@ CaretDiagnostics1.hs:8:3-45: error: | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ CaretDiagnostics1.hs:8:31-44: error: - • Couldn't match expected type ‘[Char]’ with actual type ‘()’ + • Couldn't match type ‘()’ with ‘[Char]’ + Expected: String + Actual: () • In the second argument of ‘(+)’, namely ‘()’ In the first argument of ‘pure’, namely ‘("this is not an IO" + ())’ @@ -45,7 +47,10 @@ CaretDiagnostics1.hs:8:31-44: error: | ^^^^^^^^^^^^^^ CaretDiagnostics1.hs:13:7-11: error: - • Couldn't match expected type ‘a1 -> a1’ with actual type ‘[Char]’ + • Couldn't match type: a1 -> a1 + with: [Char] + Expected: a1 -> a1 + Actual: String • In the pattern: "γηξ" In a case alternative: "γηξ" -> () '0' In the expression: case id of { "γηξ" -> () '0' } |