[Git][ghc/ghc][wip/sand-witch/lazy-skol] 3 commits: Update test results

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Sun Jan 28 22:26:45 UTC 2024



Simon Peyton Jones pushed to branch wip/sand-witch/lazy-skol at Glasgow Haskell Compiler / GHC


Commits:
700d4b61 by Simon Peyton Jones at 2024-01-28T17:03:59+00:00
Update test results

- - - - -
ad9d80f2 by Simon Peyton Jones at 2024-01-28T17:05:12+00:00
Remove dead reconstructCheckType

- - - - -
82cda64c by Simon Peyton Jones at 2024-01-28T22:25:30+00:00
Undo HsMatchContext refactor

I have re-discovered why I did the refactor of `HsMatchContext`.

I have now put it back the way it was.  Notice the utterly horrible function
`convertHsMatchCtxt` in GHC.Tc.Gen.Match. It is a complete no-op, but it is
necessary to convert `HsMatchContext GhcRn` to `HsMatchContext GhcTc`.

If we parameterise `HsMatchContext` over the payload of `mc_fun`, thus:
```
data HsMatchContext fn
  = FunRhs
      { mc_fun        :: fn
      , .. }
```
then all is well, because
```
    HsMatchContext (LIdP (NoGhcTc GhcRn))   =   HsMatchContext (LIdP (NoGhcTc GhcTc))
```
But if we wrap it up as now, that is no longer apparent and we we have to do this
no-op conversion.

I am inclined to implement the refactor above to avoid this silly conversion.
Really all we want in `mc_fun` is a `Name`... but we can't have `mc_fun :: Name`, because
the parser can't do that.  Hence all this dancing around.  See #20415 which concludes
that we can't unravel this mess until we find someone who understands HIE.

- - - - -


19 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Pmc/Utils.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- testsuite/tests/indexed-types/should_compile/T10806.stderr
- testsuite/tests/indexed-types/should_fail/T8518.stderr
- testsuite/tests/typecheck/should_fail/T13902.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/T9605.stderr


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -1460,7 +1460,7 @@ pprMatch (Match { m_pats = pats, m_ctxt = ctxt, m_grhss = grhss })
                    _     -> pprPanic "pprMatch" (ppr ctxt $$ ppr pats)
 
 pprGRHSs :: (OutputableBndrId idR, Outputable body)
-         => HsMatchContext_ fnd -> GRHSs (GhcPass idR) body -> SDoc
+         => HsMatchContext fn -> GRHSs (GhcPass idR) body -> SDoc
 pprGRHSs ctxt (GRHSs _ grhss binds)
   = vcat (map (pprGRHS ctxt . unLoc) grhss)
   -- Print the "where" even if the contents of the binds is empty. Only
@@ -1469,17 +1469,17 @@ pprGRHSs ctxt (GRHSs _ grhss binds)
       (text "where" $$ nest 4 (pprBinds binds))
 
 pprGRHS :: (OutputableBndrId idR, Outputable body)
-        => HsMatchContext_ fn -> GRHS (GhcPass idR) body -> SDoc
+        => HsMatchContext fn -> GRHS (GhcPass idR) body -> SDoc
 pprGRHS ctxt (GRHS _ [] body)
  =  pp_rhs ctxt body
 
 pprGRHS ctxt (GRHS _ guards body)
  = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]
 
-pp_rhs :: Outputable body => HsMatchContext_ fn -> body -> SDoc
+pp_rhs :: Outputable body => HsMatchContext fn -> body -> SDoc
 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 
-matchSeparator :: HsMatchContext_ fn -> SDoc
+matchSeparator :: HsMatchContext fn -> SDoc
 matchSeparator FunRhs{}         = text "="
 matchSeparator CaseAlt          = text "->"
 matchSeparator LamAlt{}         = text "->"
@@ -1943,7 +1943,7 @@ pp_dotdot = text " .. "
 ************************************************************************
 -}
 
-instance Outputable fn => Outputable (HsMatchContext_ fn) where
+instance Outputable (LIdP (NoGhcTc p)) => Outputable (HsMatchContext p) where
   ppr m@(FunRhs{})            = text "FunRhs" <+> ppr (mc_fun m) <+> ppr (mc_fixity m)
   ppr CaseAlt                 = text "CaseAlt"
   ppr (LamAlt lam_variant)    = text "LamAlt" <+> ppr lam_variant
@@ -1984,11 +1984,11 @@ pprHsArrType HsFirstOrderApp  = text "first order arrow application"
 
 -----------------
 
-instance Outputable fn => Outputable (HsStmtContext_ fn) where
+instance Outputable (LIdP (NoGhcTc p)) => Outputable (HsStmtContext p) where
     ppr = pprStmtContext
 
 -- Used to generate the string for a *runtime* error message
-matchContextErrString :: Outputable fn => HsMatchContext_ fn -> SDoc
+matchContextErrString :: Outputable (LIdP (NoGhcTc p)) => HsMatchContext p -> SDoc
 matchContextErrString (FunRhs{mc_fun=fun})          = text "function" <+> ppr fun
 matchContextErrString CaseAlt                       = text "case"
 matchContextErrString (LamAlt lam_variant)          = lamCaseKeyword lam_variant
@@ -2028,10 +2028,10 @@ pprMatchInCtxt match  = hang (text "In" <+> pprMatchContext (m_ctxt match)
 
 pprStmtInCtxt :: (OutputableBndrId idL,
                   OutputableBndrId idR,
-                  Outputable fn,
+                  Outputable (LIdP (NoGhcTc p)),
                   Outputable body,
                  Anno (StmtLR (GhcPass idL) (GhcPass idR) body) ~ SrcSpanAnnA)
-              => HsStmtContext_ fn
+              => HsStmtContext p
               -> StmtLR (GhcPass idL) (GhcPass idR) body
               -> SDoc
 pprStmtInCtxt ctxt (LastStmt _ e _ _)
@@ -2047,7 +2047,7 @@ pprStmtInCtxt ctxt stmt
                         , trS_form = form }) = pprTransStmt by using form
     ppr_stmt stmt = pprStmt stmt
 
