[Git][ghc/ghc][wip/expand-do] get locations right for bind statement expressions
Apoorv Ingle (@ani)
gitlab at gitlab.haskell.org
Wed Jul 26 22:01:56 UTC 2023
Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC
Commits:
e66595be by Apoorv Ingle at 2023-07-26T17:01:46-05:00
get locations right for bind statement expressions
- - - - -
4 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Head.hs
- testsuite/tests/typecheck/should_fail/DoExpansion2.hs
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -582,6 +582,11 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args
| otherwise
= noConcreteTyVars
+ -- isFailFun
+ -- | HsVar _ (L _ fun_id) <- tc_fun
+ -- , fun_id `hasKey` failMClassOpKey
+ -- , isGeneratedSrcSpan (appCtxtLoc fun_ctxt)
+
-- Count value args only when complaining about a function
-- applied to too many value args
-- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify.
@@ -839,10 +844,17 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside
thing_inside
VAExpansionStmt stmt@(L _ BindStmt {}) loc
- -> do traceTc "addArgCtxt 2e bind" empty
+ | isGeneratedSrcSpan (locA arg_loc)
+ -> do traceTc "addArgCtxt 2e bind arg_gen" empty
setSrcSpan loc $
addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $
thing_inside
+ | otherwise
+ -> do traceTc "addArgCtxt 2e bind" empty
+ setSrcSpanA arg_loc $
+ addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $
+ thing_inside
+
VAExpansionStmt (L _ LetStmt {}) _
-> do traceTc "addArgCtxt 2e let" empty
thing_inside
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -257,7 +257,7 @@ appCtxtExpr _ = Nothing
insideExpansion :: AppCtxt -> Bool
insideExpansion (VAExpansion {}) = True
insideExpansion (VAExpansionStmt {}) = True
-insideExpansion (VACall {}) = False
+insideExpansion (VACall {}) = False -- but what if the VACall has a generated context?
instance Outputable AppCtxt where
ppr (VAExpansion e l) = text "VAExpansion" <+> ppr e <+> ppr l
@@ -331,7 +331,7 @@ splitHsApps e = go e (top_ctxt 0 e) []
go (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) fun))) _ args
| BodyStmt{} <- s
- = go fun (VAExpansionStmt stmt generatedSrcSpan)
+ = go fun (VAExpansionStmt stmt generatedSrcSpan) -- so that we set (>>) as generated
(EWrap (EExpandStmt stmt) : args)
| otherwise
= go fun (VAExpansionStmt stmt (locA loc))
=====================================
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, ffff6 :: IO Int
+ffff1, ffff2, ffff3, ffff4, ffff5, ffff6, ffff7, ffff8 :: IO Int
ffff1 = do x <- getChar
@@ -29,3 +29,11 @@ ffff5 = do x <- getChar
ffff6 = do _ <- (getVal 1)
return () -- should error here
+
+
+ffff7 = do Just x <- getVal 3 4 -- should error here
+ return x
+
+
+ffff8 = do x <- getVal 3
+ return x -- should error here
=====================================
testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
=====================================
@@ -11,9 +11,10 @@ DoExpansion2.hs:16:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul
Actual: String
• In the first argument of ‘return’, namely ‘x’
In a stmt of a 'do' block: return x
- In the expression:
- do x <- (getVal 3)
- return x
+ In an equation for ‘ffff2’:
+ ffff2
+ = do x <- (getVal 3)
+ return x
DoExpansion2.hs:20:20: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match expected type ‘Int’ with actual type ‘Char’
@@ -39,15 +40,38 @@ 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 the expression:
- do x <- getChar
- Just x <- getChar
- return x
+ In an equation for ‘ffff5’:
+ ffff5
+ = 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 an equation for ‘ffff6’:
+ ffff6
+ = do _ <- (getVal 1)
+ return ()
+
+DoExpansion2.hs:34:22: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match expected type: t0 -> IO (Maybe Int)
+ with actual type: IO String
+ • The function ‘getVal’ is applied to two value arguments,
+ but its type ‘Int -> IO String’ has only one
+ In a stmt of a 'do' block: Just x <- getVal 3 4
In the expression:
- do _ <- (getVal 1)
- return ()
+ do Just x <- getVal 3 4
+ return x
+
+DoExpansion2.hs:39:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘[Char]’ with ‘Int’
+ Expected: Int
+ Actual: String
+ • In the first argument of ‘return’, namely ‘x’
+ In a stmt of a 'do' block: return x
+ In an equation for ‘ffff8’:
+ ffff8
+ = do x <- getVal 3
+ return x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e66595be20f836cd8083df1c604faf145b783211
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e66595be20f836cd8083df1c604faf145b783211
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/20230726/3f2fee9a/attachment-0001.html>
More information about the ghc-commits
mailing list