diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2020-02-02 18:23:11 +0000 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-06-05 09:27:50 -0400 |
| commit | 2b792facab46f7cdd09d12e79499f4e0dcd4293f (patch) | |
| tree | f3bf2dffdd3c46744d3c1b0638948a1dfbd1b8f6 | |
| parent | af5e3a885ddd09dd5f550552c535af3661ff3dbf (diff) | |
| download | haskell-wip/T17775.tar.gz | |
Simple subsumptionwip/T17775
This patch simplifies GHC to use simple subsumption.
Ticket #17775
Implements GHC proposal #287
https://github.com/ghc-proposals/ghc-proposals/blob/master/
proposals/0287-simplify-subsumption.rst
All the motivation is described there; I will not repeat it here.
The implementation payload:
* tcSubType and friends become noticably simpler, because it no
longer uses eta-expansion when checking subsumption.
* No deeplyInstantiate or deeplySkolemise
That in turn means that some tests fail, by design; they can all
be fixed by eta expansion. There is a list of such changes below.
Implementing the patch led me into a variety of sticky corners, so
the patch includes several othe changes, some quite significant:
* I made String wired-in, so that
"foo" :: String rather than
"foo" :: [Char]
This improves error messages, and fixes #15679
* The pattern match checker relies on knowing about in-scope equality
constraints, andd adds them to the desugarer's environment using
addTyCsDs. But the co_fn in a FunBind was missed, and for some reason
simple-subsumption ends up with dictionaries there. So I added a
call to addTyCsDs. This is really part of #18049.
* I moved the ic_telescope field out of Implication and into
ForAllSkol instead. This is a nice win; just expresses the code
much better.
* There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader.
We called checkDataKindSig inside tc_kind_sig, /before/
solveEqualities and zonking. Obviously wrong, easily fixed.
* solveLocalEqualitiesX: there was a whole mess in here, around
failing fast enough. I discovered a bad latent bug where we
could successfully kind-check a type signature, and use it,
but have unsolved constraints that could fill in coercion
holes in that signature -- aargh.
It's all explained in Note [Failure in local type signatures]
in GHC.Tc.Solver. Much better now.
* I fixed a serious bug in anonymous type holes. IN
f :: Int -> (forall a. a -> _) -> Int
that "_" should be a unification variable at the /outer/
level; it cannot be instantiated to 'a'. This was plain
wrong. New fields mode_lvl and mode_holes in TcTyMode,
and auxiliary data type GHC.Tc.Gen.HsType.HoleMode.
This fixes #16292, but makes no progress towards the more
ambitious #16082
* I got sucked into an enormous refactoring of the reporting of
equality errors in GHC.Tc.Errors, especially in
mkEqErr1
mkTyVarEqErr
misMatchMsg
misMatchMsgOrCND
In particular, the very tricky mkExpectedActualMsg function
is gone.
It took me a full day. But the result is far easier to understand.
(Still not easy!) This led to various minor improvements in error
output, and an enormous number of test-case error wibbles.
One particular point: for occurs-check errors I now just say
Can't match 'a' against '[a]'
rather than using the intimidating language of "occurs check".
* Pretty-printing AbsBinds
Tests review
* Eta expansions
T11305: one eta expansion
T12082: one eta expansion (undefined)
T13585a: one eta expansion
T3102: one eta expansion
T3692: two eta expansions (tricky)
T2239: two eta expansions
T16473: one eta
determ004: two eta expansions (undefined)
annfail06: two eta (undefined)
T17923: four eta expansions (a strange program indeed!)
tcrun035: one eta expansion
* Ambiguity check at higher rank. Now that we have simple
subsumption, a type like
f :: (forall a. Eq a => Int) -> Int
is no longer ambiguous, because we could write
g :: (forall a. Eq a => Int) -> Int
g = f
and it'd typecheck just fine. But f's type is a bit
suspicious, and we might want to consider making the
ambiguity check do a check on each sub-term. Meanwhile,
these tests are accepted, whereas they were previously
rejected as ambiguous:
T7220a
T15438
T10503
T9222
* Some more interesting error message wibbles
T13381: Fine: one error (Int ~ Exp Int)
rather than two (Int ~ Exp Int, Exp Int ~ Int)
T9834: Small change in error (improvement)
T10619: Improved
T2414: Small change, due to order of unification, fine
T2534: A very simple case in which a change of unification order
means we get tow unsolved constraints instead of one
tc211: bizarre impredicative tests; just accept this for now
Updates Cabal and haddock submodules.
Metric Increase:
T12150
T12234
T5837
haddock.base
Metric Decrease:
haddock.compiler
haddock.Cabal
haddock.base
Merge note: This appears to break the
`UnliftedNewtypesDifficultUnification` test. It has been marked as
broken in the interest of merging.
(cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5)
429 files changed, 3985 insertions, 3323 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 9eb5061b64..8d7cecafdf 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -743,8 +743,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 @@ -1680,11 +1679,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 d51f2243ca..eed9420aa6 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, @@ -221,6 +221,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they , anyTyCon , boolTyCon , charTyCon + , stringTyCon , doubleTyCon , floatTyCon , intTyCon @@ -301,11 +302,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 @@ -507,13 +509,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 @@ -1402,7 +1405,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 960b7d9c51..4c86f17ac1 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 0f4a16c98e..25bcae6ce6 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/Type.hs b/compiler/GHC/Hs/Type.hs index 43e131ce0c..8dfc317cd9 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.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 e24eb50d51..4c30aed8ff 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 ef69e97605..f21dc1e7a1 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 cdbaab115b..1cd4e27c8d 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.Type +{- 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.Type 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.Type +-} + {- ********************************************************************* * * 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..4e30d4bc33 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 @@ -397,43 +397,51 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of res) } ViewPat _ expr pat -> do - { - -- We use tcInferRho here. - -- If we have a view function with types like: - -- blah -> forall b. burble - -- then simple-subsumption means that 'forall b' won't be instantiated - -- so we can typecheck the inner pattern with that type - -- 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 + -- Note [View patterns and polymorphism] -- 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 - -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_ty) + ; (expr_wrap1, inf_arg_ty, inf_res_sigma) + <- matchActualFunTySigma herald expr_orig (Just (unLoc expr)) (1,[]) expr_ty + -- See Note [View patterns and polymorphism] + -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_sigma) -- Check that overall pattern is more polymorphic than arg type ; expr_wrap2 <- tc_sub_type penv pat_ty inf_arg_ty -- expr_wrap2 :: pat_ty "->" inf_arg_ty - -- Pattern must have inf_res_ty - ; (pat', res) <- tc_lpat (mkCheckExpType inf_res_ty) penv pat thing_inside + -- Pattern must have inf_res_sigma + ; (pat', res) <- tc_lpat (mkCheckExpType inf_res_sigma) penv pat thing_inside ; pat_ty <- readExpType pat_ty ; let expr_wrap2' = mkWpFun expr_wrap2 idHsWrapper - pat_ty inf_res_ty doc - -- expr_wrap2' :: (inf_arg_ty -> inf_res_ty) "->" - -- (pat_ty -> inf_res_ty) + pat_ty inf_res_sigma doc + -- expr_wrap2' :: (inf_arg_ty -> inf_res_sigma) "->" + -- (pat_ty -> inf_res_sigma) expr_wrap = expr_wrap2' <.> expr_wrap1 doc = text "When checking the view pattern function:" <+> (ppr expr) ; return (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res)} +{- Note [View patterns and polymorphism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this exotic example: + pair :: forall a. Bool -> a -> forall b. b -> (a,b) + + f :: Int -> blah + f (pair True -> x) = ...here (x :: forall b. b -> (Int,b)) + +The expresion (pair True) should have type + pair True :: Int -> forall b. b -> (Int,b) +so that it is ready to consume the incoming Int. It should be an +arrow type (t1 -> t2); hence using (tcInferRho expr). + +Then, when taking that arrow apart we want to get a *sigma* type +(forall b. b->(Int,b)), because that's what we want to bind 'x' to. +Fortunately that's what matchExpectedFunTySigma returns anyway. +-} + -- Type signatures in patterns -- See Note [Pattern coercions] below SigPat _ pat sig_ty -> do 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 8a7b1b0c7f..f1233c55ed 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 267a36cd89..300a870709 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 4e828c919c..2fc8664450 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 ecfa9afa3a..6916357691 100644 --- a/compiler/GHC/Tc/Solver/Flatten.hs +++ b/compiler/GHC/Tc/Solver/Flatten.hs @@ -1175,7 +1175,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 2fc741ce6f..d7fbd2e095 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, @@ -1145,7 +1146,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 @@ -1167,7 +1168,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) } @@ -1589,7 +1590,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 d06307263d..97267a8641 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 8cd9a06a06..b08001c6e2 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 8f5d5db439..38b20df1f8 100644 --- a/docs/users_guide/8.12.1-notes.rst +++ b/docs/users_guide/8.12.1-notes.rst @@ -89,6 +89,13 @@ Language This change prepares the way for `Quick Look impredicativity <https://gitlab.haskell.org/ghc/ghc/issues/18126>`_. +* 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 51084c8e8a..3db323c9a3 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/hiefile/should_run/HieQueries.stdout b/testsuite/tests/hiefile/should_run/HieQueries.stdout index 59bfb1d19d..98f0466815 100644 --- a/testsuite/tests/hiefile/should_run/HieQueries.stdout +++ b/testsuite/tests/hiefile/should_run/HieQueries.stdout @@ -19,7 +19,7 @@ At point (31,9), we found: | `- ┌ │ $dC at HieQueries.hs:31:1-13, of type: C a - │ is an evidence variable bound by a type signature + │ is an evidence variable bound by a HsWrapper │ with scope: LocalScope HieQueries.hs:31:1-13 │ bound at: HieQueries.hs:31:1-13 │ Defined at <no location info> @@ -74,7 +74,7 @@ At point (37,9), we found: | +- ┌ | │ $dShow at HieQueries.hs:37:1-22, of type: Show x - | │ is an evidence variable bound by a type signature + | │ is an evidence variable bound by a HsWrapper | │ with scope: LocalScope HieQueries.hs:37:1-22 | │ bound at: HieQueries.hs:37:1-22 | │ Defined at <no location info> 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_compile/T17775-singleton.hs b/testsuite/tests/patsyn/should_compile/T17775-singleton.hs new file mode 100644 index 0000000000..651dff583a --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T17775-singleton.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} +module Bug where + +-- Ryan Scott (on MR !2600) said this failed + +type T = forall a. a -> () + +toT :: () -> T +toT x _ = x + +pattern ToT :: T -> () +pattern ToT{x} <- (toT -> x) + +-- f (toT -> (x::T)) = True + diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 6ef1928768..75be0c68b2 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -78,3 +78,4 @@ test('T14394', normal, ghci_script, ['T14394.script']) test('T14498', normal, compile, ['']) test('T16682', [extra_files(['T16682.hs', 'T16682a.hs'])], multimod_compile, ['T16682', '-v0 -fwarn-incomplete-patterns -fno-code']) +test('T17775-singleton', normal, compile, ['']) 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 358e7f34f2..3773c76400 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 ‘Solo (Maybe String)’ - with actual type ‘Maybe [Char]’ + • Couldn't match expected type: Solo (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 ‘Solo (Maybe [Char])’ + • Couldn't match expected type: Maybe String + with actual type: Solo (Maybe String) • In the expression: Solo Just "wat" In an equation for ‘bar’: bar = (Solo Just "wat") T17380.hs:15:6: error: - • Couldn't match expected type ‘Solo (Maybe String)’ - with actual type ‘Maybe [Char]’ + • Couldn't match expected type: Solo (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 ‘Solo (Maybe [Char])’ + • Couldn't match expected type: Maybe String + with actual type: Solo (Maybe String) • In the pattern: Solo(Just "wat") In an equation for ‘quux’: quux (Solo(Just "wat")) = Just "frerf" T17380.hs:21:8: error: - • Couldn't match type ‘Maybe String’ with ‘'Solo (Maybe String)’ - Expected type: Proxy ('Solo (Maybe String)) - Actual type: Proxy (Maybe String) + • Couldn't match type: Maybe String + with: 'Solo (Maybe String) + Expected: Proxy ('Solo (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 ‘'Solo (Maybe String)’ with ‘Maybe String’ - Expected type: Proxy (Maybe String) - Actual type: Proxy ('Solo (Maybe String)) + • Couldn't match type: 'Solo (Maybe String) + with: Maybe String + Expected: Proxy (Maybe String) + Actual: Proxy ('Solo (Maybe String)) • In the expression: Proxy :: Proxy ('Solo Maybe String) In an equation for ‘fred’: fred = Proxy :: Proxy ('Solo 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/T17775-view-pats.hs b/testsuite/tests/typecheck/should_compile/T17775-view-pats.hs new file mode 100644 index 0000000000..8ffd704d9c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-view-pats.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE RankNTypes, ViewPatterns #-} + +module ViewPats where + +ex1 :: forall a. a -> a -> Int -> Eq a => Bool +-- Accept; we skolemise over three args +ex1 x ((== x) -> result) _ = result + +{- +ex2 :: forall a. a -> a -> Int -> Eq a => Bool +-- Reject: only skolemise over two args +ex2 x ((== x) -> result) = \ _ -> result + +ex3 :: forall a. a -> a -> Int -> Eq a => Bool +-- Reject: only skolemise over two args +-- const (result :: Bool) :: b -> Eq a => Bool +ex3 x ((== x) -> result) = const result +-} + +ex4 :: forall a. a -> a -> Int -> Eq a => Bool +-- Accept +ex4 x y _ = x == y + +ex5 :: forall a. a -> a -> Int -> Eq a => Bool +-- Accept +ex5 x y = \ _ -> x == y + +{- +ex6 :: forall a. a -> a -> Int -> Eq a => Bool +-- Reject. Needs (const (bla :: Bool)) :: Int -> Eq a => Bool +ex6 x y = const (x == y) +-} + +ex7 :: forall a. a -> a -> Eq a => Bool +-- Accept +ex7 x ((== x) -> result) = result + +ex8 :: forall a. a -> a -> Eq a => Bool +-- Accept +ex8 x y = x == y + +ex9 :: forall a. a -> Eq a => a -> Bool +-- Accept +ex9 x ((== x) -> result) = result + +ex10 :: forall a. a -> Eq a => a -> Bool +-- Accept +ex10 x y = x == y + +ex11 :: forall a. a -> Eq a => a -> Bool +-- Accept +ex11 x = (== x) diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs new file mode 100644 index 0000000000..96deb25631 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE RankNTypes, ViewPatterns #-} + +module ViewPats where + +ex1 :: forall a. a -> a -> Int -> Eq a => Bool +-- Accept; we skolemise over three args +ex1 x ((== x) -> result) _ = result + +ex4 :: forall a. a -> a -> Int -> Eq a => Bool +-- Accept +ex4 x y _ = x == y + +ex5 :: forall a. a -> a -> Int -> Eq a => Bool +-- Accept +ex5 x y = \ _ -> x == y + +ex7 :: forall a. a -> a -> Eq a => Bool +-- Accept +ex7 x ((== x) -> result) = result + +ex8 :: forall a. a -> a -> Eq a => Bool +-- Accept +ex8 x y = x == y + +ex9 :: forall a. a -> Eq a => a -> Bool +-- Accept +ex9 x ((== x) -> result) = result + +ex10 :: forall a. a -> Eq a => a -> Bool +-- Accept +ex10 x y = x == y + +ex11 :: forall a. a -> Eq a => a -> Bool +-- Accept +ex11 x = (== x) diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs new file mode 100644 index 0000000000..18a6ec8da6 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes, ViewPatterns #-} + +module ViewPats where + +ex2 :: forall a. a -> a -> Int -> Eq a => Bool +-- Reject: only skolemise over two args +ex2 x ((== x) -> result) = \ _ -> result diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr new file mode 100644 index 0000000000..e631106dd0 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr @@ -0,0 +1,10 @@ + +T17775-viewpats-b.hs:7:9: error: + • No instance for (Eq a) arising from a use of ‘==’ + Possible fix: + add (Eq a) to the context of + the type signature for: + ex2 :: forall a. a -> a -> Int -> Eq a => Bool + • In the expression: == x + In the pattern: (== x) -> result + In an equation for ‘ex2’: ex2 x ((== x) -> result) = \ _ -> result diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs new file mode 100644 index 0000000000..78b4e9d0b5 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes, ViewPatterns #-} + +module ViewPats where + +ex3 :: forall a. a -> a -> Int -> Eq a => Bool +-- Reject: only skolemise over two args +-- const (result :: Bool) :: b -> Eq a => Bool +ex3 x ((== x) -> result) = const result diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr new file mode 100644 index 0000000000..a0456c5a70 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr @@ -0,0 +1,11 @@ + +T17775-viewpats-c.hs:8:28: error: + • Couldn't match type ‘Bool’ with ‘Eq a => Bool’ + Expected: Int -> Eq a => Bool + Actual: Int -> Bool + • In the expression: const result + In an equation for ‘ex3’: ex3 x ((== x) -> result) = const result + • Relevant bindings include + x :: a (bound at T17775-viewpats-c.hs:8:5) + ex3 :: a -> a -> Int -> Eq a => Bool + (bound at T17775-viewpats-c.hs:8:1) diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs new file mode 100644 index 0000000000..3a133d7930 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes, ViewPatterns #-} + +module ViewPats where + +ex6 :: forall a. a -> a -> Int -> Eq a => Bool +-- Reject. Needs (const (bla :: Bool)) :: Int -> Eq a => Bool +ex6 x y = const (x == y) diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr new file mode 100644 index 0000000000..e270cecc25 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr @@ -0,0 +1,12 @@ + +T17775-viewpats-d.hs:7:11: error: + • Couldn't match type ‘Bool’ with ‘Eq a => Bool’ + Expected: Int -> Eq a => Bool + Actual: Int -> Bool + • In the expression: const (x == y) + In an equation for ‘ex6’: ex6 x y = const (x == y) + • Relevant bindings include + y :: a (bound at T17775-viewpats-d.hs:7:7) + x :: a (bound at T17775-viewpats-d.hs:7:5) + ex6 :: a -> a -> Int -> Eq a => Bool + (bound at T17775-viewpats-d.hs:7:1) 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 3189595fc3..b4ac6c9916 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']) @@ -684,7 +685,7 @@ test('UnliftedNewtypesUnifySig', normal, compile, ['']) test('UnliftedNewtypesForall', normal, compile, ['']) test('UnlifNewUnify', normal, compile, ['']) test('UnliftedNewtypesLPFamily', normal, compile, ['']) -test('UnliftedNewtypesDifficultUnification', normal, compile, ['']) +test('UnliftedNewtypesDifficultUnification', when(compiler_debugged(), expect_broken(18300)), compile, ['']) test('T16832', normal, ghci_script, ['T16832.script']) test('T16995', normal, compile, ['']) test('T17007', normal, compile, ['']) @@ -711,3 +712,7 @@ test('T18129', expect_broken(18129), compile, ['']) test('T18185', normal, compile, ['']) test('ExplicitSpecificityA1', normal, compile, ['']) test('ExplicitSpecificityA2', normal, compile, ['']) +test('T17775-viewpats-a', normal, compile, ['']) +test('T17775-viewpats-b', normal, compile_fail, ['']) +test('T17775-viewpats-c', normal, compile_fail, ['']) +test('T17775-viewpats-d', normal, compile_fail, ['']) 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' } diff --git a/utils/haddock b/utils/haddock -Subproject 60c85324ae083e2ac3d6180c0f20db5cdb31168 +Subproject 792b82861a8abd03579a281dfdcbbb708166899 |