-pprMatchContext :: Outputable fn => HsMatchContext_ fn -> SDoc
+pprMatchContext :: Outputable (LIdP (NoGhcTc p)) => HsMatchContext p -> SDoc
 pprMatchContext ctxt
   | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt
   | otherwise    = text "a"  <+> pprMatchContextNoun ctxt
@@ -2058,7 +2058,7 @@ pprMatchContext ctxt
     want_an LazyPatCtx                               = True
     want_an _                                        = False
 
-pprMatchContextNoun :: Outputable fn => HsMatchContext_ fn -> SDoc
+pprMatchContextNoun :: Outputable (LIdP (NoGhcTc p)) => HsMatchContext p -> SDoc
 pprMatchContextNoun (FunRhs {mc_fun=fun})   = text "equation for" <+> quotes (ppr fun)
 pprMatchContextNoun CaseAlt                 = text "case alternative"
 pprMatchContextNoun (LamAlt LamSingle)      = text "lambda abstraction"
@@ -2076,7 +2076,7 @@ pprMatchContextNoun (StmtCtxt ctxt)         = text "pattern binding in"
 pprMatchContextNoun PatSyn                  = text "pattern synonym declaration"
 pprMatchContextNoun LazyPatCtx              = text "irrefutable pattern"
 
-pprMatchContextNouns :: Outputable fn => HsMatchContext_ fn -> SDoc
+pprMatchContextNouns :: Outputable (LIdP (NoGhcTc p)) => HsMatchContext p -> SDoc
 pprMatchContextNouns (FunRhs {mc_fun=fun})   = text "equations for" <+> quotes (ppr fun)
 pprMatchContextNouns PatBindGuards           = text "pattern binding guards"
 pprMatchContextNouns (ArrowMatchCtxt c)      = pprArrowMatchContextNouns c
@@ -2099,7 +2099,7 @@ pprArrowMatchContextNouns (ArrowLamAlt lam_variant) = lamCaseKeyword lam_variant
 pprArrowMatchContextNouns ctxt                      = pprArrowMatchContextNoun ctxt <> char 's'
 
 -----------------
-pprAStmtContext, pprStmtContext :: Outputable fn => HsStmtContext_ fn -> SDoc
+pprAStmtContext, pprStmtContext :: Outputable (LIdP (NoGhcTc p)) => HsStmtContext p -> SDoc
 pprAStmtContext (HsDoStmt flavour) = pprAHsDoFlavour flavour
 pprAStmtContext ctxt = text "a" <+> pprStmtContext ctxt
 


=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -385,8 +385,16 @@ deriving instance Data (ApplicativeArg GhcTc)
 
 deriving instance Data HsArrowMatchContext
 deriving instance Data HsDoFlavour
-deriving instance Data fn => Data (HsStmtContext_ fn)
-deriving instance Data fn => Data (HsMatchContext_ fn)
+
+-- Triplicated instances -- ugh!
+deriving instance Data (HsStmtContext GhcPs)
+deriving instance Data (HsStmtContext GhcRn)
+deriving instance Data (HsStmtContext GhcTc)
+
+-- Triplicated instances -- ugh!
+deriving instance Data (HsMatchContext GhcPs)
+deriving instance Data (HsMatchContext GhcRn)
+deriving instance Data (HsMatchContext GhcTc)
 
 -- deriving instance (DataIdLR p p) => Data (HsUntypedSplice p)
 deriving instance Data (HsUntypedSplice GhcPs)


=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -899,7 +899,7 @@ mkSimpleGeneratedFunBind loc fun pats expr
     ctxt = mkPrefixFunRhs (L (noAnnSrcSpan loc) fun)
 
 -- | Make a prefix, non-strict function 'HsMatchContext'
-mkPrefixFunRhs :: fn -> HsMatchContext_ fn
+mkPrefixFunRhs ::  LIdP (NoGhcTc p) -> HsMatchContext p
 mkPrefixFunRhs n = FunRhs { mc_fun        = n
                           , mc_fixity     = Prefix
                           , mc_strictness = NoSrcStrict }
@@ -917,6 +917,7 @@ mkMatch ctxt pats expr binds
                   , m_pats  = map mkParPat pats
                   , m_grhss = GRHSs emptyComments (unguardedRHS noAnn noSrcSpan expr) binds })
 
+
 {-
 ************************************************************************
 *                                                                      *


=====================================
compiler/GHC/HsToCore/Pmc/Utils.hs
=====================================
@@ -65,13 +65,13 @@ allPmCheckWarnings =
   ]
 
 -- | Check whether the redundancy checker should run (redundancy only)
-overlapping :: DynFlags -> HsMatchContext_ fn -> Bool
+overlapping :: DynFlags -> HsMatchContext p -> Bool
 -- See Note [Inaccessible warnings for record updates]
 overlapping _      RecUpd = False
 overlapping dflags _      = wopt Opt_WarnOverlappingPatterns dflags
 
 -- | Check whether the exhaustiveness checker should run (exhaustiveness only)
-exhaustive :: DynFlags -> HsMatchContext_ fn -> Bool
+exhaustive :: DynFlags -> HsMatchContext p -> Bool
 exhaustive  dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag
 
 -- | Check whether unnecessary bangs should be warned about
@@ -81,7 +81,7 @@ redundantBang dflags = wopt Opt_WarnRedundantBangPatterns dflags
 -- | Denotes whether an exhaustiveness check is supported, and if so,
 -- via which 'WarningFlag' it's controlled.
 -- Returns 'Nothing' if check is not supported.
-exhaustiveWarningFlag :: HsMatchContext_ fn -> Maybe WarningFlag
+exhaustiveWarningFlag :: HsMatchContext p -> Maybe WarningFlag
 exhaustiveWarningFlag FunRhs{}           = Just Opt_WarnIncompletePatterns
 exhaustiveWarningFlag CaseAlt            = Just Opt_WarnIncompletePatterns
 exhaustiveWarningFlag IfAlt              = Just Opt_WarnIncompletePatterns
