Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: ce879a76 by Apoorv Ingle at 2025-11-24T10:12:25-06:00 - look through applications to check if we need deepsubsumption - Tests cleanup - - - - - 18 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Hs.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Utils/Monad.hs - − testsuite/tests/deSugar/should_compile/T10662 - − testsuite/tests/ghci.debugger/Do - − testsuite/tests/ghci.debugger/Do.hs - − testsuite/tests/ghci.debugger/T25996.hs - + testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs - − testsuite/tests/typecheck/should_compile/T25996.hs - testsuite/tests/typecheck/should_compile/all.T - − testsuite/tests/typecheck/should_fail/T25970.hs - − testsuite/tests/typecheck/should_fail/T25996.hs - testsuite/tests/typecheck/should_fail/T7857.stderr - testsuite/tests/typecheck/should_fail/tcfail181.stderr Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -1,4 +1,3 @@ -{-# LANGUAGE DeepSubsumption #-} -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 1993-2004 ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -8,7 +8,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE DeepSubsumption #-} module GHC.Driver.Downsweep ( downsweep , downsweepThunk ===================================== compiler/GHC/Hs.hs ===================================== @@ -36,8 +36,7 @@ module GHC.Hs ( module GHC.Parser.Annotation, HsModule(..), AnnsModule(..), - HsParsedModule(..), XModulePs(..), - + HsParsedModule(..), XModulePs(..) ) where -- friends: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1157,7 +1157,8 @@ the typechecker: * HsDo, where we give the SrcSpan of the entire do block to each ApplicativeStmt. * Expanded (via ExpandedThingRn) ExplicitList{}, where we give the SrcSpan of the original - list expression to the 'fromListN' call. + list expression to the expanded expression. The 'fromListN' is assigned + a generated location span In order for the implicit function calls to not be confused for actual occurrences of functions in the source code, most of this extra information ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -8,7 +8,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeepSubsumption #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage {-# LANGUAGE InstanceSigs #-} ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -486,11 +486,18 @@ getDeepSubsumptionFlag_DataConHead app_head = ; return $ if | user_ds -> Deep DeepSub - | XExpr (ConLikeTc (RealDataCon {})) <- app_head - -> Deep TopSub | otherwise - -> Shallow - } + -> go app_head + } + where + go :: HsExpr GhcTc -> DeepSubsumptionFlag + go app_head + | XExpr (ConLikeTc (RealDataCon {})) <- app_head + = Deep TopSub + | HsApp _ f _ <- app_head + = go (unLoc f) + | otherwise + = Shallow finishApp :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc] -> TcRhoType -> HsWrapper ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -63,7 +63,7 @@ module GHC.Tc.Utils.Monad( -- * Error management getSrcCodeOrigin, getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, - inGeneratedCode, -- setInGeneratedCode, + inGeneratedCode, wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_, wrapLocMA_,wrapLocMA, getErrsVar, setErrsVar, ===================================== testsuite/tests/deSugar/should_compile/T10662 deleted ===================================== Binary files a/testsuite/tests/deSugar/should_compile/T10662 and /dev/null differ ===================================== testsuite/tests/ghci.debugger/Do deleted ===================================== Binary files a/testsuite/tests/ghci.debugger/Do and /dev/null differ ===================================== testsuite/tests/ghci.debugger/Do.hs deleted ===================================== @@ -1,6 +0,0 @@ - -module Main where - -main :: IO () -main = do putStrLn "Hello" - putStrLn "World" ===================================== testsuite/tests/ghci.debugger/T25996.hs deleted ===================================== @@ -1,17 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} - -main :: IO () -main = do - pure () - where - biz :: IO () - biz = do - pure (10 :: Integer) - pure () - -biz' :: IO () -biz' = do - pure (10 :: Integer) - pure () ===================================== testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs ===================================== @@ -0,0 +1,10 @@ +module Test where + + +qqqq :: [String] +qqqq = (show (1 :: Int) :) $ ["2"] + +main :: IO () +main = do + putStrLn "abc" + putStrLn $ concat qqqq ===================================== testsuite/tests/typecheck/should_compile/T25996.hs deleted ===================================== @@ -1,20 +0,0 @@ - -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} - -module T25996 where - -main :: IO () -main = do - pure () - where - biz :: IO () - biz = do - pure (10 :: Integer) - pure () - -biz' :: IO () -biz' = do - pure (10 :: Integer) - pure () ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -658,8 +658,8 @@ def onlyHsParLocs(x): """ ls = x.split("\n") filteredLines = (loc.strip() for (loc,hspar) in zip(ls,ls[5:]) - if hspar.strip().startswith("(HsPar") - and not "<no location info>" in loc) + if hspar.strip().startswith("(HsPar") + and not "<no location info>" in loc) return '\n'.join(filteredLines) test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) test('T15431', normal, compile, ['']) @@ -957,3 +957,4 @@ test('T17705', normal, compile, ['']) test('T14745', normal, compile, ['']) test('T26451', normal, compile, ['']) test('T26582', normal, compile, ['']) +test('ExpansionQLIm', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T25970.hs deleted ===================================== @@ -1,18 +0,0 @@ - -{-# LANGUAGE TypeFamilies #-} -module T25970 where - -y :: IO () -y = putStrLn "y" - - -type family K a where - K a = Bool - -x :: IO (K b) -x = do - y - pure () -- The error should point here or on the whole do block - -x' :: IO (K b) -x' = y >> pure () ===================================== testsuite/tests/typecheck/should_fail/T25996.hs deleted ===================================== @@ -1,20 +0,0 @@ - -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} - -module T25996 where - -main :: IO () -main = do - pure () - where - biz :: IO () - biz = do - pure (10 :: Integer) -- This warning should be reported only once - pure () - -biz' :: IO () -biz' = do - pure (10 :: Integer) - pure () ===================================== testsuite/tests/typecheck/should_fail/T7857.stderr ===================================== @@ -1,8 +1,7 @@ - T7857.hs:8:11: error: [GHC-39999] • Could not deduce ‘PrintfType a0’ arising from a use of ‘printf’ - from the context: PrintfArg t - bound by the inferred type of g :: PrintfArg t => t -> b + from the context: PrintfArg q + bound by the inferred type of g :: PrintfArg q => q -> b at T7857.hs:8:1-21 The type variable ‘a0’ is ambiguous Potentially matching instances: @@ -15,3 +14,4 @@ T7857.hs:8:11: error: [GHC-39999] • In the second argument of ‘($)’, namely ‘printf "" i’ In the expression: f $ printf "" i In an equation for ‘g’: g i = f $ printf "" i + ===================================== testsuite/tests/typecheck/should_fail/tcfail181.stderr ===================================== @@ -1,5 +1,5 @@ tcfail181.hs:17:9: error: [GHC-39999] - • Could not deduce ‘Monad m0’ arising from a record update + • Could not deduce ‘Monad m0’ arising from a use of ‘foo’ from the context: Monad m bound by the inferred type of wog :: Monad m => p -> Something (m Bool) e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce879a769c6f3f750df0401f60993780... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce879a769c6f3f750df0401f60993780... You're receiving this email because of your account on gitlab.haskell.org.