- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Implement List.elem via foldr
by Marge Bot (＠marge-bot) 23 May '26

23 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 31fa1412 by Simon Jakobi at 2026-05-23T16:01:06-04:00 Implement List.elem via foldr ...in order to allow specialization to Eq instances. The implementation of notElem is updated for consistency.` Corresponding CLC proposal: https://github.com/haskell/core-libraries-committee/issues/412 Addresses #27096. - - - - - 999f4b0c by Alan Zimmerman at 2026-05-23T16:01:07-04:00 EPA: Fix span for qualified multiline string Fix the span for a qualified multiline string like Text.""" I'm a multiline Text value ! """ to extend to the end of the entire string, not just the first line. Closes #27274 - - - - - e79ae377 by Alan Zimmerman at 2026-05-23T16:01:07-04:00 EPA: Fix exact printing namespace-specified wildcards Ensures correct printing of imports of the form import Data.Bool (data True(data ..)) import Data.Bool (data True(type ..)) Closes #27291 - - - - - d050864d by Mrjtjmn at 2026-05-23T16:01:14-04:00 Fix ambiguous syntax of BangPatterns in users guide Update documentation for the BangPatterns extension to specify how surrounding whitespace affects interpretation of `!`. * Only when there is whitespace before `!` and no whitespace after, it is recognized as a BangPattern. * Other cases `⟨varid⟩!⟨varid⟩`, `⟨varid⟩ ! ⟨varid⟩`, `⟨varid⟩! ⟨varid⟩` are treated as infix operators. - - - - - 12 changed files: - + changelog.d/elem-via-foldr-27096 - compiler/GHC/Parser/Lexer.x - docs/users_guide/exts/stolen_syntax.rst - libraries/base/changelog.md - libraries/base/tests/perf/ElemNoFusion_O1.stderr - libraries/base/tests/perf/ElemNoFusion_O2.stderr - libraries/ghc-internal/src/GHC/Internal/List.hs - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprQualifiedStrings.hs - + testsuite/tests/printer/Test27291.hs - testsuite/tests/printer/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== changelog.d/elem-via-foldr-27096 ===================================== @@ -0,0 +1,4 @@ +section: base +synopsis: Reimplement ``Data.List.elem`` and ``notElem`` using ``foldr`` to enable better specialization. +issues: #27096 +mrs: !15793 ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -2274,8 +2274,9 @@ tok_quoted_label span buf len _buf2 = do tok_qstrings :: Action -> Action tok_qstrings lex_str span0 buf0 len0 endBuf0 = do let modName = ModuleName $ lexemeToFastString buf0 modNameLen - (src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 - pure $ L span0 $ ITstring src meta{strMetaQualified = Just modName} s + (span1, src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 + let span2 = mkPsSpan (psSpanStart span0) (psSpanEnd span1) + pure $ L span2 $ ITstring src meta{strMetaQualified = Just modName} s where -- The buffer/span starting at the string literal (strBuf, strSpanStart) = @@ -2298,7 +2299,7 @@ tok_qstrings lex_str span0 buf0 len0 endBuf0 = do strSpan = mkPsSpan strSpanStart (psSpanEnd span0) unITstring = \case - L _ (ITstring src meta s) -> (src, meta, s) + L span1 (ITstring src meta s) -> (span1, src, meta, s) tok -> panic $ "tok_qstrings got unexpected token: " ++ show tok tok_char :: Action ===================================== docs/users_guide/exts/stolen_syntax.rst ===================================== @@ -50,7 +50,7 @@ The following syntax is stolen: Stolen by: :extension:`Arrows` -``?varid`` +``?⟨varid⟩`` .. index:: single: implicit parameters @@ -77,17 +77,20 @@ The following syntax is stolen: Stolen by: :extension:`QuasiQuotes` -⟨varid⟩``#``, ⟨char⟩``#``, ⟨string⟩``#``, ⟨integer⟩``#``, ⟨float⟩``#``, ⟨float⟩``##`` +``⟨varid⟩#``, ``⟨char⟩#``, ``⟨string⟩#``, ``⟨integer⟩#``, ``⟨float⟩#``, ``⟨float⟩##`` Stolen by: :extension:`MagicHash` -⟨integer⟩, ``#(Int|Word)(8|16|32|64)?`` +``⟨integer⟩#(Int|Word)(8|16|32|64)?`` Stolen by: :extension:`ExtendedLiterals` ``(#``, ``#)`` Stolen by: :extension:`UnboxedTuples` -⟨varid⟩, ``!``, ⟨varid⟩ - Stolen by: :extension:`BangPatterns` +``⟨varid⟩ !⟨varid⟩`` + Stolen by: :extension:`BangPatterns`. Only when there are whitespaces before + ``!`` and no whitespace after ``!``, it is interpreted as :extension:`BangPatterns`. Other + cases such as ``⟨varid⟩!⟨varid⟩``, ``⟨varid⟩ ! ⟨varid⟩``, and ``⟨varid⟩! ⟨varid⟩``, are + interpreted as infix operators. ``pattern`` Stolen by: :extension:`PatternSynonyms` ===================================== libraries/base/changelog.md ===================================== @@ -2,6 +2,7 @@ ## 4.24.0.0 *TBA* * Add `Bounded` instances for `Double`, `Float`, `CDouble` and `CFloat`. ([CLC proposal #402](https://github.com/haskell/core-libraries-committee/issues/402)) + * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) ## 4.23.0.0 *TBA* * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) ===================================== libraries/base/tests/perf/ElemNoFusion_O1.stderr ===================================== @@ -1,5 +1,38 @@ -noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) +noFusionElemSort + = \ x x1 -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case x of { I# x2 -> + case y of { I# y1 -> + case ==# x2 y1 of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + } + }; } in + jump go1 (actualSort gtInt x1) noFusionElemNonEmptyToList - = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + = \ x x1 -> + case x1 of { :| a1 as -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case x of { I# x2 -> + case y of { I# y1 -> + case ==# x2 y1 of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + } + }; } in + jump go1 (: a1 as) + } ===================================== libraries/base/tests/perf/ElemNoFusion_O2.stderr ===================================== @@ -1,5 +1,54 @@ -noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) +noFusionElemSort + = \ x x1 -> + case actualSort gtInt x1 of { + [] -> False; + : y ys -> + case x of { I# x2 -> + case y of { I# y1 -> + case ==# x2 y1 of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y2 ys1 -> + case y2 of { I# y3 -> + case ==# x2 y3 of { + __DEFAULT -> jump go1 ys1; + 1# -> True + } + } + }; } in + jump go1 ys; + 1# -> True + } + } + } + } noFusionElemNonEmptyToList - = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + = \ x x1 -> + case x1 of { :| a1 as -> + case x of { I# x2 -> + case a1 of { I# y -> + case ==# x2 y of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y1 ys -> + case y1 of { I# y2 -> + case ==# x2 y2 of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + }; } in + jump go1 as; + 1# -> True + } + } + } + } ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -1517,14 +1517,9 @@ all p (x:xs) = p x && all p xs -- -- >>> 3 `elem` [4..] -- * Hangs forever * -elem :: (Eq a) => a -> [a] -> Bool -elem _ [] = False -elem x (y:ys) = x==y || elem x ys -{-# NOINLINE [1] elem #-} -{-# RULES -"elem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b) - . elem x (build g) = g (\ y r -> (x == y) || r) False - #-} +elem :: Eq a => a -> [a] -> Bool +elem x = foldr (\y r -> x == y || r) False +{-# INLINE elem #-} -- | 'notElem' is the negation of 'elem'. -- @@ -1544,14 +1539,9 @@ elem x (y:ys) = x==y || elem x ys -- -- >>> 3 `notElem` [4..] -- * Hangs forever * -notElem :: (Eq a) => a -> [a] -> Bool -notElem _ [] = True -notElem x (y:ys)= x /= y && notElem x ys -{-# NOINLINE [1] notElem #-} -{-# RULES -"notElem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b) - . notElem x (build g) = g (\ y r -> (x /= y) && r) True - #-} +notElem :: Eq a => a -> [a] -> Bool +notElem x = foldr (\y r -> x /= y && r) True +{-# INLINE notElem #-} -- | $\mathcal{O}(n)$. 'lookup' @key assocs@ looks up a key in an association -- list. ===================================== testsuite/tests/printer/Makefile ===================================== @@ -907,6 +907,11 @@ Test25885: $(CHECK_PPR) $(LIBDIR) Test25885.hs $(CHECK_EXACT) $(LIBDIR) Test25885.hs +.PHONY: Test27291 +Test27291: + $(CHECK_PPR) $(LIBDIR) Test27291.hs + $(CHECK_EXACT) $(LIBDIR) Test27291.hs + .PHONY: TestLevelImports TestLevelImports: $(CHECK_PPR) $(LIBDIR) TestLevelImports.hs @@ -922,3 +927,8 @@ TestNamedDefaults: PprModifiers: $(CHECK_PPR) $(LIBDIR) PprModifiers.hs $(CHECK_EXACT) $(LIBDIR) PprModifiers.hs + +.PHONY: PprQualifiedStrings +PprQualifiedStrings: + $(CHECK_PPR) $(LIBDIR) PprQualifiedStrings.hs + $(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs ===================================== testsuite/tests/printer/PprQualifiedStrings.hs ===================================== @@ -0,0 +1,75 @@ +{-# LANGUAGE MultilineStrings #-} +{-# LANGUAGE QualifiedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- These are harvested from ../qualified-strings + +module PprQualifiedStrings where + +import Data.Typeable (Typeable, typeOf) +import qualified Example.ByteStringAscii as Ascii +import qualified Example.ByteStringUtf8 as Utf8 +import qualified Example.Text as Text + +exprs :: IO () +exprs = do + inspect "I'm a String" -- would be an ambiguous type error with OverloadedStrings + inspect Text."I'm a Text" + inspect Ascii."I'm an ASCII bytestring: 語" + inspect Utf8."I'm a UTF8 bytestring: 語" + + inspect """ + I'm a multiline + String value + ! + """ + + inspect Text.""" + I'm a multiline + Text value + ! + """ + + inspect Text . """ + I'm a multiline + Text value + """ + + inspect Text . + """ + I'm a multiline + Text value + """ + +pats :: IO () +pats = do + let text = Text."foo" :: Text + case text of + Text."foo" -> putStrLn "Text.\"foo\" matched" + _ -> putStrLn "Text.\"foo\" did not match" + + let ascii = Ascii."語" :: ByteString + case ascii of + Ascii."語" -> putStrLn "Ascii.\"語\" matched" + _ -> putStrLn "Ascii.\"語\" did not match" + + let utf = Utf8."語" :: ByteString + case utf of + Utf8."語" -> putStrLn "Utf8.\"語\" matched" + _ -> putStrLn "Utf8.\"語\" did not match" + +th :: IO () +th = + $(do + foldr (\stmt acc -> [| $stmt >> $acc |]) [| pure () |] $ + [ [| inspect Text."I'm a Text" |] + , [| inspect Ascii."I'm an ASCII bytestring: 語" |] + , [| inspect Utf8."I'm a Utf8 bytestring: 語" |] + , [| + inspect Text.""" + I'm a multiline + Text string + """ + |] + ] + ) ===================================== testsuite/tests/printer/Test27291.hs ===================================== @@ -0,0 +1,35 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +module Test27291 + ( C(type ..) -- exports class C and data family D + , C(data ..) -- exports class C and method m + , D(type ..) -- exports data family D + , type T (..) -- exports type T and all its data constructors D, D2 + , type T (type ..) -- exports type T + , type K (type ..) -- exports type K and its constructor K1 + ) where + +import Control.Applicative qualified as A (type Applicative (data ..)) +import Data.Either qualified as E (type Either (data ..)) + +import Data.Bool (data True (..)) +import Data.Bool (data True( data .. ) ) +import Data.Bool (data True( type ..)) + +import DodgyImports03_helper (C( .. )) +import DodgyImports03_helper (C (data .. )) +import DodgyImports03_helper (C( type ..) ) + +import DodgyImports03_helper (T ( .. ) ) +import DodgyImports03_helper (T(data ..)) +import DodgyImports03_helper (T(type ..)) + +import Control.Applicative (type Applicative (type ..)) -- dodgy: no associated types +import Data.Either (type Either (type ..)) -- dodgy: not a class + +import Data.Proxy (type Proxy(data ..)) -- ok +import Data.Proxy (type Proxy(type ..)) -- dodgy: not a class + +import T25901_sub_g_helper qualified as T1 (T (data ..)) -- T and MkT +import T25901_sub_g_helper qualified as T2 (T (type ..)) -- T only +import T25901_sub_g_helper qualified as T3 (type T (..)) -- T and MkT ===================================== testsuite/tests/printer/all.T ===================================== @@ -217,7 +217,9 @@ test('T24237', normal, compile_fail, ['']) test('Test25454', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25454']) test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885']) +test('Test27291', [ignore_stderr, req_ppr_deps], makefile_test, ['Test27291']) test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports']) test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults']) test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers']) +test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3145,6 +3145,12 @@ instance ExactPrint (HsExpr GhcPs) where body' <- markAnnotated body return (HsQual noExtField ctxt' body') + exact (HsQualLit _ (QualLit _ modu (HsQualString src fs))) = do + modu' <- markAnnotated modu + printStringAdvanceA "." + printSourceTextAA src (show (unpackFS fs)) + return (HsQualLit noExtField (QualLit noExtField modu' (HsQualString src fs))) + exact x = error $ "exact HsExpr for:" ++ showAst x -- --------------------------------------------------------------------- @@ -4581,9 +4587,9 @@ instance ExactPrint (IE GhcPs) where return (IEThingAbs depr' thing' doc') exact (IEThingAll x ns_spec thing doc) = do depr' <- markAnnotated (ieta_warning x) - ns_spec' <- markAnnotated ns_spec thing' <- markAnnotated thing op' <- markEpToken (ieta_tok_lpar x) + ns_spec' <- markAnnotated ns_spec dd' <- markEpToken (ieta_tok_wc x) cp' <- markEpToken (ieta_tok_rpar x) doc' <- markAnnotated doc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3dec45b2fd79897bf38434997dbe6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3dec45b2fd79897bf38434997dbe6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Use "grimily" instead of "grimly"
by Marge Bot (＠marge-bot) 23 May '26

23 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6f9d7c71 by Markus Läll at 2026-05-21T15:25:34-04:00 Use "grimily" instead of "grimly" Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/27221 - - - - - 50e999ca by fendor at 2026-05-21T15:26:18-04:00 Speed up 'closure' computation in `ghc-pkg` Cache the set of already seen `UnitId`s and use `Set` operations to speed up 'closure' computation. Further simplify the implementation of 'closure' to account for the actual usage. As a consequence, we rename 'closure' to 'brokenPackages' to reflect its purpose better after the simplification. - - - - - 7ecc6184 by sheaf at 2026-05-21T15:27:10-04:00 TcMPluginHandling: be more lenient when no plugins This change ensures that, if a function such as 'typecheckModule' was invoked with 'NoTcMPlugins', GHC doesn't spuriously complain about TcM plugins having already been stopped, as there were none to start with. - - - - - 478c6325 by Alan Zimmerman at 2026-05-23T10:17:35+01:00 EPA: Fix span for qualified multiline string Fix the span for a qualified multiline string like Text.""" I'm a multiline Text value ! """ to extend to the end of the entire string, not just the first line. Closes #27274 - - - - - c3dec45b by Alan Zimmerman at 2026-05-23T11:19:31-04:00 EPA: Fix exact printing namespace-specified wildcards Ensures correct printing of imports of the form import Data.Bool (data True(data ..)) import Data.Bool (data True(type ..)) Closes #27291 - - - - - 21 changed files: - + changelog.d/ghc-pkg-faster-closure - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs - + testsuite/tests/ghc-api/T27273.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprQualifiedStrings.hs - + testsuite/tests/printer/Test27291.hs - testsuite/tests/printer/all.T - utils/check-exact/ExactPrint.hs - utils/ghc-pkg/Main.hs Changes: ===================================== changelog.d/ghc-pkg-faster-closure ===================================== @@ -0,0 +1,10 @@ +section: ghc-pkg +synopsis: Improve performance of `ghc-pkg list` command +issues: #27275 +mrs: !16062 + +description: { +`ghc-pkg list` was quadratic in the number of packages due to an inefficient `closure` computation. +We cache the set of seen packages, allowing us to speed up the `closure` computation, improving run-time +for the commands `list`, `check`, `distrust`, `expose`, `hide`, `trust` and `unregister`. +} ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -318,7 +318,7 @@ instance DSM.MonadGetUnique LlvmM where tag <- getEnv envTag liftUDSMT $! do uq <- DSM.getUniqueM - return (newTagUniqueGrimly uq tag) + return (newTagUniqueGrimily uq tag) -- | Lifting of IO actions. Not exported, as we want to encapsulate IO. liftIO :: IO a -> LlvmM a ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -175,11 +175,11 @@ instance MonadPlus CoreM instance MonadUnique CoreM where getUniqueSupplyM = do tag <- read cr_uniq_tag - liftIO $! mkSplitUniqSupplyGrimly tag + liftIO $! mkSplitUniqSupplyGrimily tag getUniqueM = do tag <- read cr_uniq_tag - liftIO $! uniqFromTagGrimly tag + liftIO $! uniqFromTagGrimily tag runCoreM :: HscEnv -> RuleBase ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -144,7 +144,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv | otherwise = unpackHObj res_hty header_bits = maybe mempty idTag maybe_target - idTag i = let (tag, u) = unpkUniqueGrimly (getUnique i) + idTag i = let (tag, u) = unpkUniqueGrimily (getUnique i) in CHeader (char tag <> word64 u) normal_args = map (\(nm,_ty,_,_) -> nm) arg_info ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -707,7 +707,7 @@ putName BinSymbolTable{ bin_symtab_next = symtab_next } bh name | isKnownKeyName name - , let (c, u) = unpkUniqueGrimly (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits + , let (c, u) = unpkUniqueGrimily (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits = -- assert (u < 2^(22 :: Int)) put_ bh (0x80000000 .|. (fromIntegral (ord c) `shiftL` 22) ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -2274,8 +2274,9 @@ tok_quoted_label span buf len _buf2 = do tok_qstrings :: Action -> Action tok_qstrings lex_str span0 buf0 len0 endBuf0 = do let modName = ModuleName $ lexemeToFastString buf0 modNameLen - (src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 - pure $ L span0 $ ITstring src meta{strMetaQualified = Just modName} s + (span1, src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 + let span2 = mkPsSpan (psSpanStart span0) (psSpanEnd span1) + pure $ L span2 $ ITstring src meta{strMetaQualified = Just modName} s where -- The buffer/span starting at the string literal (strBuf, strSpanStart) = @@ -2298,7 +2299,7 @@ tok_qstrings lex_str span0 buf0 len0 endBuf0 = do strSpan = mkPsSpan strSpanStart (psSpanEnd span0) unITstring = \case - L _ (ITstring src meta s) -> (src, meta, s) + L span1 (ITstring src meta s) -> (span1, src, meta, s) tok -> panic $ "tok_qstrings got unexpected token: " ++ show tok tok_char :: Action ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -66,9 +66,9 @@ newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { tag <- ask - ; liftIO $! mkSplitUniqSupplyGrimly tag} + ; liftIO $! mkSplitUniqSupplyGrimily tag} getUniqueM = StgM $ do { tag <- ask - ; liftIO $! uniqFromTagGrimly tag} + ; liftIO $! uniqFromTagGrimily tag} runStgM :: UniqueTag -> StgM a -> IO a runStgM mask (StgM m) = runReaderT m (uniqueTag mask) ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -130,7 +130,7 @@ makeIdentForId i num id_type current_module = name ident -- unique suffix for non-exported Ids , if exported then mempty - else let (c,u) = unpkUniqueGrimly (getUnique i) + else let (c,u) = unpkUniqueGrimily (getUnique i) in mconcat [BSC.pack ['_',c,'_'], word64BS u] ] @@ -235,4 +235,3 @@ declVarsForId i = case typeSize (idType i) of 0 -> return mempty 1 -> decl <$> identForId i s -> mconcat <$> mapM (\n -> decl <$> identForIdN i n) [1..s] - ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -1250,14 +1250,17 @@ emptyTcMPluginsShutdown = TcMPluginsShutdown data TcMPluginsState -- | The 'TcM' plugins have not been started. = TcMPluginsUninitialised - -- | The 'TcM' plugins have been initialised and not yet stopped. + -- | The 'TcM' plugins have been initialised and not yet stopped, + -- or there were no 'TcM' plugins to start with. -- -- We may be in the middle of typechecker, or have finished typechecking -- and be in the middle of desugaring. | TcMPluginsRunning !RunningTcMPlugins - -- | The 'TcM' plugins have been stopped. + -- | There were 'TcM' plugins that were running, but they have been stopped. | TcMPluginsStopped +-- | A (possibly empty) collection of 'TcM' plugin @run@, @post-tc@ and +-- @shutdown@ actions. data RunningTcMPlugins = RunningTcMPlugins { rtcmp_run :: TcMPluginsRun @@ -1281,11 +1284,20 @@ tcMPluginsShutdownActions = rtcmp_shutdown -- | Retrieve the 'TcM' plugins from a 'TcMPluginsState'. -- --- Assumes the plugins have been already started and not yet stopped. +-- Assumes the plugins (if any) have been already started and not yet stopped. runningTcMPlugins :: HasDebugCallStack => TcMPluginsState -> RunningTcMPlugins runningTcMPlugins = \case - TcMPluginsUninitialised -> panic "runningTcMPlugins: TcM plugins not started" - TcMPluginsStopped -> panic "runningTcMPlugins: TcM plugins already stopped" + TcMPluginsUninitialised -> + pprPanic "TcM plugins have not been started" $ + vcat [ text "If you are a GHC API user, make sure to use an appropriate 'TcMPluginHandling'" + , text "to ensure that TcM plugins (if any) are initialised before typechecking." + ] + TcMPluginsStopped -> + pprPanic "TcM plugins already stopped" $ + vcat [ text "If you are a GHC API user and want to proceed to desugaring after typechecking," + , text "make sure you are not using the 'StartAndStopTcMPlugins' 'TcMPluginHandling'," + , text "as that stops TcM plugins after typechecking." + ] TcMPluginsRunning plugins -> plugins ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -790,9 +790,10 @@ withoutTcMPlugins thing_inside = do tcg_env <- getGblEnv writeTcRef (tcg_plugins tcg_env) $ TcMPluginsRunning emptyRunningTcMPlugins - teardown = do - tcg_env <- getGblEnv - writeTcRef (tcg_plugins tcg_env) TcMPluginsStopped + teardown = + -- Don't set 'tcg_plugins' to 'TcMPluginsStopped', as that should only + -- be used when there were 'TcM' plugins to start with (#27273). + return () -- | Initialise 'TcM' plugins. initTcMPlugins :: HscEnv -> TcM () @@ -946,32 +947,20 @@ shutdownTcMPlugins = \case runPluginShutdowns (tcs ++ defs) solverTcMPlugins :: HasDebugCallStack => TcMPluginsState -> [TcPluginSolver] -solverTcMPlugins = \case - TcMPluginsUninitialised -> panic "solverTcMPlugins: TcM plugins not started" - TcMPluginsStopped -> panic "solverTcMPlugins: TcM plugins already stopped" - TcMPluginsRunning plugins -> - tcmp_solvers (tcMPluginsRunActions plugins) +solverTcMPlugins = + tcmp_solvers . tcMPluginsRunActions . runningTcMPlugins rewriterTcMPlugins :: HasDebugCallStack => TcMPluginsState -> UniqFM TyCon [TcPluginRewriter] -rewriterTcMPlugins = \case - TcMPluginsUninitialised -> panic "rewriterTcMPlugins: TcM plugins not started" - TcMPluginsStopped -> panic "rewriterTcMPlugins: TcM plugins already stopped" - TcMPluginsRunning plugins -> - tcmp_rewriters (tcMPluginsRunActions plugins) +rewriterTcMPlugins = + tcmp_rewriters . tcMPluginsRunActions . runningTcMPlugins defaultingTcMPlugins :: HasDebugCallStack => TcMPluginsState -> [FillDefaulting] -defaultingTcMPlugins = \case - TcMPluginsUninitialised -> panic "defaultingTcMPlugins: TcM plugins not started" - TcMPluginsStopped -> panic "defaultingTcMPlugins: TcM plugins already stopped" - TcMPluginsRunning plugins -> - tcmp_defaulters (tcMPluginsRunActions plugins) +defaultingTcMPlugins = + tcmp_defaulters . tcMPluginsRunActions . runningTcMPlugins holeFitTcMPlugins :: HasDebugCallStack => TcMPluginsState -> [HoleFitPlugin] -holeFitTcMPlugins = \case - TcMPluginsUninitialised -> panic "holeFitTcMPlugins: TcM plugins not started" - TcMPluginsStopped -> panic "holeFitTcMPlugins: TcM plugins already stopped" - TcMPluginsRunning plugins -> - tcmp_hole_fits (tcMPluginsRunActions plugins) +holeFitTcMPlugins = + tcmp_hole_fits . tcMPluginsRunActions . runningTcMPlugins {- ************************************************************************ @@ -1008,13 +997,13 @@ newUnique :: TcRnIf gbl lcl Unique newUnique = do { env <- getEnv ; let tag = env_ut env - ; liftIO $! uniqFromTagGrimly tag } + ; liftIO $! uniqFromTagGrimily tag } newUniqueSupply :: TcRnIf gbl lcl UniqSupply newUniqueSupply = do { env <- getEnv ; let tag = env_ut env - ; liftIO $! mkSplitUniqSupplyGrimly tag } + ; liftIO $! mkSplitUniqSupplyGrimily tag } cloneLocalName :: Name -> TcM Name -- Make a fresh Internal name with the same OccName and SrcSpan ===================================== compiler/GHC/Types/Name/Cache.hs ===================================== @@ -122,7 +122,7 @@ data NameCache = NameCache type OrigNameCache = ModuleEnv (OccEnv Name) takeUniqFromNameCache :: NameCache -> IO Unique -takeUniqFromNameCache (NameCache c _) = uniqFromTagGrimly c +takeUniqFromNameCache (NameCache c _) = uniqFromTagGrimily c lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache nc mod occ = lookup_infinite <|> lookup_normal ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -38,12 +38,12 @@ module GHC.Types.Unique ( mkUniqueIntGrimily, getKey, mkUnique, unpkUnique, - unpkUniqueGrimly, + unpkUniqueGrimily, mkUniqueInt, eqUnique, ltUnique, incrUnique, stepUnique, - newTagUnique, newTagUniqueGrimly, + newTagUnique, newTagUniqueGrimily, nonDetCmpUnique, isValidKnownKeyUnique, @@ -99,7 +99,7 @@ Note [Performance implications of UniqueTag] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The UniqueTag ADT is meant to be ephemeral and eliminated by the simplifier, so for long term storage (i.e. in monadic environments or data structures) we -want to store the raw 'Char's. Working with the raw tags is done via the *Grimly +want to store the raw 'Char's. Working with the raw tags is done via the *Grimily class of functions For instance, if we are generating a unique for a concrete tag, we should use @@ -116,7 +116,7 @@ newUnique ; liftIO $! uniqFromTag tag } Prefer `env_ut :: Char` and - ; liftIO $! uniqFromTagGrimly tag } + ; liftIO $! uniqFromTagGrimily tag } -} @@ -295,7 +295,7 @@ The stuff about unique *supplies* is handled further down this module. -} unpkUnique :: Unique -> (UniqueTag, Word64) -- The reverse -unpkUniqueGrimly :: Unique -> (Char, Word64) -- The reverse +unpkUniqueGrimily :: Unique -> (Char, Word64) -- The reverse mkUniqueGrimily :: Word64 -> Unique -- A trap-door for UniqSupply getKey :: Unique -> Word64 -- for Var @@ -303,7 +303,7 @@ getKey :: Unique -> Word64 -- for Var incrUnique :: Unique -> Unique stepUnique :: Unique -> Word64 -> Unique newTagUnique :: Unique -> UniqueTag -> Unique -newTagUniqueGrimly :: Unique -> Char -> Unique +newTagUniqueGrimily :: Unique -> Char -> Unique mkUniqueGrimily = MkUnique @@ -323,9 +323,9 @@ maxLocalUnique :: Unique maxLocalUnique = mkLocalUnique uniqueMask -- newTagUnique changes the "domain" of a unique to a different char -newTagUnique u c = newTagUniqueGrimly u (uniqueTag c) +newTagUnique u c = newTagUniqueGrimily u (uniqueTag c) -newTagUniqueGrimly u c = mkUniqueGrimilyWithTag c i where (_,i) = unpkUniqueGrimly u +newTagUniqueGrimily u c = mkUniqueGrimilyWithTag c i where (_,i) = unpkUniqueGrimily u -- | Bitmask that has zeros for the tag bits and ones for the rest. uniqueMask :: Word64 @@ -368,7 +368,7 @@ mkUniqueIntGrimily = MkUnique . intToWord64 {-# INLINE mkUniqueIntGrimily #-} -unpkUniqueGrimly (MkUnique u) +unpkUniqueGrimily (MkUnique u) = let -- The potentially truncating use of fromIntegral here is safe -- because the argument is just the tag bits after shifting. @@ -376,10 +376,10 @@ unpkUniqueGrimly (MkUnique u) i = u .&. uniqueMask in (tag, i) -{-# INLINE unpkUniqueGrimly #-} +{-# INLINE unpkUniqueGrimily #-} -unpkUnique u = case unpkUniqueGrimly u of +unpkUnique u = case unpkUniqueGrimily u of (c, i) -> ( charToUniqueTag c, i) {-# INLINE unpkUnique #-} @@ -389,7 +389,7 @@ unpkUnique u = case unpkUniqueGrimly u of -- See Note [Symbol table representation of names] in "GHC.Iface.Binary" for details. isValidKnownKeyUnique :: Unique -> Bool isValidKnownKeyUnique u = - case unpkUniqueGrimly u of + case unpkUniqueGrimily u of (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22) {- @@ -512,7 +512,7 @@ showUnique :: Unique -> String showUnique uniq = tagStr ++ w64ToBase62 u where - (tag, u) = unpkUniqueGrimly uniq + (tag, u) = unpkUniqueGrimily uniq -- Avoid emitting non-printable characters in pretty uniques. -- See #25989. tagStr ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -16,10 +16,10 @@ module GHC.Types.Unique.Supply ( -- ** Operations on supplies uniqFromSupply, uniqsFromSupply, -- basic ops takeUniqFromSupply, - uniqFromTag, uniqFromTagGrimly, + uniqFromTag, uniqFromTagGrimily, UniqueTag(..), - mkSplitUniqSupply, mkSplitUniqSupplyGrimly, + mkSplitUniqSupply, mkSplitUniqSupplyGrimily, splitUniqSupply, listSplitUniqSupply, -- * Unique supply monad and its abstraction @@ -203,10 +203,10 @@ data UniqSupply -- when split => these two supplies mkSplitUniqSupply :: UniqueTag -> IO UniqSupply -mkSplitUniqSupply ut = mkSplitUniqSupplyGrimly (uniqueTag ut) +mkSplitUniqSupply ut = mkSplitUniqSupplyGrimily (uniqueTag ut) {-# INLINE mkSplitUniqSupply #-} -mkSplitUniqSupplyGrimly :: Char -> IO UniqSupply +mkSplitUniqSupplyGrimily :: Char -> IO UniqSupply -- ^ Create a unique supply out of thin air. -- The "tag" (Char) supplied is mostly cosmetic, making it easier -- to figure out where a Unique was born. See Note [Uniques and tags]. @@ -219,7 +219,7 @@ mkSplitUniqSupplyGrimly :: Char -> IO UniqSupply -- See Note [How the unique supply works] -- See Note [Optimising the unique supply] -mkSplitUniqSupplyGrimly ut +mkSplitUniqSupplyGrimily ut = unsafeDupableInterleaveIO (IO mk_supply) where @@ -286,15 +286,15 @@ initUniqSupply counter inc = do poke ghc_unique_inc inc uniqFromTag :: UniqueTag -> IO Unique -uniqFromTag !ut = uniqFromTagGrimly (uniqueTag ut) +uniqFromTag !ut = uniqFromTagGrimily (uniqueTag ut) {-# INLINE uniqFromTag #-} -uniqFromTagGrimly :: Char -> IO Unique -uniqFromTagGrimly !tag +uniqFromTagGrimily :: Char -> IO Unique +uniqFromTagGrimily !tag = do { uqNum <- genSym ; return $! mkUniqueGrimilyWithTag tag uqNum } -{-# NOINLINE uniqFromTagGrimly #-} -- We'll unbox everything, but we don't want to inline it +{-# NOINLINE uniqFromTagGrimily #-} -- We'll unbox everything, but we don't want to inline it splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply) -- ^ Build two 'UniqSupply' from a single one, each of which ===================================== testsuite/tests/ghc-api/T27273.hs ===================================== @@ -0,0 +1,56 @@ +module Main where + +-- base +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import System.Environment (getArgs) + +-- time +import Data.Time (getCurrentTime) + +-- ghc +import qualified GHC as GHC +import qualified GHC.Core as GHC +import qualified GHC.Data.StringBuffer as GHC +import qualified GHC.Unit.Module.ModGuts as GHC +import qualified GHC.Unit.Types as GHC + +-------------------------------------------------------------------------------- + +main :: IO () +main = do + let inputSource = unlines + [ "module NumLitDesugaring where" + , "f :: Num a => a" -- !!! Succeeds if type signature is f :: Int + , "f = 1" + ] + + void $ compileToCore "NumLitDesugaring" inputSource + +compileToCore :: String -> String -> IO [GHC.CoreBind] +compileToCore modName inputSource = do + [libdir] <- getArgs + GHC.runGhc (Just libdir) $ do + (_ms, tcMod) <- typecheckSourceCode modName inputSource + dsMod <- GHC.desugarModule tcMod + return $ GHC.mg_binds $ GHC.dm_core_module dsMod + +typecheckSourceCode + :: GHC.GhcMonad m => String -> String -> m (GHC.ModSummary, GHC.TypecheckedModule) +typecheckSourceCode modName inputSource = do + now <- liftIO getCurrentTime + df1 <- GHC.getSessionDynFlags + GHC.setSessionDynFlags $ df1 { GHC.backend = GHC.bytecodeBackend } + let target = GHC.Target + { GHC.targetId = GHC.TargetFile (modName ++ ".hs") Nothing + , GHC.targetUnitId = GHC.homeUnitId_ df1 + , GHC.targetAllowObjCode = False + , GHC.targetContents = Just (GHC.stringToStringBuffer inputSource, now) + } + GHC.setTargets [target] + void $ GHC.depanal [] False + + ms <- GHC.getModSummary + (GHC.mkModule GHC.mainUnit (GHC.mkModuleName modName)) + tm <- GHC.parseModule ms >>= GHC.typecheckModule GHC.NoTcMPlugins + return (ms, tm) ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -82,3 +82,6 @@ test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc']) test('T25121_status', normal, compile_and_run, ['-package ghc']) test('T24386', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc']) +test('T27273', [extra_run_opts(f'"{config.libdir}"')], + compile_and_run, + ['-package ghc']) ===================================== testsuite/tests/printer/Makefile ===================================== @@ -907,6 +907,11 @@ Test25885: $(CHECK_PPR) $(LIBDIR) Test25885.hs $(CHECK_EXACT) $(LIBDIR) Test25885.hs +.PHONY: Test27291 +Test27291: + $(CHECK_PPR) $(LIBDIR) Test27291.hs + $(CHECK_EXACT) $(LIBDIR) Test27291.hs + .PHONY: TestLevelImports TestLevelImports: $(CHECK_PPR) $(LIBDIR) TestLevelImports.hs @@ -922,3 +927,8 @@ TestNamedDefaults: PprModifiers: $(CHECK_PPR) $(LIBDIR) PprModifiers.hs $(CHECK_EXACT) $(LIBDIR) PprModifiers.hs + +.PHONY: PprQualifiedStrings +PprQualifiedStrings: + $(CHECK_PPR) $(LIBDIR) PprQualifiedStrings.hs + $(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs ===================================== testsuite/tests/printer/PprQualifiedStrings.hs ===================================== @@ -0,0 +1,75 @@ +{-# LANGUAGE MultilineStrings #-} +{-# LANGUAGE QualifiedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- These are harvested from ../qualified-strings + +module PprQualifiedStrings where + +import Data.Typeable (Typeable, typeOf) +import qualified Example.ByteStringAscii as Ascii +import qualified Example.ByteStringUtf8 as Utf8 +import qualified Example.Text as Text + +exprs :: IO () +exprs = do + inspect "I'm a String" -- would be an ambiguous type error with OverloadedStrings + inspect Text."I'm a Text" + inspect Ascii."I'm an ASCII bytestring: 語" + inspect Utf8."I'm a UTF8 bytestring: 語" + + inspect """ + I'm a multiline + String value + ! + """ + + inspect Text.""" + I'm a multiline + Text value + ! + """ + + inspect Text . """ + I'm a multiline + Text value + """ + + inspect Text . + """ + I'm a multiline + Text value + """ + +pats :: IO () +pats = do + let text = Text."foo" :: Text + case text of + Text."foo" -> putStrLn "Text.\"foo\" matched" + _ -> putStrLn "Text.\"foo\" did not match" + + let ascii = Ascii."語" :: ByteString + case ascii of + Ascii."語" -> putStrLn "Ascii.\"語\" matched" + _ -> putStrLn "Ascii.\"語\" did not match" + + let utf = Utf8."語" :: ByteString + case utf of + Utf8."語" -> putStrLn "Utf8.\"語\" matched" + _ -> putStrLn "Utf8.\"語\" did not match" + +th :: IO () +th = + $(do + foldr (\stmt acc -> [| $stmt >> $acc |]) [| pure () |] $ + [ [| inspect Text."I'm a Text" |] + , [| inspect Ascii."I'm an ASCII bytestring: 語" |] + , [| inspect Utf8."I'm a Utf8 bytestring: 語" |] + , [| + inspect Text.""" + I'm a multiline + Text string + """ + |] + ] + ) ===================================== testsuite/tests/printer/Test27291.hs ===================================== @@ -0,0 +1,35 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +module Test27291 + ( C(type ..) -- exports class C and data family D + , C(data ..) -- exports class C and method m + , D(type ..) -- exports data family D + , type T (..) -- exports type T and all its data constructors D, D2 + , type T (type ..) -- exports type T + , type K (type ..) -- exports type K and its constructor K1 + ) where + +import Control.Applicative qualified as A (type Applicative (data ..)) +import Data.Either qualified as E (type Either (data ..)) + +import Data.Bool (data True (..)) +import Data.Bool (data True( data .. ) ) +import Data.Bool (data True( type ..)) + +import DodgyImports03_helper (C( .. )) +import DodgyImports03_helper (C (data .. )) +import DodgyImports03_helper (C( type ..) ) + +import DodgyImports03_helper (T ( .. ) ) +import DodgyImports03_helper (T(data ..)) +import DodgyImports03_helper (T(type ..)) + +import Control.Applicative (type Applicative (type ..)) -- dodgy: no associated types +import Data.Either (type Either (type ..)) -- dodgy: not a class + +import Data.Proxy (type Proxy(data ..)) -- ok +import Data.Proxy (type Proxy(type ..)) -- dodgy: not a class + +import T25901_sub_g_helper qualified as T1 (T (data ..)) -- T and MkT +import T25901_sub_g_helper qualified as T2 (T (type ..)) -- T only +import T25901_sub_g_helper qualified as T3 (type T (..)) -- T and MkT ===================================== testsuite/tests/printer/all.T ===================================== @@ -217,7 +217,9 @@ test('T24237', normal, compile_fail, ['']) test('Test25454', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25454']) test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885']) +test('Test27291', [ignore_stderr, req_ppr_deps], makefile_test, ['Test27291']) test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports']) test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults']) test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers']) +test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3145,6 +3145,12 @@ instance ExactPrint (HsExpr GhcPs) where body' <- markAnnotated body return (HsQual noExtField ctxt' body') + exact (HsQualLit _ (QualLit _ modu (HsQualString src fs))) = do + modu' <- markAnnotated modu + printStringAdvanceA "." + printSourceTextAA src (show (unpackFS fs)) + return (HsQualLit noExtField (QualLit noExtField modu' (HsQualString src fs))) + exact x = error $ "exact HsExpr for:" ++ showAst x -- --------------------------------------------------------------------- @@ -4581,9 +4587,9 @@ instance ExactPrint (IE GhcPs) where return (IEThingAbs depr' thing' doc') exact (IEThingAll x ns_spec thing doc) = do depr' <- markAnnotated (ieta_warning x) - ns_spec' <- markAnnotated ns_spec thing' <- markAnnotated thing op' <- markEpToken (ieta_tok_lpar x) + ns_spec' <- markAnnotated ns_spec dd' <- markEpToken (ieta_tok_wc x) cp' <- markEpToken (ieta_tok_rpar x) doc' <- markAnnotated doc ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -1826,7 +1826,7 @@ checkConsistency verbosity my_flags = do all_ps = map mungedId pkgs1 let not_broken_pkgs = filterOut broken_pkgs pkgs - (_, trans_broken_pkgs) = closure [] not_broken_pkgs + trans_broken_pkgs = brokenPackages not_broken_pkgs all_broken_pkgs :: [InstalledPackageInfo] all_broken_pkgs = broken_pkgs ++ trans_broken_pkgs @@ -1845,26 +1845,26 @@ checkConsistency verbosity my_flags = do when (not (null all_broken_pkgs)) $ exitWith (ExitFailure 1) -closure :: [InstalledPackageInfo] -> [InstalledPackageInfo] - -> ([InstalledPackageInfo], [InstalledPackageInfo]) -closure pkgs db_stack = go pkgs db_stack - where - go avail not_avail = - case partition (depsAvailable avail) not_avail of - ([], not_avail') -> (avail, not_avail') - (new_avail, not_avail') -> go (new_avail ++ avail) not_avail' +-- | Compute the set of transitive broken packages. +-- +-- A package is assumed to be broken if any of its dependencies is not +-- found in the 'db_stack' after a transitive reduction. +brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] +brokenPackages db_stack = go Set.empty db_stack + where + go avail_ids not_avail = + case partition (depsAvailable avail_ids) not_avail of + ([], not_avail') -> not_avail' + (new_avail, not_avail') -> go (add new_avail avail_ids) not_avail' - depsAvailable :: [InstalledPackageInfo] -> InstalledPackageInfo - -> Bool - depsAvailable pkgs_ok pkg = null dangling - where dangling = filter (`notElem` pids) (depends pkg) - pids = map installedUnitId pkgs_ok + add new_avail avail_ids = + foldl' (flip Set.insert) avail_ids (map installedUnitId new_avail) - -- we want mutually recursive groups of package to show up - -- as broken. (#1750) + depsAvailable :: Set.Set UnitId -> InstalledPackageInfo -> Bool + depsAvailable pids pkg = all (`Set.member` pids) (depends pkg) -brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] -brokenPackages pkgs = snd (closure [] pkgs) + -- we want mutually recursive groups of package to show up + -- as broken. (#1750) ----------------------------------------------------------------------------- -- Sanity-check a new package config, and automatically build GHCi libs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a56de36e2fed3577462bb1266489be… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a56de36e2fed3577462bb1266489be… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T23414] 3 commits: Add support for related locations in Diagnostic
by Simon Jakobi (＠sjakobi2) 23 May '26

23 May '26

Simon Jakobi pushed to branch wip/sjakobi/T23414 at Glasgow Haskell Compiler / GHC Commits: f011f329 by Simon Jakobi at 2026-05-22T23:20:42+02:00 Add support for related locations in Diagnostic - - - - - 75d0d232 by Simon Jakobi at 2026-05-23T14:58:44+02:00 Refactor - - - - - c65d3550 by Simon Jakobi at 2026-05-23T15:07:49+02:00 Fix?! - - - - - 12 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Logger.hs - testsuite/tests/patsyn/should_fail/T14114.stderr - testsuite/tests/patsyn/should_fail/all.T - testsuite/tests/rename/should_fail/all.T - testsuite/tests/rename/should_fail/rnfail004.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail038.stderr Changes: ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -15,6 +15,7 @@ import GHC.Utils.Json import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Logger +import Data.List.NonEmpty (NonEmpty(..)) reportError :: Logger -> NamePprCtx -> DiagOpts -> SrcSpan -> SDoc -> IO () reportError logger nameContext opts span doc = do @@ -47,7 +48,7 @@ printMessages logger msg_opts opts = mapM_ (printMessage logger msg_opts opts) . printMessage :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> MsgEnvelope a -> IO () printMessage logger msg_opts opts message | log_diags_as_json = do - decorated <- decorateDiagnostic logflags messageClass location doc + decorated <- decorateDiagnostic logflags messageClass location sourceSpans doc let rendered :: String rendered = renderWithContext (log_default_user_context logflags) decorated @@ -57,7 +58,7 @@ printMessage logger msg_opts opts message logJsonMsg logger messageClass jsonMessage - | otherwise = logMsg logger messageClass location doc + | otherwise = logMsg (pushLogHook renderWithSourceSpans logger) messageClass location doc where logflags :: LogFlags logflags = logFlags logger @@ -80,9 +81,21 @@ printMessage logger msg_opts opts message diagnostic :: a diagnostic = errMsgDiagnostic message + sourceSpans :: NonEmpty SrcSpan + sourceSpans = location :| diagnosticRelatedLocations diagnostic + severity :: Severity severity = errMsgSeverity message + renderWithSourceSpans :: LogAction -> LogAction + renderWithSourceSpans fallback logflags' msg_class' srcSpan' msg' = + case msg_class' of + MCDiagnostic _ _ _ -> do + decorated <- decorateDiagnostic logflags' msg_class' srcSpan' sourceSpans msg' + fallback logflags' MCInfo noSrcSpan decorated + _ -> + fallback logflags' msg_class' srcSpan' msg' + messageWithHints :: a -> SDoc messageWithHints e = let main_msg = formatBulleted $ diagnosticMessage msg_opts e ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -87,6 +87,18 @@ instance Diagnostic GhcMessage where diagnosticCode = constructorCode @GHC + diagnosticRelatedLocations = \case + GhcPsMessage m + -> diagnosticRelatedLocations m + GhcTcRnMessage m + -> diagnosticRelatedLocations m + GhcDsMessage m + -> diagnosticRelatedLocations m + GhcDriverMessage m + -> diagnosticRelatedLocations m + GhcUnknownMessage m + -> diagnosticRelatedLocations m + instance HasDefaultDiagnosticOpts DriverMessageOpts where defaultOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage) ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -660,9 +660,10 @@ mkNameClashErr gre_env rdr_name gres = TcRnAmbiguousName gre_env rdr_name gres dupNamesErr :: NE.NonEmpty SrcSpan -> NE.NonEmpty RdrName -> RnM () dupNamesErr locs names - = addErrAt big_loc (TcRnBindingNameConflict (NE.head names) locs) + = addErrAt (NE.head sorted_locs) + (TcRnBindingNameConflict (NE.head names) sorted_locs) where - big_loc = foldr1 combineSrcSpans locs + sorted_locs = NE.sortBy leftmost_smallest locs badQualBndrErr :: RdrName -> TcRnMessage badQualBndrErr rdr_name = TcRnQualifiedBinder rdr_name ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3455,6 +3455,18 @@ instance Diagnostic TcRnMessage where diagnosticCode = constructorCode @GHC + diagnosticRelatedLocations = \case + TcRnUnknownMessage m + -> diagnosticRelatedLocations m + TcRnMessageWithInfo _ (TcRnMessageDetailed _ msg') + -> diagnosticRelatedLocations msg' + TcRnWithHsDocContext _ msg' + -> diagnosticRelatedLocations msg' + TcRnBindingNameConflict _ locs + -> NE.tail locs + _ -> + [] + pprTcRnBadlyLevelled :: LevelCheckReason -> Set.Set ThLevelIndex -> ThLevelIndex -> Maybe ErrorItem -> DecoratedSDoc pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt = mkDecorated $ [ fsep [ text "Level error:", pprLevelCheckReason reason ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Types.Error , mkLocMessageWarningGroups , formatDiagnostic , getCaretDiagnostic + , getCaretDiagnostics , jsonDiagnostic @@ -108,8 +109,8 @@ import Data.Bifunctor import Data.Foldable import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE -import Data.List ( intercalate ) -import Data.Maybe ( maybeToList ) +import Data.List ( intercalate, sort ) +import Data.Maybe ( mapMaybe, maybeToList ) import Data.Typeable ( Typeable ) import Numeric.Natural ( Natural ) import Text.Printf ( printf ) @@ -277,6 +278,13 @@ class (Outputable (DiagnosticHint a), HasDefaultDiagnosticOpts (DiagnosticOpts a -- #18516 tracks our progress toward this goal. diagnosticCode :: a -> Maybe DiagnosticCode + -- | Additional locations related to this diagnostic. + -- + -- When rendering caret diagnostics, these locations are shown alongside the + -- message's primary location. + diagnosticRelatedLocations :: a -> [SrcSpan] + diagnosticRelatedLocations _ = [] + -- | An existential wrapper around an unknown diagnostic. data UnknownDiagnostic opts hint where UnknownDiagnostic :: (Diagnostic a, Typeable a) @@ -295,6 +303,7 @@ instance (HasDefaultDiagnosticOpts opts, Outputable hint) => Diagnostic (Unknown diagnosticReason (UnknownDiagnostic _ _ diag) = diagnosticReason diag diagnosticHints (UnknownDiagnostic _ f diag) = map f (diagnosticHints diag) diagnosticCode (UnknownDiagnostic _ _ diag) = diagnosticCode diag + diagnosticRelatedLocations (UnknownDiagnostic _ _ diag) = diagnosticRelatedLocations diag -- A fallback 'DiagnosticOpts' which can be used when there are no options -- for a particular diagnostic. @@ -785,7 +794,25 @@ getSeverityColour severity = case severity of SevIgnore -> const mempty getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc -getCaretDiagnostic msg_class (RealSrcSpan span _) = +getCaretDiagnostic msg_class span = getCaretDiagnostics msg_class (span :| []) + +getCaretDiagnostics :: MessageClass -> NonEmpty SrcSpan -> IO SDoc +getCaretDiagnostics msg_class spans = do + let realSpans = dedupSortedRealSpans spans + maxMarginWidth = + foldl' (\acc s -> max acc (length (show (srcSpanStartLine s)))) 0 realSpans + vcat <$> traverse (getSingleCaretDiagnostic msg_class maxMarginWidth) realSpans + where + dedupSortedRealSpans :: NonEmpty SrcSpan -> [RealSrcSpan] + dedupSortedRealSpans = go Nothing . sort . mapMaybe srcSpanToRealSrcSpan . NE.toList + where + go _ [] = [] + go prev (span:rest) + | Just span == prev = go prev rest + | otherwise = span : go (Just span) rest + +getSingleCaretDiagnostic :: MessageClass -> Int -> RealSrcSpan -> IO SDoc +getSingleCaretDiagnostic msg_class maxMarginWidth span = caretDiagnostic <$> getSrcLine (srcSpanFile span) row where getSrcLine fn i = @@ -848,9 +875,9 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) = | otherwise = srcSpanEndCol span - 1 width = max 1 (end - start) - marginWidth = length rowStr + marginWidth = maxMarginWidth marginSpace = replicate marginWidth ' ' ++ " |" - marginRow = rowStr ++ " |" + marginRow = replicate (marginWidth - length rowStr) ' ' ++ rowStr ++ " |" (srcLinePre, srcLineRest) = splitAt start srcLine (srcLineSpan, srcLinePost) = splitAt width srcLineRest @@ -858,7 +885,6 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) = caretEllipsis | multiline = "..." | otherwise = "" caretLine = replicate start ' ' ++ replicate width '^' ++ caretEllipsis -getCaretDiagnostic _ _ = pure empty -- -- Queries -- ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -84,7 +84,7 @@ import GHC.Prelude import GHC.Driver.Flags import GHC.Types.Error ( MessageClass (..), Severity (..) - , mkLocMessageWarningGroups,getCaretDiagnostic ) + , mkLocMessageWarningGroups, getCaretDiagnostics ) -- import GHC.Types.Error () import GHC.Types.SrcLoc @@ -102,6 +102,7 @@ import System.FilePath ( takeDirectory, (</>) ) import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) import Data.List (stripPrefix) +import Data.List.NonEmpty (NonEmpty(..)) import Data.Time import System.IO import Control.Monad @@ -423,7 +424,8 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg MCInfo -> printErrs msg MCFatal -> printErrs msg MCDiagnostic SevIgnore _ _ -> pure () -- suppress the message - MCDiagnostic _sev _rea _code -> decorateDiagnostic logflags msg_class srcSpan msg >>= printErrs + MCDiagnostic _sev _rea _code -> + decorateDiagnostic logflags msg_class srcSpan (srcSpan :| []) msg >>= printErrs where printOut = defaultLogActionHPrintDoc logflags False out printErrs = defaultLogActionHPrintDoc logflags False err @@ -463,8 +465,8 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg -- `defaultLogActionWithHandles`) -- -- This story is tracked by #24113. -decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO SDoc -decorateDiagnostic logflags msg_class srcSpan msg = addCaret +decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> NonEmpty SrcSpan -> SDoc -> IO SDoc +decorateDiagnostic logflags msg_class srcSpan sourceSpans msg = addCaret where -- Pretty print the warning flag, if any (#10752) message :: SDoc @@ -474,7 +476,7 @@ decorateDiagnostic logflags msg_class srcSpan msg = addCaret addCaret = do caretDiagnostic <- if log_show_caret logflags - then getCaretDiagnostic msg_class srcSpan + then getCaretDiagnostics msg_class sourceSpans else pure empty return $ getPprStyle $ \style -> withPprStyle (setStyleColoured True style) ===================================== testsuite/tests/patsyn/should_fail/T14114.stderr ===================================== @@ -1,18 +1,36 @@ - T14114.hs:4:20: error: [GHC-10498] • Conflicting definitions for ‘a’ Bound at: T14114.hs:4:20 T14114.hs:4:22 • In a pattern synonym declaration + | +4 | pattern Foo1 a <- (a,a) + | ^ + | +4 | pattern Foo1 a <- (a,a) + | ^ T14114.hs:5:20: error: [GHC-10498] • Conflicting definitions for ‘a’ Bound at: T14114.hs:5:20 T14114.hs:5:22 • In a pattern synonym declaration + | +5 | pattern Foo2 a = (a,a) + | ^ + | +5 | pattern Foo2 a = (a,a) + | ^ T14114.hs:6:20: error: [GHC-10498] • Conflicting definitions for ‘a’ Bound at: T14114.hs:6:20 T14114.hs:6:22 • In a pattern synonym declaration + | +6 | pattern Foo3 a <- (a,a) where + | ^ + | +6 | pattern Foo3 a <- (a,a) where + | ^ + ===================================== testsuite/tests/patsyn/should_fail/all.T ===================================== @@ -40,7 +40,7 @@ test('T26465', normal, compile_fail, ['']) test('T13349', normal, compile_fail, ['']) test('T13470', normal, compile_fail, ['']) test('T14112', normal, compile_fail, ['']) -test('T14114', normal, compile_fail, ['']) +test('T14114', normal, compile_fail, ['-fdiagnostics-show-caret']) test('T14507', normal, compile_fail, ['-dsuppress-uniques']) test('T15289', normal, compile_fail, ['']) test('T15685', normal, compile_fail, ['']) ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -1,7 +1,7 @@ test('rnfail001', normal, compile_fail, ['']) test('rnfail002', normal, compile_fail, ['']) test('rnfail003', normal, compile_fail, ['']) -test('rnfail004', normal, compile_fail, ['']) +test('rnfail004', normal, compile_fail, ['-fdiagnostics-show-caret']) test('rnfail007', normal, compile_fail, ['']) test('rnfail008', normal, compile_fail, ['']) test('rnfail009', normal, compile_fail, ['']) ===================================== testsuite/tests/rename/should_fail/rnfail004.stderr ===================================== @@ -1,10 +1,22 @@ - -rnfail004.hs:6:5: [GHC-10498] +rnfail004.hs:6:5: error: [GHC-10498] Conflicting definitions for ‘a’ Bound at: rnfail004.hs:6:5 rnfail004.hs:7:10 + | +6 | a = [] + | ^ + | +7 | (b,c,a) = ([],[],d) + | ^ -rnfail004.hs:7:6: [GHC-10498] +rnfail004.hs:7:6: error: [GHC-10498] Conflicting definitions for ‘b’ Bound at: rnfail004.hs:7:6 rnfail004.hs:8:8 + | +7 | (b,c,a) = ([],[],d) + | ^ + | +8 | [d,b,_] = ([],a,[]) + | ^ + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -31,7 +31,7 @@ test('tcfail034', normal, compile_fail, ['']) test('tcfail035', normal, compile_fail, ['']) test('tcfail036', normal, compile_fail, ['']) test('tcfail037', normal, compile_fail, ['']) -test('tcfail038', normal, compile_fail, ['']) +test('tcfail038', normal, compile_fail, ['-fdiagnostics-show-caret']) test('tcfail040', normal, compile_fail, ['']) test('tcfail041', normal, compile_fail, ['']) test('tcfail042', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail038.stderr ===================================== @@ -1,10 +1,22 @@ - -tcfail038.hs:7:11: [GHC-10498] +tcfail038.hs:7:11: error: [GHC-10498] Conflicting definitions for ‘==’ Bound at: tcfail038.hs:7:11-12 tcfail038.hs:9:11-12 + | +7 | a == b = True + | ^^ + | +9 | a == b = False + | ^^ -tcfail038.hs:8:11: [GHC-10498] +tcfail038.hs:8:11: error: [GHC-10498] Conflicting definitions for ‘/=’ Bound at: tcfail038.hs:8:11-12 tcfail038.hs:10:11-12 + | + 8 | a /= b = False + | ^^ + | +10 | a /= b = True + | ^^ + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9de8fc388fdf0ce440f01e7215ddb1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9de8fc388fdf0ce440f01e7215ddb1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/module-graph-reuse-in-downsweep] 24 commits: Introduce a cache of home module name providers
by Wolfgang Jeltsch (＠jeltsch) 23 May '26

23 May '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/module-graph-reuse-in-downsweep at Glasgow Haskell Compiler / GHC Commits: 5fab2238 by Wolfgang Jeltsch at 2026-05-12T21:24:27+03:00 Introduce a cache of home module name providers This contribution introduces to the module graph a cache that maps home module names to sets of units providing them and changes the finder to use that cache. This is a performance optimization, especially for multi-home-unit builds. The particular changes are as follows: * In `GHC.Unit.Module.Graph`, `ModuleGraph` is extended with a new field `mg_home_module_name_providers_map`, exposed as `mgHomeModuleNameProvidersMap`. This is a cache that assigns to each home module name the set of IDs of home units that define it. Operations that construct module graphs are updated such that this cache stays synchronized. * In `GHC.Unit.Finder`, `findImportedModule` is changed to pull `mgHomeModuleNameProvidersMap` from `hsc_mod_graph` and pass it to `findImportedModuleNoHsc`, which now does not search home units in arbitrary order but prioritizes those units that the cache mentions as potential providers of the requested module. In addition, this contribution adds variants of the two multi-component compiler performance tests that use 100 units instead of 20, because with just 20 units the benefits from caching of home module name providers are still negligible. The following table shows the total time needed for running both multi-component tests before and after this contribution and with different numbers of units: | # of units | Before | After | |-----------:|-------:|------:| | 20 | 0:12 | 0:12 | | 100 | 0:47 | 0:42 | | 200 | 3:05 | 2:08 | Note that there seems to be a general overhead of 12 seconds that is not attributable to the actual tests, so that the real running times should be 12 seconds smaller than shown above. Resolves #27055. Metric Decrease: MultiComponentModules MultiComponentModulesRecomp Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com> Co-authored-by: Fendor <fendor(a)posteo.de> - - - - - 38b76b2f by Cheng Shao at 2026-05-13T17:48:48-04:00 testsuite: mark T22159 as fragile This patch marks T22159 as fragile on Windows for issue described in #27248. Before we get to the bottom of those failures, this unblocks newer Windows runners. - - - - - 50188615 by Ian Duncan at 2026-05-14T13:45:07+02:00 AArch64: use ASR not LSR for MO_U_Shr at W8/W16 The unsigned right shift (MO_U_Shr) for sub-word widths (W8, W16) with a variable shift amount was emitting ASR (arithmetic/signed shift right) after zero-extending with UXTB/UXTH. This should be LSR (logical/unsigned shift right). After zero-extension the upper bits happen to be 0 so ASR produces the same result, but it is semantically wrong and would break if the zero-extension were ever optimized away. Includes assembly output test (grep for lsr) and runtime test verifying unsigned right shift of Word8 and Word16 values. - - - - - 28666fbf by Vladislav Zavialov at 2026-05-19T12:44:05-04:00 Add type families: Tuple, Constraints, Tuple#, Sum# (#27179) These type families map tuples of types to the corresponding Tuple<N>, Tuple<N>#, CTuple<N>, and Sum<N># types. Some examples at N=2: Tuple (Int, Bool) = Tuple2 Int Bool Constraints (Show a, Eq a) = CTuple2 (Show a) (Eq a) Tuple# (Int#, Float#) = Tuple2# Int# Float# Sum# (Int#, Float#) = Sum2# Int# Float# See GHC Proposal #145 "Non-punning list and tuple syntax". To make the Sum# instance at N=64 possible, this patch also introduces the Sum64# constructor declaration and bumps mAX_SUM_SIZE from 63 to 64. Metric Increase: ghc_experimental_dir - - - - - 41c2448b by Wen Kokke at 2026-05-19T12:44:53-04:00 rts: Add IPE event class for -l This commit adds a new IPE event class to the -l RTS flag. Previously, IPE events were enabled unconditionally. However, the IPE events can easily grow to hundreds or thousands of megabytes. With the new event class you can pass, e.g., -l-I to disable IPE events. - - - - - 62536551 by Wen Kokke at 2026-05-19T12:44:53-04:00 ghc-internal: Add TraceFlags.traceIPE - - - - - e45312d1 by Wen Kokke at 2026-05-19T12:44:53-04:00 testsuite: Add test for TraceFlags.traceIpe - - - - - 4768d9aa by Wen Kokke at 2026-05-19T12:44:53-04:00 ghc-internal: Add DebugFlags.ipe - - - - - bc1b5c69 by Wen Kokke at 2026-05-19T12:44:53-04:00 testsuite: Add test for DebugFlags.ipe - - - - - 0da1543f by Duncan Coutts at 2026-05-19T12:45:37-04:00 Document removal of the signal-based interval timer Update mentions within the RTS section of the users guide. Add a changelog entry. - - - - - b2911514 by Duncan Coutts at 2026-05-19T12:45:37-04:00 Fix section for an recent changelog entry - - - - - d6d76a7a by David Eichmann at 2026-05-19T12:46:19-04:00 ghc-toolchain: implement llvm program versioning logic - - - - - 2dd36fa3 by Wolfgang Jeltsch at 2026-05-20T04:49:52-04:00 Turn `Trustworthy` into `Safe` in `base` where possible - - - - - f4399dd1 by Wolfgang Jeltsch at 2026-05-20T04:50:37-04:00 Make the current `base` buildable with GHC 10.0 - - - - - 1a7de232 by Duncan Coutts at 2026-05-20T12:26:25-04:00 Hadrian: remove legacy rts .so symlinks For compatibility with the old makefile based build system, hadrian had rules to generate symlinks from unversioned to versioned names for the rts .so/.dynlib file, like libHSrts-ghcx.y.so -> libHSrts-1.0.3-ghcx.y.so We no longer need these symlinks since the makefile build system has been retired some time ago. The need for these symlinks is awkward on windows where we cannot (in practice) create symlinks. So rather than make them conditional (non-windows), just remove them entirely. - - - - - 286f1adf by fendor at 2026-05-20T12:27:09-04:00 Fix regression T27202: `:load` and `:add` work in GHCi To fix the regression there are conceptually two major things that we fix: * We don't remove the `importDirs` from `interactive-session` * When `:add`ing a module, we don't try to find them via PackageImports * The PackageImport is wrong as we can't know the package-name at this stage in ghc/UI.hs What does it mean to not remove the `importDirs` from `interactive-session`? It means that, given some initial `DynFlags`, we will use those `importDirs` in `interactive-session`. The initial `DynFlags`, however, depend on how you initialise the GHC session. For a simple session, initialised by ghc -isrc -this-unit-id main It is simple, just use the `DynFlags` given on the cli. Thus, `main` and `interactive-session` will have the same `DynFlags`, except for the `homeUnitId` and `interactive-session` depends on `main` by construction of the GHCi session. What about a multiple home unit session, though? ghc -unit @unit1 -unit @unit2 What are the `DynFlags` in this cli invocation? It shouldn't be either `@unti1` nor `@unit2`, as the order shouldn't matter or any other implicit condition. For consistency, we decide that the initial `DynFlags` are the top `DynFlags` on the cli, ignoring `-unit` flags. Thus, in this example, there are no `importsDirs` regardless of what we might find in `@unit1` and `@unit2`. But in this invocation: ghc -isrc -unit @unit1 -unit @unit2 The `interactive-session` will have the `importsDirs` `src`. Note, `-isrc` will be inherited in `@unit1` and `@unit2`, so you need to explicitly use `-i` to clear the `importsDirs`, in order to avoid accidentally adding `src` as an import directory to all other home units. This fix has been made possible by the improvements introduced in !15888, which avoids ambiguity when a home unit shares the `importsDirs` with the `interactive-session`, on top of being much faster for multiple home units. Adds regression tests for T27202 for `:load`ing and `:add`ing modules that are located in import directories. - - - - - 728662de by fendor at 2026-05-20T12:27:09-04:00 Use home unit package db stacks in GHCi prompt and session unit In order to import modules from home unit dependencies (e.g., `Data.Map`), the ghci prompt unit needs to populate its `UnitState`. This is tricky to handle correctly, which `PackageDBFlag`s should we use to populate the `UnitState`? We decide, the most intuitive solution for users is to depend on all `PackageDBFlag`s, so that any dependency can be imported in GHCi. This assumes consistency in the `PackageDBFlag`s, so no two home units specify `PackageDBFlag`s that are inconsistent with each other. We could simply concat all the `PackageDBFlag`s of the existing home units, but later `PackageDBFlag`s shadow earlier ones, leading to the last processed home units' `PackageDBFlag`s to shadow the earlier ones. This is hard to fix, we need to give users the capability to provide ghc options for the ghci prompt home unit. However, as this is considerably more work, we decided on an approximation that should work out most of the time. Package Db stacks in cabal and stack follow a certain structure: -no-user-package-db > -package-db $cabal-store > -package-db $local-db The first two arguments are always the same, namely the `-no-user-package-db` and `-package-db`. We compute the longest common prefix over all home units, and use that as the start of the package db stack. Then, over the rest of the `PackageDBFlag`s, we simply take the union and append them to our initial stack. We assume, that the rest of package dbs only defines very few, "local" units that are usually not shadowing each other. This allows us to get a relatively consistent package database stack for the ghci prompt home unit. Similar reasoning applies to the session unit in order to add modules to the session and have dependencies available in the module. We do something similar for `-package` flags, to make sure only the correct units are actually visible in the ghci session. This time, we simply take the union of all `PackageFlag`s, allowing us to import modules from the home unit dependencies. In the future, it would be beneficial to allow the user to provide the exact ghc options to control the visibilities. For now, this will have to do. - - - - - 740d89a0 by Simon Peyton Jones at 2026-05-20T17:20:44-04:00 Do not use mkCast during typechecking This commit fixes #27219. The problem was that the typechecker was using `mkCast`, whose assertion checks legitimately fail when applied to types that contain unification variables. - - - - - a50fdb06 by Simon Peyton Jones at 2026-05-20T17:20:45-04:00 Major refactor of the Simplifier The main payload of this patch is to refactor the Simplifer to avoid repeated simplification when using Plan (AFTER) for rule rewrites. The need for this was shown up by #26989. See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration. Related refactoring: * Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`. Reason: the envt is irrelevant in the "simplified" case, so the data type describes the possiblitiies much more accurately now. * Some refactoring in `knownCon` to split off `wrapDataConFloats`. * Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`, a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule. This RuleMatch returns fragments of the target in rm_args and rm_floats, leaving `rm_rhs` to be the stuff from the RULE itself. Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes there but all routine. * When doing occurrence analysis on RULEs, make the occ-info on the rule binders relate just to the RHS, not the LHS. See (OUR1) in Note Note [OccInfo in unfoldings and rules] This means that Lint must not complain about the fact that the patterns in the RULE mentions binders that are marked dead. See Note [Dead occurrences] in GHC.Core.Lint. I changed the Core pretty-printer so that it didn't suppress dead binders, else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles. * Refactor FloatBinds, so that it is used both by `exprIsConApp_mabye` and by `lookupRule` * Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core. * Add FloatTick as an extra constructor. * Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`. This refactor just shares more code. (Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious name clash with GHC.Core.FloatBinds.) Corecion optimisation * In simpleOpt, when composing coercions, call new function `optTransCo`. This is much lighter weight than full blown coercion optimisation. * Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the coercionLKind of the coercion. This saves recomputing that coercionLKind at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast. * Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`. * In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`. I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal]. * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration. The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have Compiler allocs: Before: 7,363M After: 688M Compile time goes down generally. Here are compiler-alloc changes over 0.5%: CoOpt_Read(normal) 729,184,920 -0.7% CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD LargeRecord(normal) 1,227,056,876 +1.1% T12227(normal) 256,827,604 -4.6% GOOD T12425(optasm) 76,879,410 -0.8% T12545(normal) 787,826,918 -10.8% GOOD T12707(normal) 775,186,464 -0.9% T13253(normal) 318,599,596 -0.8% T14766(normal) 685,857,320 -1.0% T15304(normal) 1,123,333,422 -2.2% T15630(normal) 123,142,330 -2.6% T15630a(normal) 123,092,100 -2.6% T15703(normal) 299,751,682 -2.9% GOOD T17516(normal) 964,072,280 +1.0% T18223(normal) 367,016,820 -6.2% GOOD T18730(optasm) 130,643,770 -3.3% GOOD T20261(normal) 535,608,584 -0.7% T21839c(normal) 340,340,436 -0.9% T24984(normal) 85,568,392 -1.9% T3064(normal) 174,631,992 -1.2% T3294(normal) 1,215,886,432 -0.7% T5030(normal) 141,449,704 -17.2% GOOD T5321Fun(normal) 258,484,744 -1.9% T8095(normal) 770,532,232 -2.7% T9630(normal) 858,423,408 -14.5% GOOD T9872c(normal) 1,591,709,448 +0.7% info_table_map_perf(normal) 19,700,614,458 -1.3% geo. mean -0.7% minimum -17.2% maximum +1.1% However, strangely there seems to be a 5.0% increase in CoOpt_Read in the x86_64-linux-fedora43-validate+debug_info+ubsan job, although there generally a /decrease/ in this test in other builds. The baseline value looks strange. Anyway I'll just accept it. Metric Decrease: CoOpt_Singletons T12227 T12545 T12707 T15703 T18223 T18730 T21839c T5030 T9630 Metric Increase: CoOpt_Read - - - - - 834623d4 by Mrjtjmn at 2026-05-20T17:21:41-04:00 users-guide: Fix weird notation in "Summary of stolen syntax" - - - - - 6f9d7c71 by Markus Läll at 2026-05-21T15:25:34-04:00 Use "grimily" instead of "grimly" Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/27221 - - - - - 50e999ca by fendor at 2026-05-21T15:26:18-04:00 Speed up 'closure' computation in `ghc-pkg` Cache the set of already seen `UnitId`s and use `Set` operations to speed up 'closure' computation. Further simplify the implementation of 'closure' to account for the actual usage. As a consequence, we rename 'closure' to 'brokenPackages' to reflect its purpose better after the simplification. - - - - - 7ecc6184 by sheaf at 2026-05-21T15:27:10-04:00 TcMPluginHandling: be more lenient when no plugins This change ensures that, if a function such as 'typecheckModule' was invoked with 'NoTcMPlugins', GHC doesn't spuriously complain about TcM plugins having already been stopped, as there were none to start with. - - - - - 89e7a6ba by Wolfgang Jeltsch at 2026-05-23T15:38:37+03:00 Allow `downsweep` to use nodes of an existing module graph To this end, `downsweep` has not been able to use the nodes of a module graph obtained from a previous downsweeping round. In some GHC API applications, downsweeping is performed somewhat incrementally and therefore could profit from reusing such existing results. This contribution makes this possible. Resolves #27054. Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com> - - - - - 234 changed files: - + changelog.d/T26979 - + changelog.d/T27202 - changelog.d/dynamic-trace-flags - + changelog.d/ghc-pkg-faster-closure - + changelog.d/ipe-event-class - + changelog.d/lib-add-tuple-tyfam-27179 - + changelog.d/more-efficient-home-unit-imports-finding - + changelog.d/no-more-timer-signal - + changelog.d/rts_symlinks.md - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/State.hs - docs/users_guide/exts/stolen_syntax.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/profiling.rst - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - libraries/base/src/Control/Exception.hs - libraries/base/src/Control/Monad/IO/Class.hs - libraries/base/src/Data/Data.hs - libraries/base/src/Data/Fixed.hs - libraries/base/src/Data/List/NonEmpty.hs - libraries/base/src/Data/Version.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/ByteOrder.hs - libraries/base/src/GHC/Exts.hs - libraries/base/src/Numeric.hs - libraries/base/src/System/IO.hs - libraries/base/src/System/Timeout.hs - libraries/ghc-experimental/src/Data/Sum/Experimental.hs - libraries/ghc-experimental/src/Data/Tuple/Experimental.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghc-internal/src/GHC/Internal/Types.hs - m4/ghc_toolchain.m4 - rts/IPE.c - rts/RtsFlags.c - rts/Trace.c - rts/Trace.h - rts/include/rts/EventLogWriter.h - rts/include/rts/Flags.h - testsuite/tests/codeGen/should_compile/T25177.stderr - + testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.asm - + testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.hs - + testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.asm - + testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.hs - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_run/aarch64-subword-ops.hs - + testsuite/tests/codeGen/should_run/aarch64-subword-ops.stdout - + testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.hs - + testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/driver/fat-iface/fat014.stdout - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/ghc-api/T27273.hs - testsuite/tests/ghc-api/all.T - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.stdout - testsuite/tests/ghc-api/downsweep/OldModLocation.hs - testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs - + testsuite/tests/ghci/prog-mhu006/Makefile - + testsuite/tests/ghci/prog-mhu006/a/A.hs - + testsuite/tests/ghci/prog-mhu006/all.T - + testsuite/tests/ghci/prog-mhu006/b/B.hs - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout - + testsuite/tests/ghci/prog-mhu006/unitA - + testsuite/tests/ghci/prog-mhu006/unitB - testsuite/tests/ghci/prog003/prog003.T - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/ghci/prog020/Makefile - testsuite/tests/ghci/prog020/all.T - testsuite/tests/ghci/prog020/ghci.prog020.script → testsuite/tests/ghci/prog020/ghci.prog020a.script - testsuite/tests/ghci/prog020/ghci.prog020.stderr → testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020.stdout → testsuite/tests/ghci/prog020/ghci.prog020a.stdout - + testsuite/tests/ghci/prog020/ghci.prog020b.script - + testsuite/tests/ghci/prog020/ghci.prog020b.stderr - + testsuite/tests/ghci/prog020/ghci.prog020b.stdout - + testsuite/tests/ghci/prog023/Makefile - + testsuite/tests/ghci/prog023/all.T - + testsuite/tests/ghci/prog023/prog023a.script - + testsuite/tests/ghci/prog023/prog023a.stdout - + testsuite/tests/ghci/prog023/prog023b.script - + testsuite/tests/ghci/prog023/prog023b.stdout - + testsuite/tests/ghci/prog023/src/A.hs - + testsuite/tests/ghci/prog024/Makefile - + testsuite/tests/ghci/prog024/all.T - + testsuite/tests/ghci/prog024/prog024a.script - + testsuite/tests/ghci/prog024/prog024a.stdout - + testsuite/tests/ghci/prog024/prog024b.script - + testsuite/tests/ghci/prog024/prog024b.stdout - + testsuite/tests/ghci/prog024/prog024c.script - + testsuite/tests/ghci/prog024/prog024c.stderr - + testsuite/tests/ghci/prog024/prog024c.stdout - + testsuite/tests/ghci/prog024/prog024d.script - + testsuite/tests/ghci/prog024/prog024d.stderr - + testsuite/tests/ghci/prog024/prog024d.stdout - + testsuite/tests/ghci/prog024/prog024e.script - + testsuite/tests/ghci/prog024/prog024e.stdout - + testsuite/tests/ghci/prog024/prog024f.script - + testsuite/tests/ghci/prog024/prog024f.stdout - + testsuite/tests/ghci/prog024/src/A.hs - + testsuite/tests/ghci/prog024/src/B.hs - + testsuite/tests/ghci/prog025/Makefile - + testsuite/tests/ghci/prog025/a/A.hs - + testsuite/tests/ghci/prog025/all.T - + testsuite/tests/ghci/prog025/prog025a.script - + testsuite/tests/ghci/prog025/prog025a.stdout - + testsuite/tests/ghci/prog025/prog025b.script - + testsuite/tests/ghci/prog025/prog025b.stdout - + testsuite/tests/ghci/prog025/testpkg/Test.hs - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg - + testsuite/tests/ghci/prog025/unitA - testsuite/tests/ghci/scripts/ListTuplePunsPprNoAbbrevTuple.stdout - testsuite/tests/ghci/scripts/T13997.stdout - testsuite/tests/ghci/scripts/T1914.stdout - testsuite/tests/ghci/scripts/T20217.stdout - testsuite/tests/ghci/scripts/T8042.stdout - testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/ghci/should_run/T10920.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/linters/notes.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T20347.stderr - testsuite/tests/numeric/should_compile/T20374.stderr - testsuite/tests/numeric/should_compile/T20376.stderr - testsuite/tests/parser/should_compile/ListTuplePunsSuccess1.hs - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/parser/should_fail/ListTuplePunsFail6.hs - + testsuite/tests/parser/should_fail/ListTuplePunsFail6.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/parser/should_run/ListTuplePunsConstraints.hs - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/T26989.hs - + testsuite/tests/perf/compiler/T26989a.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/perf/compiler/genMultiComp.py - testsuite/tests/printer/T18052a.stderr - testsuite/tests/profiling/should_run/callstack001.stdout - + testsuite/tests/rts/T25275/DebugIpe.hs - + testsuite/tests/rts/T25275/T25275_A.stdout - + testsuite/tests/rts/T25275/T25275_B.stdout - + testsuite/tests/rts/T25275/T25275_C.stdout - + testsuite/tests/rts/T25275/T25275_D.stdout - + testsuite/tests/rts/T25275/TraceIpe.hs - + testsuite/tests/rts/T25275/all.T - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T18668.stderr - testsuite/tests/simplCore/should_compile/T19246.stderr - testsuite/tests/simplCore/should_compile/T19599.stderr - testsuite/tests/simplCore/should_compile/T19599a.stderr - testsuite/tests/simplCore/should_compile/T21917.stderr - testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - testsuite/tests/simplCore/should_compile/T25160.stderr - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26051.stderr - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/T8848a.stderr - testsuite/tests/simplCore/should_compile/spec004.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr - + testsuite/tests/typecheck/should_compile/T23135.hs - testsuite/tests/typecheck/should_compile/all.T - utils/ghc-pkg/Main.hs - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c793b4500bdd9712010b25d404cc87… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c793b4500bdd9712010b25d404cc87… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/module-graph-reuse-in-downsweep] Fix test setup
by Wolfgang Jeltsch (＠jeltsch) 23 May '26

