Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
-
2003c4ab
by Apoorv Ingle at 2025-11-24T10:04:35-06:00
7 changed files:
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Tc/Gen/App.hs
- + testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T7857.stderr
- testsuite/tests/typecheck/should_fail/tcfail181.stderr
Changes:
| 1 | -{-# LANGUAGE DeepSubsumption #-}
|
|
| 2 | 1 | -- -----------------------------------------------------------------------------
|
| 3 | 2 | --
|
| 4 | 3 | -- (c) The University of Glasgow 1993-2004
|
| ... | ... | @@ -1157,7 +1157,8 @@ the typechecker: |
| 1157 | 1157 | * HsDo, where we give the SrcSpan of the entire do block to each
|
| 1158 | 1158 | ApplicativeStmt.
|
| 1159 | 1159 | * Expanded (via ExpandedThingRn) ExplicitList{}, where we give the SrcSpan of the original
|
| 1160 | - list expression to the 'fromListN' call.
|
|
| 1160 | + list expression to the expanded expression. The 'fromListN' is assigned
|
|
| 1161 | + a generated location span
|
|
| 1161 | 1162 | |
| 1162 | 1163 | In order for the implicit function calls to not be confused for actual
|
| 1163 | 1164 | occurrences of functions in the source code, most of this extra information
|
| ... | ... | @@ -486,11 +486,18 @@ getDeepSubsumptionFlag_DataConHead app_head = |
| 486 | 486 | ; return $
|
| 487 | 487 | if | user_ds
|
| 488 | 488 | -> Deep DeepSub
|
| 489 | - | XExpr (ConLikeTc (RealDataCon {})) <- app_head
|
|
| 490 | - -> Deep TopSub
|
|
| 491 | 489 | | otherwise
|
| 492 | - -> Shallow
|
|
| 493 | - }
|
|
| 490 | + -> go app_head
|
|
| 491 | + }
|
|
| 492 | + where
|
|
| 493 | + go :: HsExpr GhcTc -> DeepSubsumptionFlag
|
|
| 494 | + go app_head
|
|
| 495 | + | XExpr (ConLikeTc (RealDataCon {})) <- app_head
|
|
| 496 | + = Deep TopSub
|
|
| 497 | + | HsApp _ f _ <- app_head
|
|
| 498 | + = go (unLoc f)
|
|
| 499 | + | otherwise
|
|
| 500 | + = Shallow
|
|
| 494 | 501 | |
| 495 | 502 | finishApp :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc]
|
| 496 | 503 | -> TcRhoType -> HsWrapper
|
| 1 | +module Test where
|
|
| 2 | + |
|
| 3 | + |
|
| 4 | +qqqq :: [String]
|
|
| 5 | +qqqq = (show (1 :: Int) :) $ ["2"]
|
|
| 6 | + |
|
| 7 | +main :: IO ()
|
|
| 8 | +main = do
|
|
| 9 | + putStrLn "abc"
|
|
| 10 | + putStrLn $ concat qqqq |
| ... | ... | @@ -658,8 +658,8 @@ def onlyHsParLocs(x): |
| 658 | 658 | """
|
| 659 | 659 | ls = x.split("\n")
|
| 660 | 660 | filteredLines = (loc.strip() for (loc,hspar) in zip(ls,ls[5:])
|
| 661 | - if hspar.strip().startswith("(HsPar")
|
|
| 662 | - and not "<no location info>" in loc)
|
|
| 661 | + if hspar.strip().startswith("(HsPar")
|
|
| 662 | + and not "<no location info>" in loc)
|
|
| 663 | 663 | return '\n'.join(filteredLines)
|
| 664 | 664 | test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, [''])
|
| 665 | 665 | test('T15431', normal, compile, [''])
|
| ... | ... | @@ -957,3 +957,4 @@ test('T17705', normal, compile, ['']) |
| 957 | 957 | test('T14745', normal, compile, [''])
|
| 958 | 958 | test('T26451', normal, compile, [''])
|
| 959 | 959 | test('T26582', normal, compile, [''])
|
| 960 | +test('ExpansionQLIm', normal, compile, ['']) |
| 1 | - |
|
| 2 | 1 | T7857.hs:8:11: error: [GHC-39999]
|
| 3 | 2 | • Could not deduce ‘PrintfType a0’ arising from a use of ‘printf’
|
| 4 | - from the context: PrintfArg t
|
|
| 5 | - bound by the inferred type of g :: PrintfArg t => t -> b
|
|
| 3 | + from the context: PrintfArg q
|
|
| 4 | + bound by the inferred type of g :: PrintfArg q => q -> b
|
|
| 6 | 5 | at T7857.hs:8:1-21
|
| 7 | 6 | The type variable ‘a0’ is ambiguous
|
| 8 | 7 | Potentially matching instances:
|
| ... | ... | @@ -15,3 +14,4 @@ T7857.hs:8:11: error: [GHC-39999] |
| 15 | 14 | • In the second argument of ‘($)’, namely ‘printf "" i’
|
| 16 | 15 | In the expression: f $ printf "" i
|
| 17 | 16 | In an equation for ‘g’: g i = f $ printf "" i
|
| 17 | + |
| 1 | 1 | tcfail181.hs:17:9: error: [GHC-39999]
|
| 2 | - • Could not deduce ‘Monad m0’ arising from a record update
|
|
| 2 | + • Could not deduce ‘Monad m0’ arising from a use of ‘foo’
|
|
| 3 | 3 | from the context: Monad m
|
| 4 | 4 | bound by the inferred type of
|
| 5 | 5 | wog :: Monad m => p -> Something (m Bool) e
|