[Git][ghc/ghc][wip/expand-do] debugging error ctxts
Apoorv Ingle (@ani)
gitlab at gitlab.haskell.org
Mon Jul 24 23:34:44 UTC 2023
Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC
Commits:
bc7db422 by Apoorv Ingle at 2023-07-24T18:34:24-05:00
debugging error ctxts
- - - - -
9 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Utils/Monad.hs
- testsuite/tests/typecheck/should_fail/DoExpansion2.hs
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion3.stderr
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -492,7 +492,7 @@ data XXExprGhcTc
{-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcTc))
| ExpansionStmt -- See Note [Rebindable syntax and HsExpansion] below
- {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcTc))
+ {-# UNPACK #-} !(HsExpansion (ExprStmt GhcRn) (HsExpr GhcTc))
| ConLikeTc -- Result of typechecking a data-con
-- See Note [Typechecking data constructors] in
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -369,14 +369,14 @@ tcApp rn_expr exp_res_ty
setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VACall stmt") stmt
thing_inside
| insideExpansion fun_ctxt
- , VAExpansionStmt stmt@(L loc _) <- fun_ctxt
+ , VAExpansionStmt stmt loc <- fun_ctxt
= do traceTc "tcApp" (vcat [text "VAExpansionStmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt])
- setSrcSpanA loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt
- thing_inside
- | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun
- = do traceTc "tcApp" (vcat [text "RnFun stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt])
- setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt
+ setSrcSpan loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt
thing_inside
+ -- | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun
+ -- = do traceTc "tcApp" (vcat [text "RnFun stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt])
+ -- setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt
+ -- thing_inside
| insideExpansion fun_ctxt
= do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt])
addHeadCtxt fun_ctxt thing_inside
@@ -567,10 +567,10 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args
, text "do_ql" <+> ppr do_ql ])
; go emptyVarSet [] [] fun_sigma rn_args }
where
- fun_orig = exprCtOrigin (case fun_ctxt of
- VAExpansion e _ -> e
- VACall e _ _ -> e
- VAExpansionStmt stmt -> HsDo noExtField (DoExpr Nothing) (L noSrcSpanA [stmt]))
+ fun_orig = case fun_ctxt of
+ VAExpansionStmt{} -> DoOrigin
+ VAExpansion e _ -> exprCtOrigin e
+ VACall e _ _ -> exprCtOrigin e
-- These are the type variables which must be instantiated to concrete
-- types. See Note [Representation-polymorphic Ids with no binding]
@@ -786,7 +786,7 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside
-- <+> ppr (is_bind_fun (appCtxtExpr ctxt))
])
; case ctxt of
- VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _
+ VACall (XExpr (ExpandedStmt (HsExpanded (L loc stmt) _))) _ _
-> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .."
setSrcSpanA loc $
addStmtCtxt (text "addArgCtxt 2c") stmt $
@@ -796,27 +796,26 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside
setSrcSpanA arg_loc $
addErrCtxt (funAppCtxt fun arg arg_no) $
thing_inside
- VAExpansionStmt stmt@(L loc (BodyStmt{}))
+ VAExpansionStmt stmt@(BodyStmt{}) loc
-> do traceTc "addArgCtxt 2e body" empty
- setSrcSpanA loc $
+ setSrcSpan loc $
addStmtCtxt ((text "addArgCtxt 2e")) stmt $
thing_inside
- VAExpansionStmt stmt@(L loc (LastStmt {}))
+ VAExpansionStmt stmt@(LastStmt {}) loc
-> do traceTc "addArgCtxt 2e last" empty
- setSrcSpanA loc $
- -- addExprCtxt ((text "addArgCtxt body 2e")) body $
+ setSrcSpan loc $
addStmtCtxt ((text "addArgCtxt last 2e")) stmt $
- -- setSrcSpanA arg_loc $
- -- addErrCtxt (funAppCtxt fun arg arg_no) $
thing_inside
- VAExpansionStmt stmt@(L _ (BindStmt _ _ (L body_loc _)))
+ VAExpansionStmt stmt@(BindStmt {}) loc
-> do traceTc "addArgCtxt 2e bind" empty
- setSrcSpanA body_loc $
- -- addExprCtxt ((text "addArgCtxt body 2e")) body $
- addStmtCtxt ((text "addArgCtxt body 2e")) stmt $
+ setSrcSpan loc $
+ -- (if in_generated_code && in_src_ctxt
+ -- then
+ addStmtCtxt ((text "addArgCtxt bind 2e")) stmt $
+ -- else id) $
thing_inside
- VAExpansionStmt (L _ (LetStmt {})) -- TODO: Do nothing for let statements for now?
+ VAExpansionStmt (LetStmt {}) _
-> do traceTc "addArgCtxt 2e let" empty
thing_inside
_ -> do traceTc "addArgCtxt 3" empty
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -217,19 +217,17 @@ tcExpr e@(XExpr (ExpandedExpr {})) res_ty
}
tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty
- | XExpr (ExpandedStmt (HsExpanded stmt expanded_expr)) <- e
- , L l (LastStmt{}) <- stmt
+ | XExpr (ExpandedStmt (HsExpanded stmt _)) <- e
+ , L _ (LastStmt{}) <- stmt
= do traceTc "tcExpr" (text "PopErrCtxt last stmt")
popErrCtxt $
- setSrcSpanA l $
- addStmtCtxt (text "tcExpr last stmt") stmt $
- tcExpr expanded_expr res_ty
+ setSrcSpanA loc $
+ tcExpr e res_ty
| XExpr (ExpandedStmt (HsExpanded stmt _)) <- e
, L _ (LetStmt{}) <- stmt
= do traceTc "tcExpr" (text "PopErrCtxt let stmt")
popErrCtxt $
setSrcSpanA loc $
- -- addStmtCtxt (text "tcExpr let stmt") stmt $
tcExpr e res_ty
-- It is important that we call tcExpr and not tcApp here as
-- `e` is just the last statement's body expression
@@ -254,11 +252,9 @@ tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
, text "loc" <+> ppr loc
])
; (binds', e') <- setSrcSpanA loc $
- addStmtCtxt (text "tcExpr let") stmt $
+ addStmtCtxt (text "tcExpr let") s $
tcLocalBinds binds $
- do { -- traceTc "tcExpr let popErrCtxt" empty
- -- ; popErrCtxt $
- tcMonoExprNC e res_ty }
+ tcMonoExprNC e res_ty
; return $ HsLet x tkLet binds' tkIn e'
}
| BindStmt{} <- s
@@ -271,6 +267,16 @@ tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
-- addStmtCtxt (text "tcExpr bind") stmt $
tcApp e res_ty
}
+ | LastStmt{} <- s
+ = do { traceTc "tcDoStmts last" (vcat [ text "stmt:" <+> ppr stmt
+ , text "expr:" <+> ppr expd_expr
+ , text "res_ty:" <+> ppr res_ty
+ , text "loc" <+> ppr loc
+ ])
+ ; setSrcSpanA loc $
+ addStmtCtxt (text "tcExpr last") s $
+ tcExpr expd_expr res_ty
+ }
| otherwise
= do { traceTc "tcDoStmts other" (vcat [ text "stmt:" <+> ppr stmt
, text "expr:" <+> ppr expd_expr
@@ -278,7 +284,7 @@ tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
, text "loc" <+> ppr loc
])
; setSrcSpanA loc $
- addStmtCtxt (text "tcExpr other") stmt $
+ addStmtCtxt (text "tcExpr other") s $
tcExpr expd_expr res_ty
}
@@ -339,12 +345,12 @@ tcExpr (HsLam _ match) res_ty
= do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty
; return (mkHsWrap wrap (HsLam noExtField match')) }
where
- match_ctxt = MC { mc_what = case mg_ext match of -- refactor this for a better place.
- Generated DoExpansion _ -> StmtCtxt (HsDoStmt (DoExpr Nothing))
- -- Either this lambda expr was generated by expanding a do block
- _ -> LambdaExpr
- -- Or it was a true lambda
- , mc_body = tcBody }
+ match_ctxt = case mg_ext match of
+ Generated DoExpansion _ -> MC { mc_what = StmtCtxt (HsDoStmt (DoExpr Nothing))
+ , mc_body = tcBodyNC
+ }
+ _ -> MC { mc_what = LambdaExpr
+ , mc_body = tcBody }
herald = ExpectedFunTyLam match
tcExpr e@(HsLamCase x lc_variant matches) res_ty
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -188,7 +188,7 @@ data HsExprArg (p :: TcPass)
data EWrap = EPar AppCtxt
| EExpand (HsExpr GhcRn)
- | EExpandStmt (ExprLStmt GhcRn)
+ | EExpandStmt (ExprStmt GhcRn)
| EHsWrap HsWrapper
data EValArg (p :: TcPass) where -- See Note [EValArg]
@@ -209,7 +209,8 @@ data AppCtxt
SrcSpan -- The SrcSpan of the expression
-- noSrcSpan if outermost; see Note [AppCtxt]
| VAExpansionStmt
- (ExprLStmt GhcRn) -- Inside an expansion of this do stmt
+ (ExprStmt GhcRn) -- Inside an expansion of this do stmt
+ SrcSpan -- location of this statement
| VACall
(HsExpr GhcRn) Int -- In the third argument of function f
@@ -245,7 +246,7 @@ a second time.
appCtxtLoc :: AppCtxt -> SrcSpan
appCtxtLoc (VAExpansion _ l) = l
-appCtxtLoc (VAExpansionStmt _) = generatedSrcSpan
+appCtxtLoc (VAExpansionStmt _ l) = l
appCtxtLoc (VACall _ _ l) = l
appCtxtExpr :: AppCtxt -> Maybe (HsExpr GhcRn)
@@ -260,7 +261,7 @@ insideExpansion (VACall {}) = False
instance Outputable AppCtxt where
ppr (VAExpansion e l) = text "VAExpansion" <+> ppr e <+> ppr l
- ppr (VAExpansionStmt stmt) = text "VAExpansionStmt" <+> ppr stmt
+ ppr (VAExpansionStmt stmt l) = text "VAExpansionStmt" <+> ppr stmt <+> ppr l
ppr (VACall f n l) = text "VACall" <+> int n <+> ppr f <+> ppr l
type family XPass p where
@@ -295,22 +296,8 @@ splitHsApps :: HsExpr GhcRn
-> ( (HsExpr GhcRn, AppCtxt) -- Head
, [HsExprArg 'TcpRn]) -- Args
-- See Note [splitHsApps]
-splitHsApps e = -- maybeShiftCtxt $
- go e (top_ctxt 0 e) []
+splitHsApps e = go e (top_ctxt 0 e) []
where
- -- Ugly fix for setting the correct AppCtxt for let statements
- -- The point is that when we try to typecheck a let expression we are checking
- -- for the body of the let expression. But the go function for let statement expansion does not
- -- calculate the correct app context
- -- maybeShiftCtxt :: ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
- -- maybeShiftCtxt ((rn_fun, fun_ctxt), rn_args)
- -- | ((HsLet _ _ _ _ (L _ (XExpr (PopErrCtxt
- -- (L _ (XExpr (ExpandedStmt (HsExpanded body_stmt _))))))))
- -- , VAExpansionStmt{}) <- (rn_fun, fun_ctxt)
- -- = ((rn_fun, VAExpansionStmt body_stmt), rn_args)
- -- | otherwise = ((rn_fun, fun_ctxt), rn_args)
-
-
top_ctxt :: Int -> HsExpr GhcRn -> AppCtxt
-- Always returns VACall fun n_val_args noSrcSpan
-- to initialise the argument splitting in 'go'
@@ -342,8 +329,8 @@ splitHsApps e = -- maybeShiftCtxt $
= go fun (VAExpansion orig (appCtxtLoc ctxt))
(EWrap (EExpand orig) : args)
- go (XExpr (ExpandedStmt (HsExpanded stmt fun))) _ args
- = go fun (VAExpansionStmt stmt)
+ go (XExpr (ExpandedStmt (HsExpanded (L loc stmt) fun))) _ args
+ = go fun (VAExpansionStmt stmt (locA loc))
(EWrap (EExpandStmt stmt) : args)
-- See Note [Desugar OpApp in the typechecker]
@@ -853,8 +840,8 @@ tcInferAppHead_maybe fun args
_ -> return Nothing
addHeadCtxt :: AppCtxt -> TcM a -> TcM a
-addHeadCtxt (VAExpansionStmt stmt@(L stmt_loc _)) thing_inside =
- do setSrcSpanA stmt_loc $
+addHeadCtxt (VAExpansionStmt stmt loc) thing_inside =
+ do setSrcSpan loc $
addStmtCtxt (text "addHeadCtxt") stmt
thing_inside
addHeadCtxt fun_ctxt thing_inside
@@ -1538,12 +1525,13 @@ mis-match in the number of value arguments.
* *
********************************************************************* -}
-addStmtCtxt :: SDoc -> ExprLStmt GhcRn -> TcRn a -> TcRn a
+addStmtCtxt :: SDoc -> ExprStmt GhcRn -> TcRn a -> TcRn a
addStmtCtxt doc stmt thing_inside
= do isRebindable <- xoptM LangExt.RebindableSyntax
- let err = pprStmtInCtxt isRebindable (HsDoStmt (DoExpr Nothing)) (unLoc stmt)
- traceTc "addStmtCtxt" (ppr $ doc <+> err)
- addErrCtxt ({-doc <+>-} err) thing_inside
+ let err = pprStmtInCtxt isRebindable (HsDoStmt (DoExpr Nothing)) stmt
+ traceTc "addStmtCtxt" (ppr doc)
+ addErrCtxt ({-doc <+>-} err) $ debugErrCtxt thing_inside
+
where
pprStmtInCtxt :: Bool -> HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -29,6 +29,7 @@ module GHC.Tc.Gen.Match
, tcStmtsAndThen
, tcDoStmts
, tcBody
+ , tcBodyNC
, tcDoStmt
, tcGuardStmt
, checkArgCounts
@@ -343,6 +344,12 @@ tcBody body res_ty
; tcMonoExpr body res_ty
}
+tcBodyNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
+tcBodyNC body res_ty
+ = do { traceTc "tcBodyNC" (ppr res_ty)
+ ; tcMonoExprNC body res_ty
+ }
+
{-
************************************************************************
* *
@@ -436,7 +443,6 @@ tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside
(rhs', rhs_ty) <- tcScalingUsage ManyTy $ tcInferRhoNC rhs
-- Stmt has a context already
; hasFixedRuntimeRep_syntactic FRRBindStmtGuard rhs_ty
- ; traceTc "tcGuardStmt" (ppr pat <+> ppr rhs)
; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs)
pat (unrestricted rhs_ty) $
thing_inside res_ty
@@ -1262,7 +1268,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts)
do -- isRebindableOn <- xoptM LangExt.RebindableSyntax
-- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan
expand_stmts <- expand_do_stmts do_or_lc lstmts
- expr <- mk_failable_expr_tcm pat
+ expr <- mk_failable_expr pat
expand_stmts
fail_op
return $ wrapGenSpan (mkPopErrCtxtExpr $ (wrapGenSpan (mkExpandedStmt stmt (
@@ -1332,36 +1338,32 @@ expand_do_stmts do_or_lc
expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts)
-mk_failable_expr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn)
+mk_failable_expr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn)
-- checks the pattern `pat`for irrefutability which decides if we need to decorate it with a fail block
-mk_failable_expr_tcm pat@(L loc _) lexpr fail_op =
+mk_failable_expr pat@(L loc _) expr fail_op =
do { tc_env <- getGblEnv
; is_strict <- xoptM LangExt.Strict
; irrf_pat <- isIrrefutableHsPatRn' tc_env is_strict pat
- ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat
- , text "lexpr:" <+> ppr lexpr
- , text "isIrrefutable:" <+> ppr irrf_pat
- ])
+ ; traceTc "mk_fail_expr" (vcat [ text "pat:" <+> ppr pat
+ , text "isIrrefutable:" <+> ppr irrf_pat
+ ])
; if irrf_pat
- -- don't decorate with fail statement if
+ -- don't decorate with fail block if
-- the pattern is irrefutable
- then return $ let (L _ e) = genHsLamDoExp [pat] lexpr
- in L loc e
- else mk_fail_block pat lexpr fail_op
+ then return $ genHsLamDoExp [pat] expr
+ else L loc <$> mk_fail_block pat expr fail_op
}
--- makes the fail block
--- TODO: check the discussion around MonadFail.fail type signature.
--- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help
-mk_fail_block :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn)
+-- makes the fail block with a given fail_op
+mk_fail_block :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (HsExpr GhcRn)
mk_fail_block pat e (Just (SyntaxExprRn fail_op)) =
do dflags <- getDynFlags
- return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup doExpansionOrigin -- \
+ return $ HsLam noExtField $ mkMatchGroup doExpansionOrigin -- \
(wrapGenSpan [ genHsCaseAltDoExp pat e -- pat -> expr
, genHsCaseAltDoExp (wrapGenSpan (WildPat noExtField)) -- _ -> fail "fail pattern"
$ wrapGenSpan (genHsApp (wrapGenSpan fail_op) (mk_fail_msg_expr dflags pat))
- ]))
+ ])
where
mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn
mk_fail_msg_expr dflags pat
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -85,6 +85,7 @@ module GHC.Tc.Utils.Monad(
-- * Context management for the type checker
getErrCtxt, setErrCtxt, addErrCtxt, addErrCtxtM, addLandmarkErrCtxt,
+ debugErrCtxt,
addLandmarkErrCtxtM, popErrCtxt, getCtLocM, setCtLocM, mkCtLocEnv,
-- * Diagnostic message generation (type checker)
@@ -1269,7 +1270,8 @@ updCtxt ctxt env
| otherwise = addLclEnvErrCtxt ctxt env
popErrCtxt :: TcM a -> TcM a
-popErrCtxt = updLclEnv (\env -> setLclEnvErrCtxt (pop $ getLclEnvErrCtxt env) env)
+popErrCtxt thing_inside = updLclEnv (\env -> setLclEnvErrCtxt (pop $ getLclEnvErrCtxt env) env) $
+ debugErrCtxt $ thing_inside
where
pop [] = []
pop (_:msgs) = msgs
@@ -1301,6 +1303,19 @@ setCtLocM (CtLoc { ctl_env = lcl }) thing_inside
$ env) thing_inside
+
+debugErrCtxt :: TcRn a -> TcRn a
+debugErrCtxt thing_inside
+ = do { err_ctxt <- getErrCtxt
+ ; env0 <- liftZonkM tcInitTidyEnv
+ ; err_info <- mkErrInfo env0 err_ctxt
+ ; traceTc "debugErrCtxt" err_info
+ ; thing_inside
+ }
+
+
+
+
{- *********************************************************************
* *
Error recovery and exceptions
=====================================
testsuite/tests/typecheck/should_fail/DoExpansion2.hs
=====================================
@@ -6,7 +6,7 @@ module DoExpansion2 where
getVal :: Int -> IO String
getVal _ = return "x"
-ffff1, ffff2, ffff3, ffff4, ffff5 :: IO Int
+ffff1, ffff2, ffff3, ffff4, ffff5, ffff6 :: IO Int
ffff1 = do x <- getChar
@@ -26,3 +26,6 @@ ffff4 = do Just x <- getChar -- should error here
ffff5 = do x <- getChar
Just x <- getChar -- should error here
return x
+
+ffff6 = do _ <- (getVal 1)
+ return () -- should error here
=====================================
testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
=====================================
@@ -39,8 +39,15 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul
• Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’
• In the pattern: Just x
In a stmt of a 'do' block: Just x <- getChar
- In an equation for ‘ffff5’:
- ffff5
- = do x <- getChar
- Just x <- getChar
- return x
+ In the expression:
+ do x <- getChar
+ Just x <- getChar
+ return x
+
+DoExpansion2.hs:31:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match expected type ‘Int’ with actual type ‘()’
+ • In the first argument of ‘return’, namely ‘()’
+ In a stmt of a 'do' block: return ()
+ In the expression:
+ do _ <- (getVal 1)
+ return ()
=====================================
testsuite/tests/typecheck/should_fail/DoExpansion3.stderr
=====================================
@@ -29,3 +29,18 @@ DoExpansion3.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul
In the expression:
do Just x <- getChar
return x
+
+DoExpansion3.hs:33:3: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘()’ with ‘Int’
+ Expected: IO Int
+ Actual: IO ()
+ • In a stmt of a 'do' block: putStrLn $ a + ""
+ In the expression:
+ do let z :: Int = 3
+ let a = 1
+ putStrLn $ a + ""
+ In an equation for ‘gggg5’:
+ gggg5
+ = do let z :: Int = ...
+ let a = ...
+ putStrLn $ a + ""
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc7db422d0b6f2d54c9808a7041e63dd44d4783a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc7db422d0b6f2d54c9808a7041e63dd44d4783a
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/20230724/4c83aec0/attachment-0001.html>
More information about the ghc-commits
mailing list