@@ -109,14 +109,14 @@ arrowMatchContextExhaustiveWarningFlag = \ case
 -- | Check whether any part of pattern match checking is enabled for this
 -- 'HsMatchContext' (does not matter whether it is the redundancy check or the
 -- exhaustiveness check).
-isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext_ fn -> Bool
+isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext p -> Bool
 isMatchContextPmChecked dflags origin ctxt
   =  requiresPMC origin
   && (overlapping dflags ctxt || exhaustive dflags ctxt)
 
 -- | Check whether exhaustivity checks are enabled for this 'HsMatchContext',
 -- when dealing with a single pattern (using the 'matchSinglePatVar' function).
-isMatchContextPmChecked_SinglePat :: DynFlags -> Origin -> HsMatchContext_ fn -> LPat GhcTc -> Bool
+isMatchContextPmChecked_SinglePat :: DynFlags -> Origin -> HsMatchContext p -> LPat GhcTc -> Bool
 isMatchContextPmChecked_SinglePat dflags origin ctxt pat
   | not (needToRunPmCheck dflags origin)
   = False


=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -2341,13 +2341,13 @@ by the Opt_QualifiedDo dynamic flag.
 
 -- Lookup operations for a qualified do. If the context is not a qualified
 -- do, then use lookupSyntaxExpr. See Note [QualifiedDo].
-lookupQualifiedDoExpr :: HsStmtContext_ fn -> Name -> RnM (HsExpr GhcRn, FreeVars)
+lookupQualifiedDoExpr :: HsStmtContext p -> Name -> RnM (HsExpr GhcRn, FreeVars)
 lookupQualifiedDoExpr ctxt std_name
   = first nl_HsVar <$> lookupQualifiedDoName ctxt std_name
 
 -- Like lookupQualifiedDoExpr but for producing SyntaxExpr.
 -- See Note [QualifiedDo].
-lookupQualifiedDo :: HsStmtContext_ fn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
+lookupQualifiedDo :: HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
 lookupQualifiedDo ctxt std_name
   = first mkSyntaxExpr <$> lookupQualifiedDoExpr ctxt std_name
 
@@ -2357,7 +2357,7 @@ lookupNameWithQualifier std_name modName
        ; return (qname, unitFV qname) }
 
 -- See Note [QualifiedDo].
-lookupQualifiedDoName :: HsStmtContext_ fn -> Name -> RnM (Name, FreeVars)
+lookupQualifiedDoName :: HsStmtContext p -> Name -> RnM (Name, FreeVars)
 lookupQualifiedDoName ctxt std_name
   = case qualifiedDoModuleName_maybe ctxt of
       Nothing -> lookupSyntaxName std_name


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -2677,7 +2677,7 @@ using fromString:
                         Nothing -> M.fail (fromString "Pattern match error")
 
 -}
-getMonadFailOp :: HsStmtContext_ fn -> RnM (FailOperator GhcRn, FreeVars) -- Syntax expr fail op
+getMonadFailOp :: HsStmtContext p -> RnM (FailOperator GhcRn, FreeVars) -- Syntax expr fail op
 getMonadFailOp ctxt
  = do { xOverloadedStrings <- fmap (xopt LangExt.OverloadedStrings) getDynFlags
       ; xRebindableSyntax <- fmap (xopt LangExt.RebindableSyntax) getDynFlags


=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -227,7 +227,7 @@ isTopRecNameMaker _ = False
 localRecNameMaker :: MiniFixityEnv -> NameMaker
 localRecNameMaker fix_env = LetMk NotTopLevel fix_env
 
-matchNameMaker :: HsMatchContext_ fn -> NameMaker
+matchNameMaker :: HsMatchContext fn -> NameMaker
 matchNameMaker ctxt = LamMk report_unused
   where
     -- Do not report unused names in interactive contexts


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -2403,7 +2403,7 @@ data TcRnMessage where
                 typecheck/should_fail/T20768_fail
   -}
   TcRnMatchesHaveDiffNumArgs
-    :: !(HsMatchContext GhcTc) -- ^ Pattern match specifics
+    :: !(HsMatchContext GhcRn) -- ^ Pattern match specifics
     -> !MatchArgBadMatches
     -> TcRnMessage
 