23 May '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/module-graph-reuse-in-downsweep at Glasgow Haskell Compiler / GHC Commits: c793b450 by Wolfgang Jeltsch at 2026-05-23T15:02:21+03:00 Fix test setup - - - - - 9 changed files: - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/A.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/B.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/C.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/D.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/X.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Y.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Z.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs - testsuite/tests/ghc-api/downsweep/all.T Changes: ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.hs ===================================== @@ -33,7 +33,7 @@ import GHC ) sourceDirectory :: String -sourceDirectory = "IncrementalDownsweep" +sourceDirectory = "IncrementalDownsweep.modules" withSimpleErrorHandler :: Ghc a -> Ghc a withSimpleErrorHandler = defaultErrorHandler defaultFatalMessager ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/A.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/B.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/C.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/D.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/X.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Y.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Z.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -16,7 +16,8 @@ test('OldModLocation', ['-package ghc']) test('IncrementalDownsweep', - [ extra_run_opts('"' + config.libdir + '"') + [ extra_files(['IncrementalDownsweep.modules/*']) + , extra_run_opts('"' + config.libdir + '"') ], compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c793b4500bdd9712010b25d404cc872… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c793b4500bdd9712010b25d404cc872… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/module-graph-reuse-in-downsweep] Fix test setup
by Wolfgang Jeltsch (＠jeltsch) 23 May '26

23 May '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/module-graph-reuse-in-downsweep at Glasgow Haskell Compiler / GHC Commits: a303667c by Wolfgang Jeltsch at 2026-05-23T14:58:06+03:00 Fix test setup - - - - - 8 changed files: - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/A.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/B.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/C.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/D.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/X.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Y.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Z.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs - testsuite/tests/ghc-api/downsweep/all.T Changes: ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/A.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/B.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/C.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/D.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/X.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Y.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/IncrementalDownsweep/Z.hs → testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs ===================================== ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -16,7 +16,8 @@ test('OldModLocation', ['-package ghc']) test('IncrementalDownsweep', - [ extra_run_opts('"' + config.libdir + '"') + [ extra_files(['IncrementalDownsweep.modules/*']) + , extra_run_opts('"' + config.libdir + '"') ], compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a303667c703a9870e39bddb0cfde86a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a303667c703a9870e39bddb0cfde86a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/T27291-namespace-specified-wildcards] EPA: Fix exact printing namespace-specified wildcards
by Alan Zimmerman (＠alanz) 23 May '26

23 May '26

Alan Zimmerman pushed to branch wip/az/T27291-namespace-specified-wildcards at Glasgow Haskell Compiler / GHC Commits: 1fb5b6b6 by Alan Zimmerman at 2026-05-23T12:55:01+01:00 EPA: Fix exact printing namespace-specified wildcards Ensures correct printing of imports of the form import Data.Bool (data True(data ..)) import Data.Bool (data True(type ..)) Closes #27291 - - - - - 4 changed files: - testsuite/tests/printer/Makefile - + testsuite/tests/printer/Test27291.hs - testsuite/tests/printer/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== testsuite/tests/printer/Makefile ===================================== @@ -907,6 +907,11 @@ Test25885: $(CHECK_PPR) $(LIBDIR) Test25885.hs $(CHECK_EXACT) $(LIBDIR) Test25885.hs +.PHONY: Test27291 +Test27291: + $(CHECK_PPR) $(LIBDIR) Test27291.hs + $(CHECK_EXACT) $(LIBDIR) Test27291.hs + .PHONY: TestLevelImports TestLevelImports: $(CHECK_PPR) $(LIBDIR) TestLevelImports.hs ===================================== testsuite/tests/printer/Test27291.hs ===================================== @@ -0,0 +1,35 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +module Test27291 + ( C(type ..) -- exports class C and data family D + , C(data ..) -- exports class C and method m + , D(type ..) -- exports data family D + , type T (..) -- exports type T and all its data constructors D, D2 + , type T (type ..) -- exports type T + , type K (type ..) -- exports type K and its constructor K1 + ) where + +import Control.Applicative qualified as A (type Applicative (data ..)) +import Data.Either qualified as E (type Either (data ..)) + +import Data.Bool (data True (..)) +import Data.Bool (data True( data .. ) ) +import Data.Bool (data True( type ..)) + +import DodgyImports03_helper (C( .. )) +import DodgyImports03_helper (C (data .. )) +import DodgyImports03_helper (C( type ..) ) + +import DodgyImports03_helper (T ( .. ) ) +import DodgyImports03_helper (T(data ..)) +import DodgyImports03_helper (T(type ..)) + +import Control.Applicative (type Applicative (type ..)) -- dodgy: no associated types +import Data.Either (type Either (type ..)) -- dodgy: not a class + +import Data.Proxy (type Proxy(data ..)) -- ok +import Data.Proxy (type Proxy(type ..)) -- dodgy: not a class + +import T25901_sub_g_helper qualified as T1 (T (data ..)) -- T and MkT +import T25901_sub_g_helper qualified as T2 (T (type ..)) -- T only +import T25901_sub_g_helper qualified as T3 (type T (..)) -- T and MkT ===================================== testsuite/tests/printer/all.T ===================================== @@ -217,6 +217,7 @@ test('T24237', normal, compile_fail, ['']) test('Test25454', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25454']) test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885']) +test('Test27291', [ignore_stderr, req_ppr_deps], makefile_test, ['Test27291']) test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports']) test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -4581,9 +4581,9 @@ instance ExactPrint (IE GhcPs) where return (IEThingAbs depr' thing' doc') exact (IEThingAll x ns_spec thing doc) = do depr' <- markAnnotated (ieta_warning x) - ns_spec' <- markAnnotated ns_spec thing' <- markAnnotated thing op' <- markEpToken (ieta_tok_lpar x) + ns_spec' <- markAnnotated ns_spec dd' <- markEpToken (ieta_tok_wc x) cp' <- markEpToken (ieta_tok_rpar x) doc' <- markAnnotated doc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fb5b6b649e93b0120728e17f0527bf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fb5b6b649e93b0120728e17f0527bf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/T27274-epa-qualified-multiline-string] EPA: Fix span for qualified multiline string
by Alan Zimmerman (＠alanz) 23 May '26

23 May '26

Alan Zimmerman pushed to branch wip/az/T27274-epa-qualified-multiline-string at Glasgow Haskell Compiler / GHC Commits: 478c6325 by Alan Zimmerman at 2026-05-23T10:17:35+01:00 EPA: Fix span for qualified multiline string Fix the span for a qualified multiline string like Text.""" I'm a multiline Text value ! """ to extend to the end of the entire string, not just the first line. Closes #27274 - - - - - 5 changed files: - compiler/GHC/Parser/Lexer.x - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprQualifiedStrings.hs - testsuite/tests/printer/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -2274,8 +2274,9 @@ tok_quoted_label span buf len _buf2 = do tok_qstrings :: Action -> Action tok_qstrings lex_str span0 buf0 len0 endBuf0 = do let modName = ModuleName $ lexemeToFastString buf0 modNameLen - (src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 - pure $ L span0 $ ITstring src meta{strMetaQualified = Just modName} s + (span1, src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0 + let span2 = mkPsSpan (psSpanStart span0) (psSpanEnd span1) + pure $ L span2 $ ITstring src meta{strMetaQualified = Just modName} s where -- The buffer/span starting at the string literal (strBuf, strSpanStart) = @@ -2298,7 +2299,7 @@ tok_qstrings lex_str span0 buf0 len0 endBuf0 = do strSpan = mkPsSpan strSpanStart (psSpanEnd span0) unITstring = \case - L _ (ITstring src meta s) -> (src, meta, s) + L span1 (ITstring src meta s) -> (span1, src, meta, s) tok -> panic $ "tok_qstrings got unexpected token: " ++ show tok tok_char :: Action ===================================== testsuite/tests/printer/Makefile ===================================== @@ -922,3 +922,8 @@ TestNamedDefaults: PprModifiers: $(CHECK_PPR) $(LIBDIR) PprModifiers.hs $(CHECK_EXACT) $(LIBDIR) PprModifiers.hs + +.PHONY: PprQualifiedStrings +PprQualifiedStrings: + $(CHECK_PPR) $(LIBDIR) PprQualifiedStrings.hs + $(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs ===================================== testsuite/tests/printer/PprQualifiedStrings.hs ===================================== @@ -0,0 +1,75 @@ +{-# LANGUAGE MultilineStrings #-} +{-# LANGUAGE QualifiedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- These are harvested from ../qualified-strings + +module PprQualifiedStrings where + +import Data.Typeable (Typeable, typeOf) +import qualified Example.ByteStringAscii as Ascii +import qualified Example.ByteStringUtf8 as Utf8 +import qualified Example.Text as Text + +exprs :: IO () +exprs = do + inspect "I'm a String" -- would be an ambiguous type error with OverloadedStrings + inspect Text."I'm a Text" + inspect Ascii."I'm an ASCII bytestring: 語" + inspect Utf8."I'm a UTF8 bytestring: 語" + + inspect """ + I'm a multiline + String value + ! + """ + + inspect Text.""" + I'm a multiline + Text value + ! + """ + + inspect Text . """ + I'm a multiline + Text value + """ + + inspect Text . + """ + I'm a multiline + Text value + """ + +pats :: IO () +pats = do + let text = Text."foo" :: Text + case text of + Text."foo" -> putStrLn "Text.\"foo\" matched" + _ -> putStrLn "Text.\"foo\" did not match" + + let ascii = Ascii."語" :: ByteString + case ascii of + Ascii."語" -> putStrLn "Ascii.\"語\" matched" + _ -> putStrLn "Ascii.\"語\" did not match" + + let utf = Utf8."語" :: ByteString + case utf of + Utf8."語" -> putStrLn "Utf8.\"語\" matched" + _ -> putStrLn "Utf8.\"語\" did not match" + +th :: IO () +th = + $(do + foldr (\stmt acc -> [| $stmt >> $acc |]) [| pure () |] $ + [ [| inspect Text."I'm a Text" |] + , [| inspect Ascii."I'm an ASCII bytestring: 語" |] + , [| inspect Utf8."I'm a Utf8 bytestring: 語" |] + , [| + inspect Text.""" + I'm a multiline + Text string + """ + |] + ] + ) ===================================== testsuite/tests/printer/all.T ===================================== @@ -221,3 +221,4 @@ test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885']) test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports']) test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults']) test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers']) +test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3145,6 +3145,12 @@ instance ExactPrint (HsExpr GhcPs) where body' <- markAnnotated body return (HsQual noExtField ctxt' body') + exact (HsQualLit _ (QualLit _ modu (HsQualString src fs))) = do + modu' <- markAnnotated modu + printStringAdvanceA "." + printSourceTextAA src (show (unpackFS fs)) + return (HsQualLit noExtField (QualLit noExtField modu' (HsQualString src fs))) + exact x = error $ "exact HsExpr for:" ++ showAst x -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/478c632598d4e6609b808eff0589828… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/478c632598d4e6609b808eff0589828… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T23414] Fix test output
by Simon Jakobi (＠sjakobi2) 22 May '26

22 May '26

Simon Jakobi pushed to branch wip/sjakobi/T23414 at Glasgow Haskell Compiler / GHC Commits: 9de8fc38 by Simon Jakobi at 2026-05-22T18:16:55+02:00 Fix test output - - - - - 3 changed files: - testsuite/tests/patsyn/should_fail/T14114.stderr - testsuite/tests/rename/should_fail/rnfail004.stderr - testsuite/tests/typecheck/should_fail/tcfail038.stderr Changes: ===================================== testsuite/tests/patsyn/should_fail/T14114.stderr ===================================== @@ -1,6 +1,5 @@ - T14114.hs:4:20: error: [GHC-10498] - • Conflicting definitions for 'a' + • Conflicting definitions for ‘a’ Bound at: T14114.hs:4:20 T14114.hs:4:22 • In a pattern synonym declaration @@ -12,7 +11,7 @@ T14114.hs:4:20: error: [GHC-10498] | ^ T14114.hs:5:20: error: [GHC-10498] - • Conflicting definitions for 'a' + • Conflicting definitions for ‘a’ Bound at: T14114.hs:5:20 T14114.hs:5:22 • In a pattern synonym declaration @@ -24,7 +23,7 @@ T14114.hs:5:20: error: [GHC-10498] | ^ T14114.hs:6:20: error: [GHC-10498] - • Conflicting definitions for 'a' + • Conflicting definitions for ‘a’ Bound at: T14114.hs:6:20 T14114.hs:6:22 • In a pattern synonym declaration @@ -34,3 +33,4 @@ T14114.hs:6:20: error: [GHC-10498] | 6 | pattern Foo3 a <- (a,a) where | ^ + ===================================== testsuite/tests/rename/should_fail/rnfail004.stderr ===================================== @@ -1,6 +1,5 @@ - rnfail004.hs:6:5: error: [GHC-10498] - Conflicting definitions for 'a' + Conflicting definitions for ‘a’ Bound at: rnfail004.hs:6:5 rnfail004.hs:7:10 | @@ -11,7 +10,7 @@ rnfail004.hs:6:5: error: [GHC-10498] | ^ rnfail004.hs:7:6: error: [GHC-10498] - Conflicting definitions for 'b' + Conflicting definitions for ‘b’ Bound at: rnfail004.hs:7:6 rnfail004.hs:8:8 | @@ -20,3 +19,4 @@ rnfail004.hs:7:6: error: [GHC-10498] | 8 | [d,b,_] = ([],a,[]) | ^ + ===================================== testsuite/tests/typecheck/should_fail/tcfail038.stderr ===================================== @@ -1,6 +1,5 @@ - tcfail038.hs:7:11: error: [GHC-10498] - Conflicting definitions for '==' + Conflicting definitions for ‘==’ Bound at: tcfail038.hs:7:11-12 tcfail038.hs:9:11-12 | @@ -11,7 +10,7 @@ tcfail038.hs:7:11: error: [GHC-10498] | ^^ tcfail038.hs:8:11: error: [GHC-10498] - Conflicting definitions for '/=' + Conflicting definitions for ‘/=’ Bound at: tcfail038.hs:8:11-12 tcfail038.hs:10:11-12 | @@ -20,3 +19,4 @@ tcfail038.hs:8:11: error: [GHC-10498] | 10 | a /= b = True | ^^ + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9de8fc388fdf0ce440f01e7215ddb1c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9de8fc388fdf0ce440f01e7215ddb1c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-reinstallable-base2] 3 commits: Trying to fix horrendous blackhole hang in almost every compiled
by Rodrigo Mesquita (＠alt-romes) 22 May '26

22 May '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 83639740 by Rodrigo Mesquita at 2026-05-21T11:51:57+01:00 Trying to fix horrendous blackhole hang in almost every compiled Required fixing plugins, which were broken too! - - - - - dc475bf4 by Rodrigo Mesquita at 2026-05-22T16:25:41+01:00 fix runtime loop with Simon - - - - - 563805cc by Rodrigo Mesquita at 2026-05-22T16:56:22+01:00 tweaks, finally running the testsuite! - - - - - 6 changed files: - compiler/GHC/Builtin/WiredIn/Types.hs - libraries/ghc-experimental/src/Data/Sum/Experimental.hs - libraries/ghc-experimental/src/Prelude/Experimental.hs - libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs - libraries/template-haskell/Language/Haskell/TH/Lib.hs Changes: ===================================== compiler/GHC/Builtin/WiredIn/Types.hs ===================================== @@ -2898,10 +2898,10 @@ pLUGINS :: Module pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins") pluginTyConName :: Name -pluginTyConName = mkKnownKeyName pluginTyConKey pLUGINS (mkOccName tcName "Plugin") noSrcSpan +pluginTyConName = mkExternalName pluginTyConKey pLUGINS (mkOccName tcName "Plugin") noSrcSpan frontendPluginTyConName :: Name -frontendPluginTyConName = mkKnownKeyName frontendPluginTyConKey pLUGINS (mkOccName tcName "FrontendPlugin") noSrcSpan +frontendPluginTyConName = mkExternalName frontendPluginTyConKey pLUGINS (mkOccName tcName "FrontendPlugin") noSrcSpan {- ************************************************************************ ===================================== libraries/ghc-experimental/src/Data/Sum/Experimental.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedSums, NoListTuplePuns #-} {- ===================================== libraries/ghc-experimental/src/Prelude/Experimental.hs ===================================== @@ -1,4 +1,9 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 1001 +{-# LANGUAGE Safe #-} +#else {-# LANGUAGE Trustworthy #-} +#endif {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK not-home #-} ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs ===================================== @@ -209,7 +209,7 @@ data TypeRep a where -- 'Just and the trKindVars will be [Bool]. , trTyCon :: !TyCon , trKindVars :: [SomeTypeRep] - , trTyConKind :: !(TypeRep k) } -- See Note [Kind caching] + , trTyConKind :: TypeRep k } -- See Note [Kind caching] -> TypeRep (a :: k) -- | Invariant: Saturated arrow types (e.g. things of the form @a -> b@) @@ -318,14 +318,31 @@ There are two things we need to be careful about when caching kinds. Wrinkle 1: -We want to do it eagerly. Suppose we have +The kind cache must be a /lazy/ field because, otherwise, we get a runtime loop: - tf :: TypeRep (f :: j -> k) - ta :: TypeRep (a :: j) + consider: + $tcTYPE = TyCon fp1 fp2 mod "TYPE"# krep01 + krep01 = KindRepFun (KindRepTyConApp $tcRuntimeRep []) KindRepType -Then the cached kind of App tf ta should be eagerly evaluated to k, rather -than being stored as a thunk that will strip the (j ->) off of j -> k if -and when it is forced. + typeRep @TYPE + = mkTrCon $tcTYPE + = TrTyCon { tc, cachedKrep = instantiateKindRep krep01 } + + evaluating instantiateKindRep (KindRepFun ...) eagerly, will require + computing the fingerprint of tyConTYPE: + + tyConTYPE = typeRepTyCon (typeRep @TYPE) + = typeRepTyCon (mkTrCon $tcTYPE []) + + which in turn requires computing (mkTrCon $tcTYPE) again, which requires + computing the kind cache again, which is where we started. If we don't + compute the Kind cache, we can return the $tcTYPE straight away in a TrTyCon. + + Really, if we could say tyConTYPE = $tcTYPE, we would avoid the entire thing. + + This is very delicate, and it is essentially only necessary for TYPE. + Making the kind cache lazy suffices, but the overall design could be + potentially improved to avoid this subtlessness. Wrinkle 2: @@ -338,9 +355,10 @@ But we *do not* want TypeReps to have cyclical structure! Most importantly, a cyclical structure cannot be stored in a compact region. Secondarily, using :force in GHCi on a cyclical structure will lead to non-termination. -To avoid this trouble, we use a separate constructor for TypeRep Type. +To avoid this trouble, we use a separate constructor for TypeRep Type, +namely, TrType. mkTrApp is responsible for recognizing that TYPE is being applied to -'LiftedRep and produce trType; other functions must recognize that TrType +'LiftedRep and produce TrType; other functions must recognize that TrType represents an application. -} ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs ===================================== @@ -47,6 +47,8 @@ import GHC.Internal.Prim ( ) import GHC.Internal.Word import GHC.Internal.Data.Bits +import qualified GHC.Internal.IO.Exception as Rebindable +import qualified GHC.Internal.Stack.Types as Rebindable utf8 :: TextEncoding utf8 = mkUTF8 ErrorOnCodingFailure ===================================== libraries/template-haskell/Language/Haskell/TH/Lib.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} -- | -- Language.Haskell.TH.Lib contains lots of useful helper functions for @@ -180,8 +181,10 @@ import GHC.Boot.TH.Lib hiding , conP +#if __GLASGOW_HASKELL__ < 1001 , Role , InjectivityAnn +#endif ) import qualified GHC.Boot.TH.Lib as Internal import Language.Haskell.TH.Syntax View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee1cc94e5be0570b7bb1310659f8f9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee1cc94e5be0570b7bb1310659f8f9… You're receiving this email because of your account on gitlab.haskell.org.

1 0