=====================================
compiler/GHC/Tc/Gen/Arrow.hs
=====================================
@@ -263,7 +263,7 @@ tc_cmd env cmd@(HsCmdLam x lam_variant match) cmd_ty
         LamSingle -> id    -- Avoids clutter in the vanilla-lambda form
         _         -> addErrCtxt (cmdCtxt cmd)) $
     do { let match_ctxt = ArrowLamAlt lam_variant
-       ; arity <- checkArgCounts (ArrowMatchCtxt match_ctxt) match
+       ; arity <- checkArgCounts match
        ; (wrap, match') <- tcCmdMatchLambda env match_ctxt arity match cmd_ty
        ; return (mkHsCmdWrap wrap (HsCmdLam x lam_variant match')) }
 
@@ -319,11 +319,9 @@ tcCmdMatches :: CmdEnv
              -> CmdType
              -> TcM (HsWrapper, MatchGroup GhcTc (LHsCmd GhcTc))
 tcCmdMatches env scrut_ty matches (stk, res_ty)
-  = tcCaseMatches match_ctxt (unrestricted scrut_ty) matches (mkCheckExpType res_ty)
+  = tcCaseMatches tc_body (unrestricted scrut_ty) matches (mkCheckExpType res_ty)
   where
-    match_ctxt = MC { mc_what = ArrowMatchCtxt ArrowCaseAlt,
-                      mc_body = mc_body }
-    mc_body body res_ty' = do { res_ty' <- expTypeToType res_ty'
+    tc_body body res_ty' = do { res_ty' <- expTypeToType res_ty'
                               ; tcCmd env body (stk, res_ty') }
 
 -- | Typechecking for 'HsCmdLam' and 'HsCmdLamCase'.


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -57,8 +57,8 @@ import GHC.Rename.Expr        ( mkExpandedExpr )
 import GHC.Rename.Env         ( addUsedGRE, getUpdFieldLbls )
 import GHC.Tc.Utils.Env
 import GHC.Tc.Gen.Arrow
-import GHC.Tc.Gen.Match( TcMatchCtxt(..), tcBody, tcLambdaMatches, tcCaseMatches
-                       , tcGRHS, tcDoStmts )
+import GHC.Tc.Gen.Match( tcBody, tcLambdaMatches, tcCaseMatches
+                       , tcGRHSList, tcDoStmts )
 import GHC.Tc.Gen.HsType
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Zonk.TcType
@@ -430,7 +430,7 @@ tcExpr (HsLet x binds expr) res_ty
           -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; return (HsLet x binds' (mkLHsWrap wrapper expr')) }
 
-tcExpr (HsCase x scrut matches) res_ty
+tcExpr (HsCase ctxt scrut matches) res_ty
   = do  {  -- We used to typecheck the case alternatives first.
            -- The case patterns tend to give good type info to use
            -- when typechecking the scrutinee.  For example
@@ -452,11 +452,8 @@ tcExpr (HsCase x scrut matches) res_ty
 
         ; traceTc "HsCase" (ppr scrut_ty)
         ; hasFixedRuntimeRep_syntactic FRRCase scrut_ty
-        ; (mult_co_wrap, matches') <- tcCaseMatches match_ctxt (Scaled mult scrut_ty) matches res_ty
-        ; return (HsCase x (mkLHsWrap mult_co_wrap scrut') matches') }
- where
-    match_ctxt = MC { mc_what = x,
-                      mc_body = tcBody }
+        ; (mult_co_wrap, matches') <- tcCaseMatches tcBody (Scaled mult scrut_ty) matches res_ty
+        ; return (HsCase ctxt (mkLHsWrap mult_co_wrap scrut') matches') }
 
 tcExpr (HsIf x pred b1 b2) res_ty
   = do { pred'    <- tcCheckMonoExpr pred boolTy
@@ -490,14 +487,10 @@ Not using 'sup' caused #23814.
 -}
 
 tcExpr (HsMultiIf _ alts) res_ty
-  = do { (ues, alts') <- mapAndUnzipM tc_alt alts
+  = do { alts' <- tcGRHSList IfAlt tcBody alts res_ty
+                  -- See Note [MultiWayIf linearity checking]
        ; res_ty <- readExpType res_ty
-       ; tcEmitBindingUsage (supUEs ues)  -- See Note [MultiWayIf linearity checking]
        ; return (HsMultiIf res_ty alts') }
-  where
-    match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody }
-    tc_alt alt = tcCollectingUsage $
-                 wrapLocMA (tcGRHS match_ctxt res_ty) alt
 
 tcExpr (HsDo _ do_or_lc stmts) res_ty
   = tcDoStmts do_or_lc stmts res_ty


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -4,6 +4,7 @@
 {-# LANGUAGE RecordWildCards  #-}
 {-# LANGUAGE TupleSections    #-}
 {-# LANGUAGE TypeFamilies     #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
 
@@ -18,9 +19,8 @@ module GHC.Tc.Gen.Match
    ( tcFunBindMatches
    , tcCaseMatches
    , tcLambdaMatches
-   , tcGRHS
+   , tcGRHSList
    , tcGRHSsPat
-   , TcMatchCtxt(..)
    , TcStmtChecker
    , TcExprStmtChecker
    , TcCmdStmtChecker
@@ -105,7 +105,7 @@ tcFunBindMatches :: UserTypeCtxt -> Name
 tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
   = assertPpr (funBindPrecondition matches) (pprMatches matches) $
     do  {  -- Check that they all have the same no of arguments
-          arity <- checkArgCounts hs_match_ctxt matches
+          arity <- checkArgCounts matches
 
         ; traceTc "tcFunBindMatches" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)
 
@@ -117,17 +117,10 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
 
                 do { traceTc "tcFunBindMatches" (vcat [ pprUserTypeCtxt ctxt, ppr invis_pat_tys
                                                       , ppr pat_tys $$ ppr exp_ty ])
-                   ; tcMatches tc_match_ctxt (invis_pat_tys ++ pat_tys) rhs_ty matches }
+                   ; tcMatches tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches }
 
         ; return (wrap_fun <.> wrap_mult, r) }
   where
-    -- In this block of pattern bindings, funBindPrecondition ensures that the matches succeed
-    match1        :: Match GhcRn (LHsExpr GhcRn)
-    hs_match_ctxt :: HsMatchContext GhcRn
-    (L _ match1 : _) = unLoc (mg_alts matches)
-    Match { m_ctxt = hs_match_ctxt } = match1
-
-    tc_match_ctxt = MC { mc_what = hs_match_ctxt, mc_body = tcBody }
     herald        = ExpectedFunTyMatches (NameThing fun_name) matches
 
 funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
@@ -143,16 +136,15 @@ tcLambdaMatches :: HsExpr GhcRn -> HsLamVariant
                 -> ExpSigmaType  -- NB can be a sigma-type
                 -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
 tcLambdaMatches e lam_variant matches invis_pat_tys res_ty
-  =  do { arity <- checkArgCounts (mc_what match_ctxt) matches
+  =  do { arity <- checkArgCounts matches
             -- Check argument counts since this is also used for \cases
 
         ; (wrapper, (mult_co_wrap, r))
             <- matchExpectedFunTys herald GenSigCtxt arity res_ty $ \ pat_tys rhs_ty ->
-               tcMatches match_ctxt (invis_pat_tys ++ pat_tys) rhs_ty matches
+               tcMatches tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches
 
         ; return (wrapper <.> mult_co_wrap, r) }
   where
-    match_ctxt = MC { mc_what = LamAlt lam_variant, mc_body = tcBody }
     herald = ExpectedFunTyLam lam_variant e
              -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
 
@@ -161,17 +153,17 @@ tcLambdaMatches e lam_variant matches invis_pat_tys res_ty
 parser guarantees that each equation has exactly one argument.
 -}
 
-tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc)) =>
-                TcMatchCtxt body      -- ^ Case context
-             -> Scaled TcSigmaTypeFRR -- ^ Type of scrutinee
-             -> MatchGroup GhcRn (LocatedA (body GhcRn)) -- ^ The case alternatives
-             -> ExpRhoType                               -- ^ Type of the whole case expression
-             -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
+tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc))
+              => TcMatchBodyChecker body   -- ^ Typecheck the alternative RHSS
+              -> Scaled TcSigmaTypeFRR     -- ^ Type of scrutinee
+              -> MatchGroup GhcRn (LocatedA (body GhcRn)) -- ^ The case alternatives
+              -> ExpRhoType                               -- ^ Type of the whole case expression
+              -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
                 -- Translated alternatives
                 -- wrapper goes from MatchGroup's ty to expected ty
 
-tcCaseMatches ctxt (Scaled scrut_mult scrut_ty) matches res_ty
-  = tcMatches ctxt [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches
+tcCaseMatches tc_body (Scaled scrut_mult scrut_ty) matches res_ty
+  = tcMatches tc_body [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches
 
 -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind at .
 
@@ -180,13 +172,9 @@ tcGRHSsPat :: Mult -> GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType
 -- Used for pattern bindings
 tcGRHSsPat mult grhss res_ty
   = tcScalingUsage mult $ do
-    { (mult_co_wrapper, r) <- tcGRHSs match_ctxt grhss res_ty
+    { (mult_co_wrapper, r) <- tcGRHSs PatBindRhs tcBody grhss res_ty
     ; return $ mkWrap mult_co_wrapper r }
   where
-    match_ctxt :: TcMatchCtxt HsExpr -- AZ
-    match_ctxt = MC { mc_what = PatBindRhs,
-                      mc_body = tcBody }
-
     mkWrap wrap grhss@(GRHSs { grhssGRHSs = L loc (GRHS x guards body) : rhss }) =
       grhss { grhssGRHSs = L loc (GRHS x guards (mkLHsWrap wrap body)) : rhss }
     mkWrap _ (GRHSs { grhssGRHSs = [] }) = panic "tcGRHSsPat: empty GHRSs"
@@ -203,12 +191,10 @@ tcGRHSsPat mult grhss res_ty
 *                                                                      *
 ********************************************************************* -}
 
-data TcMatchCtxt body   -- c.f. TcStmtCtxt, also in this module
-  = MC { mc_what :: HsMatchContext GhcTc,  -- What kind of thing this is
-         mc_body :: LocatedA (body GhcRn)  -- Type checker for a body of
-                                           -- an alternative
-                 -> ExpRhoType
-                 -> TcM (LocatedA (body GhcTc)) }
+type TcMatchBodyChecker body
+  -- Type checker for a body of an alternative
+  -- c.f. TcStmtChecker, also in this module
+  = LocatedA (body GhcRn) -> ExpRhoType -> TcM (LocatedA (body GhcTc))
 
 type AnnoBody body
   = ( Outputable (body GhcRn)
@@ -223,14 +209,14 @@ type AnnoBody body
     )
 
 -- | Type-check a MatchGroup.
-tcMatches :: (AnnoBody body, Outputable (body GhcTc)) =>
-             TcMatchCtxt body
+tcMatches :: (AnnoBody body, Outputable (body GhcTc))
+          => TcMatchBodyChecker body
           -> [ExpPatType]             -- ^ Expected pattern types.
           -> ExpRhoType               -- ^ Expected result-type of the Match.
           -> MatchGroup GhcRn (LocatedA (body GhcRn))
           -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
 
-tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
+tcMatches tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
                                   , mg_ext = origin })
   | null matches  -- Deal with case e of {}
     -- Since there are no branches, no one else will fill in rhs_ty
@@ -244,7 +230,7 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
                                  }) }
 
   | otherwise
-  = do { umatches <- mapM (tcCollectingUsage . tcMatch ctxt pat_tys rhs_ty) matches
+  = do { umatches <- mapM (tcCollectingUsage . tcMatch tc_body pat_tys rhs_ty) matches
        ; let (usages, wmatches) = unzip umatches
        ; let (wrappers, matches') = unzip wmatches
        ; let wrapper = mconcat wrappers
@@ -264,40 +250,44 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
         match_fun_pat_ty ExpForAllPatTy{} = Nothing
 
 -------------
-tcMatch :: (AnnoBody body) => TcMatchCtxt body
+tcMatch :: (AnnoBody body)
+        => TcMatchBodyChecker body
         -> [ExpPatType]          -- Expected pattern types
         -> ExpRhoType            -- Expected result-type of the Match.
         -> LMatch GhcRn (LocatedA (body GhcRn))
         -> TcM (HsWrapper, LMatch GhcTc (LocatedA (body GhcTc)))
 
-tcMatch ctxt pat_tys rhs_ty match
-  = do { (L loc (wrapper, r)) <- wrapLocMA (tc_match ctxt pat_tys rhs_ty) match
+tcMatch tc_body pat_tys rhs_ty match
+  = do { (L loc (wrapper, r)) <- wrapLocMA (tc_match pat_tys rhs_ty) match
        ; return (wrapper, L loc r) }
   where
-    tc_match ctxt pat_tys rhs_ty
-             match@(Match { m_pats = pats, m_grhss = grhss })
-      = add_match_ctxt match $
-        do { (pats', (wrapper, grhss')) <- tcMatchPats (mc_what ctxt) pats pat_tys $
-                                           tcGRHSs ctxt grhss rhs_ty
+    tc_match pat_tys rhs_ty
+             match@(Match { m_ctxt = ctxt, m_pats = pats, m_grhss = grhss })
+      = add_match_ctxt $
+        do { let ctxt' = convertHsMatchCtxt ctxt   -- Ugh!
+
+           ; (pats', (wrapper, grhss')) <- tcMatchPats ctxt' pats pat_tys $
+                                           tcGRHSs ctxt' tc_body grhss rhs_ty
              -- NB: pats' are just the /value/ patterns
              -- See Note [tcMatchPats] in GHC.Tc.Gen.Pat
-           ; return (wrapper, Match { m_ext = noAnn
-                                    , m_ctxt = mc_what ctxt
-                                    , m_pats = pats'
+           ; return (wrapper, Match { m_ext   = noAnn
+                                    , m_ctxt  = ctxt'
+                                    , m_pats  = pats'
                                     , m_grhss = grhss' }) }
-
+      where
         -- For (\x -> e), tcExpr has already said "In the expression \x->e"
         --     so we don't want to add "In the lambda abstraction \x->e"
         -- But for \cases with many alternatives, it is helpful to say
         --     which particular alternative we are looking at
-    add_match_ctxt match thing_inside
-        = case mc_what ctxt of
+        add_match_ctxt thing_inside = case ctxt of
             LamAlt LamSingle -> thing_inside
             _                -> addErrCtxt (pprMatchInCtxt match) thing_inside
 
 -------------
 tcGRHSs :: AnnoBody body
-        => TcMatchCtxt body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType
+        => HsMatchContext GhcTc
+        -> TcMatchBodyChecker body
+        -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType
         -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
 
 -- Notice that we pass in the full res_ty, so that we get
@@ -306,26 +296,32 @@ tcGRHSs :: AnnoBody body
 -- We used to force it to be a monotype when there was more than one guard
 -- but we don't need to do that any more
 
-tcGRHSs ctxt (GRHSs _ grhss binds) res_ty
-  = do  { (binds', wrapper, grhss')
-            <- tcLocalBinds binds $ do
-               { ugrhss <- mapM (tcCollectingUsage . wrapLocMA (tcGRHS ctxt res_ty)) grhss
-               ; let (usages, grhss') = unzip ugrhss
-               ; tcEmitBindingUsage $ supUEs usages
-               ; return grhss' }
+tcGRHSs ctxt tc_body (GRHSs _ grhss binds) res_ty
+  = do  { (binds', wrapper, grhss') <- tcLocalBinds binds $ do
+                                       tcGRHSList ctxt tc_body grhss res_ty
         ; return (wrapper, GRHSs emptyComments grhss' binds') }
 
--------------
-tcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (LocatedA (body GhcRn))
-       -> TcM (GRHS GhcTc (LocatedA (body GhcTc)))
-
-tcGRHS ctxt res_ty (GRHS _ guards rhs)
-  = do  { (guards', rhs')
-            <- tcStmtsAndThen stmt_ctxt tcGuardStmt guards res_ty $
-               mc_body ctxt rhs
-        ; return (GRHS noAnn guards' rhs') }
-  where
-    stmt_ctxt  = PatGuard (mc_what ctxt)
+tcGRHSList :: forall body. AnnoBody body
+           => HsMatchContext GhcTc -> TcMatchBodyChecker body
+           -> [LGRHS GhcRn (LocatedA (body GhcRn))] -> ExpRhoType
+           -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))]
+tcGRHSList ctxt tc_body grhss res_ty
+   = do { -- (usages, grhss') <- mapAndUnzipM (wrapLocSndMA tc_alt) grhss
+        ; stuff <- mapM (wrapLocSndMA tc_alt) grhss
+        ; let (usages, grhss') = unzip stuff
+        ; tcEmitBindingUsage $ supUEs usages
+        ; return grhss' }
+   where
+     stmt_ctxt  = PatGuard ctxt
+
+     tc_alt :: GRHS GhcRn (LocatedA (body GhcRn))
+            -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc)))
+     tc_alt (GRHS _ guards rhs)
+       = tcCollectingUsage $
+         do  { (guards', rhs')
+                   <- tcStmtsAndThen stmt_ctxt tcGuardStmt guards res_ty $
+                      tc_body rhs
+             ; return (GRHS noAnn guards' rhs') }
 
 {-
 ************************************************************************
@@ -1192,20 +1188,20 @@ the variables they bind into scope, and typecheck the thing_inside.
 --       f    False z = ...
 --       The MatchGroup for `f` has arity 2, not 3
 checkArgCounts :: AnnoBody body
-               => HsMatchContext GhcTc -> MatchGroup GhcRn (LocatedA (body GhcRn))
+               => MatchGroup GhcRn (LocatedA (body GhcRn))
                -> TcM Arity
-checkArgCounts _ (MG { mg_alts = L _ [] })
+checkArgCounts (MG { mg_alts = L _ [] })
     = return 1 -- See Note [Empty MatchGroups] in GHC.Rename.Bind
                --   case e of {} or \case {}
                -- Both have arity 1
 
-checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) })
+checkArgCounts (MG { mg_alts = L _ (match1:matches) })
     | null matches  -- There was only one match; nothing to check
     = return n_args1
 
     -- Two or more matches: check that they agree on arity
     | Just bad_matches <- mb_bad_matches
-    = failWithTc $ TcRnMatchesHaveDiffNumArgs matchContext
+    = failWithTc $ TcRnMatchesHaveDiffNumArgs (m_ctxt (unLoc match1))
                  $ MatchArgMatches match1 bad_matches
     | otherwise
     = return n_args1
@@ -1217,3 +1213,30 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) })
     -- Counts the number of /required/ args in the match
     -- IMPORTANT: THIS WILL NEED TO CHANGE WHEN @ty BECOMES A PATTERN
     reqd_args_in_match (L _ (Match { m_pats = pats })) = length pats
+
+
+-- | Ths horrible function converts HsMatchContext GhcRn to HsMatchContext GhcTc
+--   It is a little silly to do it this way as all except for FunRhs constructor, are independent
+--   of the GhcPass index parameter.
+convertHsMatchCtxt :: HsMatchContext GhcRn -> HsMatchContext GhcTc
+convertHsStmtCtxt  :: HsStmtContext GhcRn -> HsStmtContext GhcTc
+
+convertHsMatchCtxt CaseAlt            = CaseAlt
+convertHsMatchCtxt (LamAlt x)         = LamAlt x
+convertHsMatchCtxt IfAlt              = IfAlt
+convertHsMatchCtxt (ArrowMatchCtxt x) = ArrowMatchCtxt x
+convertHsMatchCtxt PatBindRhs         = PatBindRhs
+convertHsMatchCtxt LazyPatCtx         = LazyPatCtx
+convertHsMatchCtxt PatBindGuards      = CaseAlt
+convertHsMatchCtxt RecUpd             = RecUpd
+convertHsMatchCtxt (StmtCtxt x)       = StmtCtxt $ convertHsStmtCtxt x
+convertHsMatchCtxt ThPatSplice        = ThPatSplice
+convertHsMatchCtxt ThPatQuote         = ThPatQuote
+convertHsMatchCtxt PatSyn             = PatSyn
+convertHsMatchCtxt (FunRhs x y z)     = FunRhs x y z
+
+convertHsStmtCtxt (HsDoStmt x)      = HsDoStmt x
+convertHsStmtCtxt (PatGuard x)      = PatGuard $ convertHsMatchCtxt x
+convertHsStmtCtxt (ParStmtCtxt x)   = ParStmtCtxt $ convertHsStmtCtxt x
+convertHsStmtCtxt (TransStmtCtxt x) = TransStmtCtxt $ convertHsStmtCtxt x
+convertHsStmtCtxt ArrowExpr         = ArrowExpr


=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -30,7 +30,7 @@ module GHC.Tc.Utils.TcType (
   ExpType(..), InferResult(..),
   ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR,
   ExpRhoType,
-  mkCheckExpType, reconstructCheckType,
+  mkCheckExpType,
   checkingExpType_maybe, checkingExpType,
 
   ExpPatType(..), mkInvisExpPatType, isVisibleExpPatType, isExpFunPatType,
@@ -475,18 +475,6 @@ isExpFunPatType :: ExpPatType -> Bool
 isExpFunPatType ExpFunPatTy{}    = True
 isExpFunPatType ExpForAllPatTy{} = False
 
-reconstructCheckType :: [ExpPatType] -> ExpType -> TcType
--- Precondition: all the arguments are Check{}
-reconstructCheckType pat_tys res_ty
-  = foldr go (checkingExpType res_ty) pat_tys
-  where
-    go :: ExpPatType -> TcType -> TcType
-    go (ExpFunPatTy (Scaled u v)) res_ty
-      = tcMkVisFunTy u (checkingExpType v) res_ty
-    go (ExpForAllPatTy bndr) res_ty
-      | isVisibleForAllTyBinder bndr = mkForAllTy bndr res_ty
-      | otherwise                    = res_ty
-
 instance Outputable ExpPatType where
   ppr (ExpFunPatTy t) = ppr t
   ppr (ExpForAllPatTy tv) = text "forall" <+> ppr tv


=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -853,9 +853,6 @@ matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside
     check n_so_far rev_pat_tys res_ty
       = addErrCtxtM (mkFunTysMsg herald (arity, top_ty))  $
         defer n_so_far rev_pat_tys res_ty
---      where
---        res_exp_ty = mkCheckExpType res_ty
---        fun_ty = reconstructCheckType (reverse rev_pat_tys) res_exp_ty
 
     ------------
     defer :: Arity -> [ExpPatType] -> TcRhoType -> TcM (HsWrapper, a)
@@ -897,7 +894,7 @@ mkFunTysMsg herald (n_val_args_in_call, fun_ty) env
                  = text "In the result of a function call"
                  | otherwise
                  = hang (full_herald <> comma)
-                      2 (sep [ text "but its type" <+> quotes (pprType fun_ty)
+                      2 (sep [ text "but its type" <+> quotes (pprSigmaType fun_ty)
                              , if n_fun_args == 0 then text "has none"
                                else text "has only" <+> speakN n_fun_args])
 


=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -1529,13 +1529,14 @@ data ArithSeqInfo id
 --
 -- Context of a pattern match. This is more subtle than it would seem. See
 -- Note [FunBind vs PatBind].
-type HsMatchContext p = HsMatchContext_ (LIdP (NoGhcTc p))
+-- type HsMatchContext p = HsMatchContext_ (LIdP (NoGhcTc p))
 
-data HsMatchContext_ fn
+data HsMatchContext p
   = FunRhs
     -- ^ A pattern matching on an argument of a
     -- function binding
-      { mc_fun        :: fn    -- ^ function binder of @f@
+--      { mc_fun        :: fn    -- ^ function binder of @f@
+      { mc_fun        :: LIdP (NoGhcTc p)    -- ^ function binder of @f@
                                              -- See Note [mc_fun field of FunRhs]
                                              -- See #20415 for a long discussion about
                                              -- this field and why it uses NoGhcTc.
@@ -1557,7 +1558,7 @@ data HsMatchContext_ fn
                                 --    tell matchWrapper what sort of
                                 --    runtime error message to generate]
 
-  | StmtCtxt (HsStmtContext_ fn)  -- ^Pattern of a do-stmt, list comprehension,
+  | StmtCtxt (HsStmtContext p)  -- ^Pattern of a do-stmt, list comprehension,
                                   -- pattern guard, etc
 
   | ThPatSplice            -- ^A Template Haskell pattern splice
@@ -1586,13 +1587,13 @@ See #20415 for a long discussion.
 -}
 
 -- | Haskell Statement Context.
-type HsStmtContext p = HsStmtContext_ (LIdP (NoGhcTc p))
+-- type HsStmtContext p = HsStmtContext_ (LIdP (NoGhcTc p))
 
-data HsStmtContext_ fn
+data HsStmtContext p
   = HsDoStmt HsDoFlavour             -- ^ Context for HsDo (do-notation and comprehensions)
-  | PatGuard (HsMatchContext_ fn)      -- ^ Pattern guard for specified thing
-  | ParStmtCtxt (HsStmtContext_ fn)    -- ^ A branch of a parallel stmt
-  | TransStmtCtxt (HsStmtContext_ fn)  -- ^ A branch of a transform stmt
+  | PatGuard (HsMatchContext p)      -- ^ Pattern guard for specified thing
+  | ParStmtCtxt (HsStmtContext p)    -- ^ A branch of a parallel stmt
+  | TransStmtCtxt (HsStmtContext p)  -- ^ A branch of a transform stmt
   | ArrowExpr                        -- ^ do-notation in an arrow-command context
 
 -- | Haskell arrow match context.
@@ -1608,19 +1609,19 @@ data HsDoFlavour
   | ListComp
   | MonadComp
 
-qualifiedDoModuleName_maybe :: HsStmtContext_ fn -> Maybe ModuleName
+qualifiedDoModuleName_maybe :: HsStmtContext fn -> Maybe ModuleName
 qualifiedDoModuleName_maybe ctxt = case ctxt of
   HsDoStmt (DoExpr m) -> m
   HsDoStmt (MDoExpr m) -> m
   _ -> Nothing
 
-isPatSynCtxt :: HsMatchContext_ fn -> Bool
+isPatSynCtxt :: HsMatchContext fn -> Bool
 isPatSynCtxt ctxt =
   case ctxt of
     PatSyn -> True
     _      -> False
 
-isComprehensionContext :: HsStmtContext_ fn -> Bool
+isComprehensionContext :: HsStmtContext fn -> Bool
 -- Uses comprehension syntax [ e | quals ]
 isComprehensionContext (ParStmtCtxt c)   = isComprehensionContext c
 isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c
@@ -1636,7 +1637,7 @@ isDoComprehensionContext ListComp = True
 isDoComprehensionContext MonadComp = True
 
 -- | Is this a monadic context?
-isMonadStmtContext :: HsStmtContext_ fn -> Bool
+isMonadStmtContext :: HsStmtContext fn -> Bool
 isMonadStmtContext (ParStmtCtxt ctxt)   = isMonadStmtContext ctxt
 isMonadStmtContext (TransStmtCtxt ctxt) = isMonadStmtContext ctxt
 isMonadStmtContext (HsDoStmt flavour) = isMonadDoStmtContext flavour
@@ -1650,7 +1651,7 @@ isMonadDoStmtContext DoExpr{}     = True
 isMonadDoStmtContext MDoExpr{}    = True
 isMonadDoStmtContext GhciStmtCtxt = True
 
-isMonadCompContext :: HsStmtContext_ fn -> Bool
+isMonadCompContext :: HsStmtContext fn -> Bool
 isMonadCompContext (HsDoStmt flavour)   = isMonadDoCompContext flavour
 isMonadCompContext (ParStmtCtxt _)   = False
 isMonadCompContext (TransStmtCtxt _) = False


=====================================
testsuite/tests/indexed-types/should_compile/T10806.stderr
=====================================
@@ -3,7 +3,7 @@ T10806.hs:11:32: error: [GHC-83865]
     • 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
+        but its type ‘Show a => a -> IO ()’ has only one
       In the expression: print 'x' 'y'
       In an equation for ‘triggersLoop’:
           triggersLoop (Q _ _) (Q _ _) = print 'x' 'y'


=====================================
testsuite/tests/indexed-types/should_fail/T8518.stderr
=====================================
@@ -3,7 +3,7 @@ T8518.hs:14:18: error: [GHC-83865]
     • Couldn't match expected type: Z c -> B c -> t0
                   with actual type: F c
     • The function ‘rpt’ is applied to four value arguments,
-        but its type ‘Int -> c -> F c’ has only two
+        but its type ‘t1 -> t2 -> F t2’ has only two
       In the expression: rpt (4 :: Int) c z b
       In an equation for ‘callCont’:
           callCont c z b


=====================================
testsuite/tests/typecheck/should_fail/T13902.stderr
=====================================
@@ -2,6 +2,6 @@
 T13902.hs:8:5: error: [GHC-83865]
     • Couldn't match expected type ‘t0 -> Int’ with actual type ‘Int’
     • The function ‘f’ is applied to two value arguments,
-        but its type ‘Int -> Int’ has only one
+        but its type ‘a -> a’ has only one
       In the expression: f @Int 42 5
       In an equation for ‘g’: g = f @Int 42 5


=====================================
testsuite/tests/typecheck/should_fail/T8603.stderr
=====================================
@@ -7,8 +7,8 @@ T8603.hs:33:17: error: [GHC-18872]
       Expected: [a2] -> StateT s RV a0
         Actual: t0 ((->) [a1]) (StateT s RV a0)
     • The function ‘lift’ is applied to two value arguments,
-        but its type ‘([a1] -> StateT s RV a0)
-                      -> t0 ((->) [a1]) (StateT s RV a0)’
+        but its type ‘(Control.Monad.Trans.Class.MonadTrans t, Monad m) =>
+                      m a -> t m a’
         has only one
       In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]
       In the expression:


=====================================
testsuite/tests/typecheck/should_fail/T9605.stderr
=====================================
@@ -3,7 +3,8 @@ T9605.hs:7:6: error: [GHC-83865]
     • Couldn't match type ‘Bool’ with ‘m Bool’
       Expected: t0 -> m Bool
         Actual: t0 -> Bool
-    • In the result of a function call
+    • The function ‘f1’ is applied to one value argument,
+        but its type ‘Monad m => m Bool’ has none
       In the expression: f1 undefined
       In an equation for ‘f2’: f2 = f1 undefined
     • Relevant bindings include f2 :: m Bool (bound at T9605.hs:7:1)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/900ecaad187908028f67017819ca2720cfd5f2a2...82cda64c0b1637efd032c64a45752a85ac8d89d3

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/900ecaad187908028f67017819ca2720cfd5f2a2...82cda64c0b1637efd032c64a45752a85ac8d89d3
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240128/ead47e41/attachment-0001.html>


More information about the ghc-commits mailing list