- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/spj-reinstallable-base2] 4 commits: Fix handful more tests
by Rodrigo Mesquita (＠alt-romes) 16 Jun '26

16 Jun '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: d90e4e76 by Rodrigo Mesquita at 2026-06-16T12:12:54+01:00 Fix handful more tests - - - - - c05644d8 by Rodrigo Mesquita at 2026-06-16T14:14:52+01:00 break006 new out - - - - - c4a4dfcb by Rodrigo Mesquita at 2026-06-16T15:06:04+01:00 upd callstack00{1,2} out - - - - - 7a4d1cf1 by Rodrigo Mesquita at 2026-06-16T15:09:53+01:00 Rebindable import in windows - - - - - 9 changed files: - libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc - testsuite/tests/backpack/cabal/bkpcabal07/Makefile - testsuite/tests/driver/make-prim/Makefile - testsuite/tests/ghci.debugger/scripts/break006.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/package/all.T - testsuite/tests/profiling/should_run/callstack001.stdout - testsuite/tests/profiling/should_run/callstack002.stderr - testsuite/tests/profiling/should_run/callstack002.stdout Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc ===================================== @@ -21,6 +21,7 @@ module GHC.Internal.Conc.POSIX.Const where import GHC.Internal.Word +import qualified GHC.Internal.Num as Rebindable #include <Rts.h> ===================================== testsuite/tests/backpack/cabal/bkpcabal07/Makefile ===================================== @@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk SETUP='$(PWD)/Setup' -v0 -CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' +CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --ghc-option=-frebindable-known-names --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' # This test checks that instantiating an indefinite package # with a wired in package works. ===================================== testsuite/tests/driver/make-prim/Makefile ===================================== @@ -5,7 +5,7 @@ include $(TOP)/mk/test.mk make-prim: # build once to test the substitution of the virtual interface in --make # mode with codegen - "$(TEST_HC)" $(TEST_HC_OPTS) --make Test.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) --make Test.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 -frebindable-known-names # build a different module (Test2) in --make mode to test the reloading # of the GHC.Internal.Prim interface - "$(TEST_HC)" $(TEST_HC_OPTS) --make Test2.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) --make Test2.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 -frebindable-known-names ===================================== testsuite/tests/ghci.debugger/scripts/break006.stderr ===================================== @@ -4,8 +4,8 @@ Use :print or :force to determine these types Relevant bindings include it :: a (bound at <interactive>:4:1) Potentially matching instances: - instance Show Ordering -- Defined in ‘GHC.Internal.Show’ instance Show Integer -- Defined in ‘GHC.Internal.Show’ + instance Show a => Show (Maybe a) -- Defined in ‘GHC.Internal.Show’ ...plus 25 others ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) @@ -17,8 +17,8 @@ Use :print or :force to determine these types Relevant bindings include it :: a (bound at <interactive>:6:1) Potentially matching instances: - instance Show Ordering -- Defined in ‘GHC.Internal.Show’ instance Show Integer -- Defined in ‘GHC.Internal.Show’ + instance Show a => Show (Maybe a) -- Defined in ‘GHC.Internal.Show’ ...plus 25 others ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -5638,6 +5638,8 @@ module GHC.Essentials where data RuleMatch = ConLike | FunLike type S1 :: forall {k}. Meta -> (k -> *) -> k -> * type S1 = M1 GHC.Internal.Generics.S + type SPEC :: * + data SPEC = SPEC | SPEC2 type Selector :: forall {k}. k -> Constraint class Selector s where selName :: forall k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). t s f a -> [GHC.Internal.Types.Char] @@ -6040,6 +6042,7 @@ module GHC.Essentials where roleAnnotD :: forall (m :: * -> *). Quote m => Name -> [Role] -> m Dec ruleVar :: forall (m :: * -> *). Quote m => Name -> m RuleBndr runMainIO :: forall a. IO a -> IO a + runRW# :: forall (r :: GHC.Internal.Types.RuntimeRep) (o :: TYPE r). (GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> o) -> o safe :: GHC.Internal.TH.Syntax.Safety sectionL :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp sectionR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp ===================================== testsuite/tests/package/all.T ===================================== @@ -5,10 +5,10 @@ incr_ghc = '-package "ghc (GHC.Hs.Type as GHC.Hs.MyTypes, GHC.Hs.Utils)" ' inc_ghc = '-package ghc ' hide_ghc = '-hide-package ghc ' -test('package01', normal, compile, [hide_all + incr_containers]) +test('package01', normal, compile, [hide_all + incr_containers + '-frebindable-known-names']) test('package01e', normalise_version('containers'), compile_fail, [hide_all + incr_containers]) -test('package02', normal, compile, [hide_all + inc_containers + incr_containers]) -test('package03', normal, compile, [hide_all + incr_containers + inc_containers]) +test('package02', normal, compile, [hide_all + inc_containers + incr_containers + '-frebindable-known-names']) +test('package03', normal, compile, [hide_all + incr_containers + inc_containers + '-frebindable-known-names']) test('package04', normal, compile, [incr_containers]) test('package05', normal, compile, [incr_ghc + inc_ghc]) test('package06', normal, compile, [incr_ghc]) @@ -16,7 +16,7 @@ test('package06e', normalise_version('ghc'), compile_fail, [incr_ghc]) test('package07e', normalise_version('ghc'), compile_fail, [incr_ghc + inc_ghc + hide_ghc]) test('package08e', normalise_version('ghc'), compile_fail, [incr_ghc + hide_ghc]) test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"']) -test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC.Types.Unique.FM as Prelude)" ']) +test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC.Types.Unique.FM as Prelude)" -frebindable-known-names']) test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) ===================================== testsuite/tests/profiling/should_run/callstack001.stdout ===================================== @@ -1,2 +1,2 @@ -["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1347:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:129:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] -["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1347:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:129:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] \ No newline at end of file +["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1368:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:128:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] +["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1368:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:128:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] ===================================== testsuite/tests/profiling/should_run/callstack002.stderr ===================================== @@ -1,6 +1,6 @@ f: 42 CallStack (from -prof): - GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:243:1-10) + GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:241:1-10) Main.f (callstack002.hs:10:7-43) Main.map.go (callstack002.hs:15:21-23) Main.map.go (callstack002.hs:15:21-34) @@ -9,7 +9,7 @@ CallStack (from -prof): Main.CAF (<entire-module>) f: 43 CallStack (from -prof): - GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:243:1-10) + GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:241:1-10) Main.f (callstack002.hs:10:7-43) Main.map.go (callstack002.hs:15:21-23) Main.map.go (callstack002.hs:15:21-34) ===================================== testsuite/tests/profiling/should_run/callstack002.stdout ===================================== @@ -1,7 +1,7 @@ [84,86] CallStack (from -prof): - GHC.Internal.Num.$fNumInt_$c* (libraries/ghc-internal/src/GHC/Internal/Num.hs:114:10) - GHC.Internal.Num.* (libraries/ghc-internal/src/GHC/Internal/Num.hs:76:5-38) + GHC.Internal.Num.$fNumInt_$c* (libraries/ghc-internal/src/GHC/Internal/Num.hs:116:10) + GHC.Internal.Num.* (libraries/ghc-internal/src/GHC/Internal/Num.hs:78:5-38) Main.f (callstack002.hs:10:38-42) Main.f (callstack002.hs:10:7-43) Main.map.go (callstack002.hs:15:21-23) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a715d7d3ce7b591b9be53e5ddf3bf1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a715d7d3ce7b591b9be53e5ddf3bf1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/T27374-repro
by Simon Jakobi (＠sjakobi2) 16 Jun '26

16 Jun '26

Simon Jakobi pushed new branch wip/sjakobi/T27374-repro at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/T27374-repro You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 3 commits: WIP: introduce external unit database cache
by Hannes Siebenhandl (＠fendor) 16 Jun '26

16 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: e5ff4198 by fendor at 2026-06-16T15:01:30+02:00 WIP: introduce external unit database cache - - - - - 78f7f4a4 by fendor at 2026-06-16T15:02:50+02:00 Never modify UnitInfo for better sharing - - - - - fd08e959 by fendor at 2026-06-16T15:03:08+02:00 WIP: Introduce UnitIndex for global data - - - - - 15 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - libraries/ghc-boot/GHC/Unit/Database.hs - utils/haddock/haddock-api/src/Haddock.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -671,15 +671,12 @@ setUnitDynFlagsNoCheck uid dflags1 = do logger <- getLogger hsc_env <- getSession - let old_hue = ue_findHomeUnitEnv uid (hsc_unit_env hsc_env) - let cached_unit_dbs = homeUnitEnv_unit_dbs old_hue - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 cached_unit_dbs (hsc_all_home_unit_ids hsc_env) + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (hsc_unit_index hsc_env) (hscEUDC hsc_env) (hsc_all_home_unit_ids hsc_env) updated_dflags <- liftIO $ updatePlatformConstants dflags1 mconstants let upd hue = hue { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_home_unit = Just home_unit } @@ -759,17 +756,15 @@ setProgramDynFlags_ invalidate_needed dflags = do old_unit_env <- ue_setFlags dflags0 . hsc_unit_env <$> getSession home_unit_graph <- forM (ue_home_unit_graph old_unit_env) $ \homeUnitEnv -> do - let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv - dflags = homeUnitEnv_dflags homeUnitEnv + let dflags = homeUnitEnv_dflags homeUnitEnv old_hpt = homeUnitEnv_hpt homeUnitEnv home_units = HUG.allUnits (ue_home_unit_graph old_unit_env) - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_unit_index old_unit_env) (ue_eud old_unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags0 mconstants pure HomeUnitEnv { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_hpt = old_hpt , homeUnitEnv_home_unit = Just home_unit @@ -783,6 +778,8 @@ setProgramDynFlags_ invalidate_needed dflags = do , ue_current_unit = ue_currentUnit old_unit_env , ue_module_graph = ue_module_graph old_unit_env , ue_eps = ue_eps old_unit_env + , ue_eud = ue_eud old_unit_env + , ue_unit_index = ue_unit_index old_unit_env } modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env } else modifySession (hscSetFlags dflags0) @@ -840,6 +837,8 @@ setProgramHUG_ invalidate_needed new_hug0 = do , ue_current_unit = ue_currentUnit unit_env0 , ue_eps = ue_eps unit_env0 , ue_module_graph = ue_module_graph unit_env0 + , ue_eud = ue_eud unit_env0 + , ue_unit_index = ue_unit_index unit_env0 } modifySession $ \h -> -- hscSetFlags takes care of updating the logger as well. @@ -881,19 +880,17 @@ setProgramHUG_ invalidate_needed new_hug0 = do updateHomeUnit :: GhcMonad m => Logger -> UnitEnv -> HomeUnitGraph -> (UnitId -> HomeUnitEnv -> m HomeUnitEnv) updateHomeUnit logger unit_env updates = \uid homeUnitEnv -> do - let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv - dflags = case HUG.unitEnv_lookup_maybe uid updates of + let dflags = case HUG.unitEnv_lookup_maybe uid updates of Nothing -> homeUnitEnv_dflags homeUnitEnv Just env -> homeUnitEnv_dflags env old_hpt = homeUnitEnv_hpt homeUnitEnv home_units = HUG.allUnits (ue_home_unit_graph unit_env) - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_unit_index unit_env) (ue_eud unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants pure HomeUnitEnv { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_hpt = old_hpt , homeUnitEnv_home_unit = Just home_unit ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -92,6 +92,7 @@ import GHC.Types.Error (mkUnknownDiagnostic) import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.Home.ModInfo import GHC.Unit.Home.PackageTable +import GHC.Unit.External.Database (cacheExternalUnitDatabase) -- | Entry point to compile a Backpack file. doBackpack :: [FilePath] -> Ghc () @@ -174,6 +175,8 @@ withBkpSession :: UnitId -> BkpM a withBkpSession cid insts deps session_type do_this = do dflags <- getDynFlags + env <- getSession + unitIndex <- liftIO $ hscUnitIndex env let cid_fs = unitFS cid is_primary = False uid_str = unpackFS (mkInstantiatedUnitHash cid insts) @@ -193,8 +196,8 @@ withBkpSession cid insts deps session_type do_this = do | otherwise = sub_comp (key_base p) mk_temp_env hsc_env = - hscUpdateFlags (\dflags -> mk_temp_dflags (hsc_units hsc_env) dflags) hsc_env - mk_temp_dflags unit_state dflags = dflags + hscUpdateFlags (\dflags -> mk_temp_dflags unitIndex (hsc_units hsc_env) dflags) hsc_env + mk_temp_dflags unit_index unit_state dflags = dflags { backend = case session_type of TcSession -> noBackend _ -> backend dflags @@ -241,7 +244,7 @@ withBkpSession cid insts deps session_type do_this = do , importPaths = [] -- Synthesize the flags , packageFlags = packageFlags dflags ++ map (\(uid0, rn) -> - let uid = unwireUnit unit_state + let uid = unwireUnit unit_index $ renameHoleUnit unit_state (listToUFM insts) uid0 in ExposePackage (showSDoc dflags @@ -348,9 +351,9 @@ buildUnit session cid insts lunit = do | otherwise = [Nothing] linkables <- liftIO $ catMaybes <$> concatHpt takeLinkables (hsc_HPT hsc_env) + unit_index <- liftIO $ hscUnitIndex hsc_env let obj_files = concatMap linkableFiles linkables - state = hsc_units hsc_env compat_fs = unitIdFS cid compat_pn = PackageName compat_fs @@ -376,7 +379,7 @@ buildUnit session cid insts lunit = do -- really used for anything, so we leave it -- blank for now. TcSession -> [] - _ -> map (toUnitId . unwireUnit state) + _ -> map (toUnitId . unwireUnit unit_index) $ deps ++ [ moduleUnit mod | (_, mod) <- insts , not (isHoleModule mod) ], @@ -435,18 +438,24 @@ addUnit u = do logger <- getLogger let dflags0 = hsc_dflags hsc_env let old_unit_env = hsc_unit_env hsc_env - newdbs <- case ue_unit_dbs old_unit_env of - Nothing -> panic "addUnit: called too early" - Just dbs -> - let newdb = UnitDatabase - { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" - , unitDatabaseUnits = [u] - } - in return (dbs ++ [newdb]) -- added at the end because ordering matters - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags0 (Just newdbs) (hsc_all_home_unit_ids hsc_env) + + -- TODO @fendor: provide an API to programmatically add an in-memory DB + let newdb = UnitDatabase + { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" + , unitDatabaseUnits = [u] + } + let eud = hscEUDC hsc_env + liftIO $ cacheExternalUnitDatabase eud newdb + -- added at the end because ordering matters + let dflags1 = dflags0 + { packageDBFlags = packageDBFlags dflags0 ++ [PackageDB (PkgDbPath (unitDatabasePath newdb))] + } + + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (ue_unit_index old_unit_env) eud (hsc_all_home_unit_ids hsc_env) + -- update platform constants - dflags <- liftIO $ updatePlatformConstants dflags0 mconstants + dflags <- liftIO $ updatePlatformConstants dflags1 mconstants let unit_env = UnitEnv { ue_platform = targetPlatform dflags @@ -456,9 +465,11 @@ addUnit u = do , ue_home_unit_graph = HUG.unitEnv_singleton (homeUnitId home_unit) - (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags (ue_hpt old_unit_env) (Just home_unit)) + (HUG.mkHomeUnitEnv unit_state dflags (ue_hpt old_unit_env) (Just home_unit)) , ue_eps = ue_eps old_unit_env , ue_module_graph = ue_module_graph old_unit_env + , ue_eud = ue_eud old_unit_env + , ue_unit_index = ue_unit_index old_unit_env } setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -13,6 +13,8 @@ module GHC.Driver.Env , hsc_HUE , hsc_HUG , hsc_all_home_unit_ids + , hscUnitIndex + , hsc_unit_index , hscUpdateLoggerFlags , hscUpdateHUG , hscInsertHPT @@ -24,6 +26,8 @@ module GHC.Driver.Env , mkInteractiveHscEnv , runInteractiveHsc , hscEPS + , hscEUD + , hscEUDC , hscInterp , prepareAnnotations , discardIC @@ -89,6 +93,7 @@ import GHC.Builtin.Names import Data.IORef import qualified Data.Set as Set +import GHC.Unit.External.Database (ExternalUnitDatabaseCache, readExternalUnitDatabases, ExternalUnitDatabases) runHsc :: HscEnv -> Hsc a -> IO a runHsc hsc_env hsc = do @@ -221,6 +226,18 @@ configured via command-line flags (in `GHC.setTopSessionDynFlags`). hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env))) +hscEUD :: HscEnv -> IO (ExternalUnitDatabases UnitId) +hscEUD = readExternalUnitDatabases . hscEUDC + +hscEUDC :: HscEnv -> ExternalUnitDatabaseCache UnitId +hscEUDC hsc_env = ue_eud (hsc_unit_env hsc_env) + +hscUnitIndex :: HscEnv -> IO UnitIndex +hscUnitIndex hsc_env = readIORef $ ue_unit_index (hsc_unit_env hsc_env) + +hsc_unit_index :: HscEnv -> IORef UnitIndex +hsc_unit_index hsc_env = ue_unit_index (hsc_unit_env hsc_env) + -------------------------------------------------------------------------------- -- * Queries on Transitive Closure -------------------------------------------------------------------------------- ===================================== compiler/GHC/Driver/Main/Hsc.hs ===================================== @@ -110,7 +110,7 @@ newHscEnv top_dir dflags = do where home_unit_graph hpt = HUG.unitEnv_singleton (homeUnitId_ dflags) - (HUG.mkHomeUnitEnv emptyUnitState Nothing dflags hpt Nothing) + (HUG.mkHomeUnitEnv emptyUnitState dflags hpt Nothing) newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do ===================================== compiler/GHC/Driver/Main/Interactive.hs ===================================== @@ -275,7 +275,7 @@ hscCheckSafe' m l = do Sf_Safe | not trust_own_pkg -> True Sf_SafeInferred | not trust_own_pkg -> True _ | isHomeModule home_unit mod -> True - _ -> unitIsTrusted $ unsafeLookupUnit unit_state (moduleUnit m) + _ -> isUnitTrusted unit_state (moduleUnit m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -297,7 +297,7 @@ checkPkgTrust pkgs = do errors = S.foldr go emptyBag pkgs state = hsc_units hsc_env go pkg acc - | unitIsTrusted $ unsafeLookupUnitId state pkg + | isUnitIdTrusted state pkg = acc | otherwise = (`consBag` acc) ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -1328,7 +1328,7 @@ hscCheckSafe' m l = do Sf_Safe | not trust_own_pkg -> True Sf_SafeInferred | not trust_own_pkg -> True _ | isHomeModule home_unit mod -> True - _ -> unitIsTrusted $ unsafeLookupUnit unit_state (moduleUnit m) + _ -> isUnitTrusted unit_state (moduleUnit m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -1350,7 +1350,7 @@ checkPkgTrust pkgs = do errors = S.foldr go emptyBag pkgs state = hsc_units hsc_env go pkg acc - | unitIsTrusted $ unsafeLookupUnitId state pkg + | isUnitIdTrusted state pkg = acc | otherwise = (`consBag` acc) ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -129,16 +129,14 @@ initMulti unitArgsFiles lintDynFlagsAndSrcs = do let home_units = HUG.allUnits initial_home_graph home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do - let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv - hue_flags = homeUnitEnv_dflags homeUnitEnv + let hue_flags = homeUnitEnv_dflags homeUnitEnv dflags = homeUnitEnv_dflags homeUnitEnv - (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units + (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags (hsc_unit_index hsc_env) (hscEUDC hsc_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants emptyHpt <- liftIO $ emptyHomePackageTable pure $ HomeUnitEnv { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_hpt = emptyHpt , homeUnitEnv_home_unit = Just home_unit @@ -239,7 +237,7 @@ createUnitEnvFromFlags unitDflags = do unitEnvList <- forM unitDflags $ \dflags -> do emptyHpt <- emptyHomePackageTable let newInternalUnitEnv = - HUG.mkHomeUnitEnv emptyUnitState Nothing dflags emptyHpt Nothing + HUG.mkHomeUnitEnv emptyUnitState dflags emptyHpt Nothing return (homeUnitId_ dflags, newInternalUnitEnv) let activeUnit = fst $ NE.head unitEnvList return (HUG.hugFromList (NE.toList unitEnvList), activeUnit) ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -80,7 +80,6 @@ module GHC.Unit.Env -- ** Queries on the current active home unit , ue_homeUnitState - , ue_unit_dbs , ue_homeUnit , ue_unitFlags @@ -110,6 +109,7 @@ import GHC.Prelude import qualified Data.Set as Set import GHC.Unit.External +import GHC.Unit.External.Database import GHC.Unit.State import GHC.Unit.Home import GHC.Unit.Types @@ -131,6 +131,7 @@ import GHC.Types.Annotations import GHC.Types.CompleteMatch import GHC.Core.InstEnv import GHC.Core.FamInstEnv +import Data.IORef -------------------------------------------------------------------------------- -- The hard queries @@ -174,6 +175,11 @@ data UnitEnv = UnitEnv , ue_namever :: !GhcNameVersion -- ^ GHC name/version (used for dynamic library suffix) + + , ue_eud :: {-# UNPACK #-} !(ExternalUnitDatabaseCache UnitId) + -- TODO: @fendor Docs + , ue_unit_index :: {-# UNPACK #-} !(IORef UnitIndex) + -- TODO: @fendor Docs } ueEPS :: UnitEnv -> IO ExternalPackageState @@ -182,6 +188,8 @@ ueEPS = eucEPS . ue_eps initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv initUnitEnv cur_unit hug namever platform = do eps <- initExternalUnitCache + eud <- initExternalUnitDatabaseCache + unit_index <- newIORef (initUnitIndex) return $ UnitEnv { ue_eps = eps , ue_home_unit_graph = hug @@ -189,6 +197,8 @@ initUnitEnv cur_unit hug namever platform = do , ue_current_unit = cur_unit , ue_platform = platform , ue_namever = namever + , ue_eud = eud + , ue_unit_index = unit_index } updateHug :: (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv @@ -258,9 +268,6 @@ ue_findHomeUnitEnv uid e = case HUG.lookupHugUnitId uid (ue_home_unit_graph e) o ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState ue_homeUnitState = HUG.homeUnitEnv_units . ue_currentHomeUnitEnv -ue_unit_dbs :: UnitEnv -> Maybe [UnitDatabase UnitId] -ue_unit_dbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv - -- ------------------------------------------------------- -- Query and modify Home Package Table in HomeUnitEnv -- ------------------------------------------------------- ===================================== compiler/GHC/Unit/External/Database.hs ===================================== @@ -0,0 +1,104 @@ +module GHC.Unit.External.Database ( + -- * + ExternalUnitDatabaseCache (..), + initExternalUnitDatabaseCache, + readExternalUnitDatabases, + readExternalUnitDatabase, + cacheExternalUnitDatabase, + clearExternalUnitDatabaseCache, + -- * + ExternalUnitDatabases, + emptyExternalUnitDatabases, + insertExternalUnitDatabases, + deleteExternalUnitDatabases, + lookupExternalUnitDatabases, + -- * + UnitDatabase (..), +) where + +import GHC.Prelude + +import GHC.Data.OsPath +import GHC.Unit.Info +import GHC.Utils.Outputable + +import Data.IORef (IORef) +import Data.IORef qualified as IORef +import Data.Map.Strict +import Data.Map.Strict qualified as Map + +-- ---------------------------------------------------------------------------- +-- ExternalUnitDatabaseCache +-- ---------------------------------------------------------------------------- + +newtype ExternalUnitDatabaseCache unit = ExternalUnitDatabaseCache + { eudc_databases :: IORef (ExternalUnitDatabases unit) + } + +initExternalUnitDatabaseCache :: IO (ExternalUnitDatabaseCache unit) +initExternalUnitDatabaseCache = + ExternalUnitDatabaseCache <$> IORef.newIORef emptyExternalUnitDatabases + +readExternalUnitDatabases :: ExternalUnitDatabaseCache unit -> IO (ExternalUnitDatabases unit) +readExternalUnitDatabases eudc = + IORef.readIORef (eudc_databases eudc) + +modifyExternalUnitDatabaseCache :: ExternalUnitDatabaseCache unit -> (ExternalUnitDatabases unit -> ExternalUnitDatabases unit) -> IO () +modifyExternalUnitDatabaseCache eudc f = + IORef.modifyIORef' (eudc_databases eudc) f + +readExternalUnitDatabase :: ExternalUnitDatabaseCache unit -> OsPath -> IO (Maybe (UnitDatabase unit)) +readExternalUnitDatabase eudc path = do + dbs <- readExternalUnitDatabases eudc + pure $ lookupExternalUnitDatabases path dbs + +cacheExternalUnitDatabase :: ExternalUnitDatabaseCache unit -> UnitDatabase unit -> IO () +cacheExternalUnitDatabase eudc db = + modifyExternalUnitDatabaseCache eudc (insertExternalUnitDatabases db) + +clearExternalUnitDatabaseCache :: ExternalUnitDatabaseCache unit -> IO () +clearExternalUnitDatabaseCache eudc = + modifyExternalUnitDatabaseCache eudc (const emptyExternalUnitDatabases) + +-- ---------------------------------------------------------------------------- +-- ExternalUnitDatabases +-- ---------------------------------------------------------------------------- + +data ExternalUnitDatabases unit = ExternalUnitDatabases + { eud_cachedDatabases :: !(Map OsPath (UnitDatabase unit)) + } + +emptyExternalUnitDatabases :: ExternalUnitDatabases unit +emptyExternalUnitDatabases = + ExternalUnitDatabases + { eud_cachedDatabases = Map.empty + } + +insertExternalUnitDatabases :: UnitDatabase unit -> ExternalUnitDatabases unit -> ExternalUnitDatabases unit +insertExternalUnitDatabases unit_db eud = + ExternalUnitDatabases + { eud_cachedDatabases = Map.insert (unitDatabasePath unit_db) unit_db (eud_cachedDatabases eud) + } + +deleteExternalUnitDatabases :: OsPath -> ExternalUnitDatabases unit -> ExternalUnitDatabases unit +deleteExternalUnitDatabases unit_db_path eud = + ExternalUnitDatabases + { eud_cachedDatabases = Map.delete unit_db_path (eud_cachedDatabases eud) + } + +lookupExternalUnitDatabases :: OsPath -> ExternalUnitDatabases unit -> Maybe (UnitDatabase unit) +lookupExternalUnitDatabases key eud = + Map.lookup key (eud_cachedDatabases eud) + +-- ---------------------------------------------------------------------------- +-- UnitDatabase +-- ---------------------------------------------------------------------------- + +-- | Unit database +data UnitDatabase unit = UnitDatabase + { unitDatabasePath :: OsPath + , unitDatabaseUnits :: [GenUnitInfo unit] + } + +instance (Outputable u) => Outputable (UnitDatabase u) where + ppr (UnitDatabase fp _u) = text "DB:" <+> ppr fp ===================================== compiler/GHC/Unit/Home/Graph.hs ===================================== @@ -128,16 +128,6 @@ data HomeUnitEnv = HomeUnitEnv { homeUnitEnv_units :: !UnitState -- ^ External units - , homeUnitEnv_unit_dbs :: !(Maybe [UnitDatabase UnitId]) - -- ^ Stack of unit databases for the target platform. - -- - -- This field is populated with the result of `initUnits`. - -- - -- 'Nothing' means the databases have never been read from disk. - -- - -- Usually we don't reload the databases from disk if they are - -- cached, even if the database flags changed! - , homeUnitEnv_dflags :: DynFlags -- ^ The dynamic flag settings , homeUnitEnv_hpt :: HomePackageTable @@ -164,10 +154,9 @@ data HomeUnitEnv = HomeUnitEnv -- ^ Home-unit } -mkHomeUnitEnv :: UnitState -> Maybe [UnitDatabase UnitId] -> DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv -mkHomeUnitEnv us dbs dflags hpt home_unit = HomeUnitEnv +mkHomeUnitEnv :: UnitState -> DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv +mkHomeUnitEnv us dflags hpt home_unit = HomeUnitEnv { homeUnitEnv_units = us - , homeUnitEnv_unit_dbs = dbs , homeUnitEnv_dflags = dflags , homeUnitEnv_hpt = hpt , homeUnitEnv_home_unit = home_unit ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -5,12 +5,20 @@ module GHC.Unit.State ( module GHC.Unit.Info, + UnitIndex(..), + initUnitIndex, + setWireMap, + isWireMapEmpty, + addUnitInfoMap, + -- lookupUnitInfoMap, + -- * Reading the package config, and processing cmdline args UnitState(..), UnitDatabase (..), UnitErr (..), emptyUnitState, initUnits, + readOrGetUnitDatabase, readUnitDatabases, readUnitDatabase, getUnitDbRefs, @@ -25,6 +33,9 @@ module GHC.Unit.State ( lookupUnitId, lookupUnitId', unsafeLookupUnitId, + isUnitTrusted, + isUnitIdTrusted, + isUnitInfoTrusted, lookupPackageName, resolvePackageImport, @@ -118,6 +129,9 @@ import Data.Monoid (First(..)) import qualified Data.Semigroup as Semigroup import qualified Data.Set as Set import Control.Applicative +import GHC.Unit.External.Database +import Data.IORef +import Data.Either (partitionEithers) -- --------------------------------------------------------------------------- -- The Unit state @@ -342,7 +356,7 @@ data UnitConfig = UnitConfig , unitConfigHideAll :: !Bool -- ^ Hide all units by default , unitConfigHideAllPlugins :: !Bool -- ^ Hide all plugins units by default - , unitConfigDBCache :: Maybe [UnitDatabase UnitId] + , unitConfigDBCache :: !(ExternalUnitDatabaseCache UnitId) -- ^ Cache of databases to use, in the order they were specified on the -- command line (later databases shadow earlier ones). -- If Nothing, databases will be found using `unitConfigFlagsDB`. @@ -356,7 +370,7 @@ data UnitConfig = UnitConfig , unitConfigHomeUnits :: Set.Set UnitId } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> ExternalUnitDatabaseCache UnitId -> Set.Set UnitId -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -419,25 +433,73 @@ initUnitConfig dflags cached_dbs home_units = type ModuleNameProvidersMap = UniqMap ModuleName (UniqMap Module ModuleOrigin) +data GlobalUnitKey = + GlobalUnitKey + UnitId -- ^ Unit Id of the 'UnitInfo' + ST.ShortText + +data UnitIndex = UnitIndex + { ui_wireMap :: WiringMap + -- ^ TODO @fendor: document global property + , ui_unwireMap :: UnwiringMap + -- ^ TODO @fendor: document global property + , ui_unitInfoMap :: UnitInfoMap + -- ^ TODO @fendor: This needs to be Map (UnitId, AbiHash) UnitInfo for absolut correctness + } + +initUnitIndex :: UnitIndex +initUnitIndex = UnitIndex + { ui_wireMap = emptyUniqMap + , ui_unwireMap = emptyUniqMap + , ui_unitInfoMap = emptyUniqMap + } + +setWireMap :: WiringMap -> UnitIndex -> UnitIndex +setWireMap wired_map unit_index = + unit_index + { ui_wireMap = wired_map + , ui_unwireMap = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ] + } + +isWireMapEmpty :: UnitIndex -> Bool +isWireMapEmpty unit_index = + isNullUniqMap (ui_wireMap unit_index) + +addUnitInfoMap :: UnitInfoMap -> UnitIndex -> UnitIndex +addUnitInfoMap unit_info_map unit_index = + unit_index + { ui_unitInfoMap = unit_info_map `plusUniqMap` ui_unitInfoMap unit_index + } + +-- lookupUnitInfoMap :: UnitIndex -> UnitId -> Maybe UnitInfo +-- lookupUnitInfoMap unit_index unit_id = +-- lookupUniqMap (ui_unitInfoMap unit_index) unit_id + data UnitState = UnitState { -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted -- so that only valid units are here. 'UnitInfo' reflects -- what was stored *on disk*, except for the 'trusted' flag, which -- is adjusted at runtime. (In particular, some units in this map -- may have the 'exposed' flag be 'False'.) + -- + -- TODO @fendor: All values are shared with 'UnitIndex.ui_unitInfoMap'. unitInfoMap :: UnitInfoMap, + -- | Local overlay for the unit info so that sharing is more accurate + trustedUnits :: Set.Set UnitId, -- TODO @fendor: UniqSet + distrustedUnits :: Set.Set UnitId, -- TODO @fendor: UniqSet + -- | A mapping of 'PackageName' to 'UnitId'. If several units have the same -- package name (e.g. different instantiations), then we return one of them... -- This is used when users refer to packages in Backpack includes. -- And also to resolve package qualifiers with the PackageImports extension. packageNameMap :: UniqFM PackageName UnitId, - -- | A mapping from database unit keys to wired in unit ids. - wireMap :: UniqMap UnitId UnitId, + -- -- | A mapping from database unit keys to wired in unit ids. + -- wireMap :: WiringMap, - -- | A mapping from wired in unit ids to unit keys from the database. - unwireMap :: UniqMap UnitId UnitId, + -- -- | A mapping from wired in unit ids to unit keys from the database. + -- unwireMap :: UnwiringMap, -- | The units we're going to link in eagerly. This list -- should be in reverse dependency order; that is, a unit @@ -479,9 +541,11 @@ data UnitState = UnitState { emptyUnitState :: UnitState emptyUnitState = UnitState { unitInfoMap = emptyUniqMap, + trustedUnits = Set.empty, + distrustedUnits = Set.empty, packageNameMap = emptyUFM, - wireMap = emptyUniqMap, - unwireMap = emptyUniqMap, + -- wireMap = emptyUniqMap, + -- unwireMap = emptyUniqMap, preloadUnits = [], explicitUnits = [], homeUnitDepends = Set.empty, @@ -491,15 +555,6 @@ emptyUnitState = UnitState { allowVirtualUnits = False } --- | Unit database -data UnitDatabase unit = UnitDatabase - { unitDatabasePath :: OsPath - , unitDatabaseUnits :: [GenUnitInfo unit] - } - -instance Outputable u => Outputable (UnitDatabase u) where - ppr (UnitDatabase fp _u) = text "DB:" <+> ppr fp - type UnitInfoMap = UniqMap UnitId UnitInfo -- | Find the unit we know about with the given unit, if any @@ -618,6 +673,21 @@ mkUnitInfoMap infos = foldl' add emptyUniqMap infos listUnitInfo :: UnitState -> [UnitInfo] listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) +isUnitTrusted :: HasDebugCallStack => UnitState -> Unit -> Bool +isUnitTrusted ue u = + Set.member (toUnitId u) (trustedUnits ue) && (Set.notMember (toUnitId u) (distrustedUnits ue)) + || unitIsTrusted (unsafeLookupUnit ue u) + +isUnitIdTrusted :: HasDebugCallStack => UnitState -> UnitId -> Bool +isUnitIdTrusted ue u = + Set.member u (trustedUnits ue) && (Set.notMember u (distrustedUnits ue)) + || unitIsTrusted (unsafeLookupUnitId ue u) + +isUnitInfoTrusted :: HasDebugCallStack => UnitState -> UnitInfo -> Bool +isUnitInfoTrusted ue unit_info = + Set.member (unitId unit_info) (trustedUnits ue) && (Set.notMember (unitId unit_info) (distrustedUnits ue)) + || unitIsTrusted unit_info + -- ---------------------------------------------------------------------------- -- Loading the unit db files and building up the unit state @@ -628,20 +698,22 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) -initUnits logger dflags cached_dbs home_units = do +initUnits :: Logger -> DynFlags -> IORef UnitIndex -> ExternalUnitDatabaseCache UnitId -> Set.Set UnitId -> IO (UnitState, HomeUnit, Maybe PlatformConstants) +initUnits logger dflags unit_index cached_dbs home_units = do - let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () + let forceUnitInfoMap state = unitInfoMap state `seq` () - (unit_state,dbs) <- withTiming logger (text "initializing unit database") + unit_state <- withTiming logger (text "initializing unit database") forceUnitInfoMap - $ mkUnitState logger (initUnitConfig dflags cached_dbs home_units) + $ mkUnitState logger unit_index (initUnitConfig dflags cached_dbs home_units) putDumpFileMaybe logger Opt_D_dump_mod_map "Module Map" FormatText (updSDocContext (\ctx -> ctx {sdocLineLength = 200}) $ pprModuleMap (moduleNameProvidersMap unit_state)) - let home_unit = mkHomeUnit unit_state + wireMap <- ui_wireMap <$> readIORef unit_index + + let home_unit = mkHomeUnit wireMap (homeUnitId_ dflags) (homeUnitInstanceOf_ dflags) (homeUnitInstantiations_ dflags) @@ -663,19 +735,18 @@ initUnits logger dflags cached_dbs home_units = do Nothing -> return Nothing Just info -> lookupPlatformConstants (fmap ST.unpack (unitIncludeDirs info)) - return (dbs,unit_state,home_unit,mconstants) + return (unit_state,home_unit,mconstants) mkHomeUnit - :: UnitState + :: WiringMap -> UnitId -- ^ Home unit id -> Maybe UnitId -- ^ Home unit instance of -> [(ModuleName, Module)] -- ^ Home unit instantiations -> HomeUnit -mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations_ = +mkHomeUnit wmap hu_id hu_instanceof hu_instantiations_ = let -- Some wired units can be used to instantiate the home unit. We need to -- replace their unit keys with their wired unit ids. - wmap = wireMap unit_state hu_instantiations = map (fmap (upd_wired_in_mod wmap)) hu_instantiations_ in case (hu_instanceof, hu_instantiations) of (Nothing,[]) -> DefiniteHomeUnit hu_id Nothing @@ -700,7 +771,7 @@ readUnitDatabases :: Logger -> UnitConfig -> IO [UnitDatabase UnitId] readUnitDatabases logger cfg = do conf_refs <- getUnitDbRefs cfg confs <- liftM catMaybes $ mapM (resolveUnitDatabase cfg) conf_refs - mapM (readUnitDatabase logger cfg) confs + mapM (readOrGetUnitDatabase logger cfg) confs getUnitDbRefs :: UnitConfig -> IO [PkgDbRef] @@ -752,6 +823,18 @@ resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do if exist then return (OsPath.unsafeEncodeUtf pkgconf) else mzero resolveUnitDatabase _ (PkgDbPath name) = return $ Just name +-- | Get the cached 'UnitDatabase' or read the 'UnitDatabase' at the given location. +readOrGetUnitDatabase :: Logger -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) +readOrGetUnitDatabase logger cfg conf_file = + readExternalUnitDatabase (unitConfigDBCache cfg) conf_file >>= \ case + Nothing -> do + new_db <- readUnitDatabase logger cfg conf_file + cacheExternalUnitDatabase (unitConfigDBCache cfg) new_db + pure new_db + Just db -> + pure db + +-- | Read the 'UnitDatabase' at the given location. readUnitDatabase :: Logger -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) readUnitDatabase logger cfg conf_file = do isdir <- OsPath.doesDirectoryExist conf_file @@ -782,7 +865,8 @@ readUnitDatabase logger cfg conf_file = do pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) . mkUnitKeyInfo) proto_pkg_configs -- - return $ UnitDatabase conf_file' pkg_configs1 + pkg_configs2 <- traverse evaluateUnitInfo pkg_configs1 + return $ pkg_configs2 `seqList` UnitDatabase conf_file' pkg_configs2 where readDirStyleUnitInfo :: OsPath -> IO [DbUnitInfo] readDirStyleUnitInfo conf_dir = do @@ -834,11 +918,6 @@ readUnitDatabase logger cfg conf_file = do else return (Just []) -- ghc-pkg will create it when it's updated else return Nothing -distrustAllUnits :: [UnitInfo] -> [UnitInfo] -distrustAllUnits pkgs = map distrust pkgs - where - distrust pkg = pkg{ unitIsTrusted = False } - mungeUnitInfo :: OsPath -> OsPath -> UnitInfo -> UnitInfo mungeUnitInfo top_dir pkgroot = @@ -866,6 +945,29 @@ mungeBytecodeLibFields pkg = ds -> ds } +evaluateUnitInfo :: UnitInfo -> IO UnitInfo +evaluateUnitInfo ui = do + importDirs <- evaluate $ unitImportDirs ui + includeDirs <- evaluate $ unitIncludeDirs ui + libraryDirs <- evaluate $ unitLibraryDirs ui + libraryBytecodeDirs <- evaluate $ unitLibraryBytecodeDirs ui + extDepFrameworkDirs <- evaluate $ unitExtDepFrameworkDirs ui + haddockInterfaces <- evaluate $ unitHaddockInterfaces ui + haddockHTMLs <- evaluate $ unitHaddockHTMLs ui + libraryDynDirs <- evaluate $ unitLibraryDynDirs ui + libraryDirsStatic <- evaluate $ unitLibraryDirsStatic ui + evaluate ui + { unitImportDirs = importDirs + , unitIncludeDirs = includeDirs + , unitLibraryDirs = libraryDirs + , unitLibraryDynDirs = libraryDynDirs + , unitLibraryDirsStatic = libraryDirsStatic + , unitLibraryBytecodeDirs = libraryBytecodeDirs + , unitExtDepFrameworkDirs = extDepFrameworkDirs + , unitHaddockInterfaces = haddockInterfaces + , unitHaddockHTMLs = haddockHTMLs + } + -- ----------------------------------------------------------------------------- -- Modify our copy of the unit database based on trust flags, -- -trust and -distrust. @@ -874,22 +976,28 @@ applyTrustFlag :: UnitPrecedenceMap -> UnusableUnits -> [UnitInfo] + -> (Set.Set UnitId, Set.Set UnitId) -> TrustFlag - -> MaybeErr UnitErr [UnitInfo] -applyTrustFlag prec_map unusable pkgs flag = + -> MaybeErr UnitErr (Set.Set UnitId, Set.Set UnitId) +applyTrustFlag prec_map unusable pkgs (trusted, distrusted) flag = case flag of -- we trust all matching packages. Maybe should only trust first one? -- and leave others the same or set them untrusted TrustPackage str -> case selectPackages prec_map (PackageArg str) pkgs unusable of Left ps -> Failed (TrustFlagErr flag ps) - Right (ps,qs) -> Succeeded (map trust ps ++ qs) - where trust p = p {unitIsTrusted=True} + Right (ps,_) -> Succeeded (insertAll ps trusted, removeAll ps distrusted) DistrustPackage str -> case selectPackages prec_map (PackageArg str) pkgs unusable of Left ps -> Failed (TrustFlagErr flag ps) - Right (ps,qs) -> Succeeded (distrustAllUnits ps ++ qs) + Right (ps,_) -> Succeeded (removeAll ps trusted, insertAll ps distrusted) + +insertAll :: [UnitInfo] -> Set UnitId -> Set UnitId +insertAll elements set = foldl' (\ acc -> flip Set.insert acc . unitId) set elements + +removeAll :: [UnitInfo] -> Set UnitId -> Set UnitId +removeAll elements set = foldl' (\ acc -> flip Set.delete acc . unitId) set elements applyPackageFlag :: UnitPrecedenceMap @@ -1093,6 +1201,7 @@ pprTrustFlag flag = case flag of -- See Note [Wired-in units] in GHC.Unit.Types type WiringMap = UniqMap UnitId UnitId +type UnwiringMap = UniqMap UnitId UnitId findWiredInUnits :: Logger @@ -1100,9 +1209,7 @@ findWiredInUnits -> [UnitInfo] -- database -> VisibilityMap -- info on what units are visible -- for wired in selection - -> IO ([UnitInfo], -- unit database updated for wired in - WiringMap) -- map from unit id to wired identity - + -> IO WiringMap -- map from unit id to wired identity findWiredInUnits logger prec_map pkgs vis_map = do -- Now we must find our wired-in units, and rename them to -- their canonical names (eg. base-1.0 ==> base), as described @@ -1165,27 +1272,41 @@ findWiredInUnits logger prec_map pkgs vis_map = do , not (unitIsIndefinite realUnitInfo) ] - updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs - where upd_pkg pkg - | Just wiredInUnitId <- lookupUniqMap wiredInMap (unitId pkg) - = pkg { unitId = wiredInUnitId - , unitInstanceOf = wiredInUnitId - -- every non instantiated unit is an instance of - -- itself (required by Backpack...) - -- - -- See Note [About units] in GHC.Unit - } - | otherwise - = pkg - upd_deps pkg = pkg { - unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), - unitExposedModules - = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) - (unitExposedModules pkg) - } - - - return (updateWiredInDependencies pkgs, wiredInMap) + return wiredInMap + +updateWiredInUnits :: WiringMap -> UnitInfoMap -> [UnitInfo] -> [Either UnitInfo UnitInfo] +updateWiredInUnits wiredInMap knownInfos pkgs = + map (updateWiredInUnitsInUnitInfo wiredInMap knownInfos) pkgs + +updateWiredInUnitsInUnitInfo :: WiringMap -> UnitInfoMap -> UnitInfo -> Either UnitInfo UnitInfo +updateWiredInUnitsInUnitInfo wiredInMap knownInfos pkg = + let + upd_pkg pkg + | Just wiredInUnitId <- lookupUniqMap wiredInMap (unitId pkg) + = pkg { unitId = wiredInUnitId + , unitInstanceOf = wiredInUnitId + -- every non instantiated unit is an instance of + -- itself (required by Backpack...) + -- + -- See Note [About units] in GHC.Unit + } + | otherwise + = pkg + upd_deps pkg = pkg { + unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), + unitExposedModules + = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) + (unitExposedModules pkg) + } + in + case lookupUniqMap knownInfos (unitId pkg) of + Just ui -> + Right ui + Nothing -> + let + updated_pkg = upd_deps $ upd_pkg pkg + in + Left updated_pkg -- Helper functions for rewiring Module and Unit. These -- rewrite Units of modules in wired-in packages to the form known to the @@ -1468,9 +1589,10 @@ validateDatabase cfg pkg_map1 = mkUnitState :: Logger + -> IORef UnitIndex -> UnitConfig - -> IO (UnitState,[UnitDatabase UnitId]) -mkUnitState logger cfg = do + -> IO UnitState +mkUnitState logger unit_index cfg = do {- Plan. @@ -1524,15 +1646,19 @@ mkUnitState logger cfg = do we build a mapping saying what every in scope module name points to. -} - -- if databases have not been provided, read the database flags - raw_dbs <- case unitConfigDBCache cfg of - Nothing -> readUnitDatabases logger cfg - Just dbs -> return dbs + raw_dbs <- readUnitDatabases logger cfg -- distrust all units if the flag is set - let distrust_all db = db { unitDatabaseUnits = distrustAllUnits (unitDatabaseUnits db) } - dbs | unitConfigDistrustAll cfg = map distrust_all raw_dbs - | otherwise = raw_dbs + let unitsOf db = Set.fromList $ map unitId (unitDatabaseUnits db) + allUnits = Set.unions $ map unitsOf raw_dbs + + distrustedUnits + | unitConfigDistrustAll cfg = allUnits + | otherwise = Set.empty + + trustedUnits = Set.empty + + dbs = raw_dbs -- This, and the other reverse's that you will see, are due to the fact that @@ -1555,11 +1681,12 @@ mkUnitState logger cfg = do reportCycles logger sccs reportUnusable logger unusable - -- Apply trust flags (these flags apply regardless of whether + -- Compute trust flags (these flags apply regardless of whether -- or not packages are visible or not) - pkgs1 <- mayThrowUnitErr - $ foldM (applyTrustFlag prec_map unusable) - (nonDetEltsUniqMap pkg_map2) (reverse (unitConfigFlagsTrusted cfg)) + (!trusted, !distrusted) <- mayThrowUnitErr + $ foldM (applyTrustFlag prec_map unusable (nonDetEltsUniqMap pkg_map2)) + (trustedUnits, distrustedUnits) (reverse (unitConfigFlagsTrusted cfg)) + let pkgs1 = nonDetEltsUniqMap pkg_map2 let prelim_pkg_db = mkUnitInfoMap pkgs1 -- @@ -1625,7 +1752,21 @@ mkUnitState logger cfg = do -- it modifies the unit ids of wired in packages, but when we process -- package arguments we need to key against the old versions. -- - (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2 + ui <- readIORef unit_index + (wired_map, pkgs2) <- do + wireMap <- if isWireMapEmpty ui + then do + wmap <- findWiredInUnits logger prec_map pkgs1 vis_map2 + modifyIORef' unit_index (setWireMap wmap) + pure wmap + else do + pure $ ui_wireMap ui + + let all_pkgs = updateWiredInUnits wireMap (ui_unitInfoMap ui) pkgs1 + (new_pkgs, _pkgs_set) = partitionEithers all_pkgs + modifyIORef' unit_index (addUnitInfoMap $ mkUnitInfoMap new_pkgs) + pure (wireMap, map (either id id) all_pkgs) + let pkg_db = mkUnitInfoMap pkgs2 -- Update the visibility map, so we treat wired packages as visible. @@ -1707,15 +1848,17 @@ mkUnitState logger cfg = do , explicitUnits = explicit_pkgs , homeUnitDepends = home_unit_deps , unitInfoMap = pkg_db + , trustedUnits = trusted + , distrustedUnits = distrusted , moduleNameProvidersMap = mod_map , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db plugin_vis_map , packageNameMap = pkgname_map - , wireMap = wired_map - , unwireMap = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ] + -- , wireMap = wired_map + -- , unwireMap = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ] , requirementContext = req_ctx , allowVirtualUnits = unitConfigAllowVirtual cfg } - return (state, raw_dbs) + return state selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True @@ -1732,9 +1875,9 @@ selectHomeUnits home_units flags = foldl' go Set.empty flags -- | Given a wired-in 'Unit', "unwire" it into the 'Unit' -- that it was recorded as in the package database. -unwireUnit :: UnitState -> Unit -> Unit +unwireUnit :: UnitIndex -> Unit -> Unit unwireUnit state uid@(RealUnit (Definite def_uid)) = - maybe uid (RealUnit . Definite) (lookupUniqMap (unwireMap state) def_uid) + maybe uid (RealUnit . Definite) (lookupUniqMap (ui_unwireMap state) def_uid) unwireUnit _ uid = uid -- ----------------------------------------------------------------------------- @@ -2151,10 +2294,10 @@ pprUnitsWith pprIPI pkgstate = -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) pprUnitsSimple :: UnitState -> SDoc -pprUnitsSimple = pprUnitsWith pprIPI +pprUnitsSimple ue = pprUnitsWith pprIPI ue where pprIPI ipi = let i = unitIdFS (unitId ipi) e = if unitIsExposed ipi then text "E" else text " " - t = if unitIsTrusted ipi then text "T" else text " " + t = if isUnitInfoTrusted ue ipi then text "T" else text " " in e <> t <> text " " <> ftext i -- | Show the mapping of modules to where they come from. ===================================== compiler/ghc.cabal.in ===================================== @@ -966,6 +966,7 @@ Library GHC.Unit GHC.Unit.Env GHC.Unit.External + GHC.Unit.External.Database GHC.Unit.Finder GHC.Unit.Finder.Types GHC.Unit.Home ===================================== ghc/GHCi/UI.hs ===================================== @@ -856,10 +856,12 @@ installInteractiveHomeUnits dflags = do where setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv setupHomeUnitFor logger dflags all_home_units = do - (dbs,unit_state,home_unit,_mconstants) <- - liftIO $ initUnits logger dflags Nothing all_home_units + env <- GHC.getSession + let unit_index = hsc_unit_index env + (unit_state,home_unit,_mconstants) <- + liftIO $ initUnits logger dflags unit_index (hscEUDC env) all_home_units hpt <- liftIO emptyHomePackageTable - pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit)) + pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit)) concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag] concatPackageDbStacksUsingLongestCommonPrefix stacks = @@ -2919,11 +2921,11 @@ isSafeModule m = do packageTrusted hsc_env md | isHomeModule (hsc_home_unit hsc_env) md = True - | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) + | otherwise = isUnitTrusted (hsc_units hsc_env) (moduleUnit md) tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) | otherwise = S.partition part deps - where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg + where part pkg = isUnitIdTrusted unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env ===================================== libraries/ghc-boot/GHC/Unit/Database.hs ===================================== @@ -746,11 +746,20 @@ mungeUnitInfoPaths top_dir pkgroot pkg = , unitHaddockHTMLs = munge_paths (munge_urls (unitHaddockHTMLs pkg)) } where - munge_paths = map munge_path - munge_urls = map munge_url + munge_paths = strictMap munge_path + munge_urls = strictMap munge_url (munge_path,munge_url) = mkMungePathUrl top_dir pkgroot -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. -- Prefer 'decodeUtf' and gracious error handling. unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath unsafeDecodeUtf = OsPath.Internal.so + +strictMap :: (a -> b) -> [a] -> [b] +strictMap _ [] = [] +strictMap f (x:xs) = + let + !x' = f x + !xs' = strictMap f xs + in + x' : xs' ===================================== utils/haddock/haddock-api/src/Haddock.hs ===================================== @@ -258,7 +258,9 @@ haddockWithGhc ghc args = handleTopExceptions $ do logger' <- getLogger let logger = setLogFlags logger' (initLogFlags dflags) let parserOpts = Parser.initParserOpts dflags - !unit_state <- hsc_units <$> getSession + env <- getSession + let !unit_state = hsc_units env + !unit_index <- liftIO $ hscUnitIndex env -- If any --show-interface was used, show the given interfaces forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do @@ -285,7 +287,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do } -- Render the interfaces. - liftIO $ renderStep dflags parserOpts logger unit_state flags sinceQual qual concSem packages ifaces + liftIO $ renderStep dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem packages ifaces -- If we were not given any input files, error if documentation was -- requested @@ -298,7 +300,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do packages <- liftIO $ readInterfaceFiles name_cache (readIfaceArgs flags) noChecks -- Render even though there are no input files (usually contents/index). - liftIO $ renderStep dflags parserOpts logger unit_state flags sinceQual qual concSem packages [] + liftIO $ renderStep dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem packages [] -- | Run the GHC action using a temporary output directory withTempOutputDir :: Ghc a -> Ghc a @@ -354,6 +356,7 @@ renderStep :: DynFlags -> ParserOpts -> Logger + -> UnitIndex -> UnitState -> [Flag] -> SinceQual @@ -362,7 +365,7 @@ renderStep -> [(DocPaths, Visibility, FilePath, InterfaceFile)] -> [Interface] -> IO () -renderStep dflags parserOpts logger unit_state flags sinceQual nameQual concSem pkgs interfaces = do +renderStep dflags parserOpts logger unit_index unit_state flags sinceQual nameQual concSem pkgs interfaces = do updateHTMLXRefs (map (\(docPath, _ifaceFilePath, _showModules, ifaceFile) -> ( case baseUrl flags of Nothing -> docPathsHtml docPath @@ -378,7 +381,7 @@ renderStep dflags parserOpts logger unit_state flags sinceQual nameQual concSem (DocPaths {docPathsSources=Just path}, _, _, ifile) <- pkgs iface <- ifInstalledIfaces ifile return (instMod iface, path) - render dflags parserOpts logger unit_state flags sinceQual nameQual concSem interfaces installedIfaces extSrcMap + render dflags parserOpts logger unit_index unit_state flags sinceQual nameQual concSem interfaces installedIfaces extSrcMap where -- get package name from unit-id packageName :: Unit -> String @@ -392,6 +395,7 @@ render :: DynFlags -> ParserOpts -> Logger + -> UnitIndex -> UnitState -> [Flag] -> SinceQual @@ -401,7 +405,7 @@ render -> [(FilePath, PackageInterfaces)] -> Map Module FilePath -> IO () -render dflags parserOpts logger unit_state flags sinceQual qual concSem ifaces packages extSrcMap = do +render dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem ifaces packages extSrcMap = do let packageInfo = PackageInfo { piPackageName = fromMaybe (PackageName mempty) $ optPackageName flags @@ -503,7 +507,7 @@ render dflags parserOpts logger unit_state flags sinceQual qual concSem ifaces p -- records the *wired in* identity base. So untranslate it -- so that we can service the request. unwire :: Module -> Module - unwire m = m { moduleUnit = unwireUnit unit_state (moduleUnit m) } + unwire m = m { moduleUnit = unwireUnit unit_index (moduleUnit m) } reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \mod_str -> do let warn' = hPutStrLn stderr . ("Warning: " ++) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d499fe14e89d9e860eed142bc8db87… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d499fe14e89d9e860eed142bc8db87… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 64 commits: Trim the continuation in mkDupableContWithDmds
by Hannes Siebenhandl (＠fendor) 16 Jun '26

16 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: 4a645683 by Simon Peyton Jones at 2026-05-27T21:41:59-04:00 Trim the continuation in mkDupableContWithDmds When there are no remaining argument demands, it means the application is bottoming. In this case, we can trim the continuation to avoid the panic that was observed in #27261. See Note [Trimming the continuation for bottoming functions] in GHC.Core.Opt.Simplify.Iteration. - - - - - 8ab506ff by Cheng Shao at 2026-05-27T21:42:47-04:00 ghci: fix module name string lifetime in hs_hpc_module invocation This patch makes hpcAddModule pass a properly malloced module name string to hs_hpc_module, instead of using useAsCString which causes use-after-free of module name string. Fixes #27297. Co-authored-by: Codex <codex(a)openai.com> - - - - - b0233814 by sheaf at 2026-05-27T21:43:31-04:00 Relax acceptance threshold for T10421 As seen in #27289, the 1% acceptance threshold for this text was overly narrow, resulting in spurious test failures. This commit widens the acceptance threshold to 2%. Fixes #27289. - - - - - 63ce5770 by Luite Stegeman at 2026-05-28T12:23:35-04:00 Fixes for black holes - suspend duplicate work for eager black holes - detect eager black holes in checkBlockingQueues - don't overwrite existing black holes even if they're not in an eager blackhole frame - don't deadlock on self when thunk is already blackholed Fixes #26936 - - - - - 037a80dc by Tom McLaughlin at 2026-05-28T12:24:36-04:00 Event/Windows.hsc: rethrow exceptions in overlapped IO This prevents the WinIO manager from swallowing exceptions in overlapped IO. It was added to make WinIO support possible in the `network` library. See https://gitlab.haskell.org/ghc/ghc/-/issues/27283. We also bump __IO_MANAGER_WINIO__ to 2 so libraries can gate on this using CPP. - - - - - 2d53bcdb by Wolfgang Jeltsch at 2026-05-28T12:25:21-04: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> - - - - - f4fbb583 by Simon Jakobi at 2026-05-28T12:26:04-04:00 Add regression test for T11226 Closes #11226. - - - - - ed29a5e6 by Sven Tennie at 2026-05-28T17:30:36-04:00 Add optional config setting for LibDir (#19174) Previously, the `libDir` was derived from `topDir`. This won't work for inplace stage2 cross-compilers where binaries and libraries are in different stage dirs (`_build/stage1/` for executables and `_build/stage2` for libraries). `LibDir` is set in the inplace `settings` files. For bindists, we generate a new `settings` file with no `LibDir` entry. GHC then defaults to use `topDir` as `libDir` again. This keeps the bindist relocatable. If `LibDir` is a relative path, it is interpreted relatively to `topDir`. The global package db is part of the `lib/` folder. If we want to point for inplace cross-compilers to the succeeding stage's folder, this is done by setting `LibDir`. Thus, the global package db must be found relative to `libDir`` (which may default to `topDir` or be set by `LibDir`). The complexity of settings becomes scary. So, add a test to ensure `LibDir` works as expected. - - - - - 8339cf8f by Sven Tennie at 2026-05-28T17:30:36-04:00 Add Haddock to FileSettings Helping to understand the fields' meanings without deeper analyses. - - - - - 4ce251e4 by Sylvain Henry at 2026-05-28T17:31:39-04:00 foundation test: skip signed minBound `quot` (-1) (#27222) `minBound `quot` (-1)` for fixed-width signed integers is platform dependent: the mathematical result -minBound is not representable in the type. On x86, IDIV traps; LLVM's sdiv is undefined behaviour in this case; on AArch64/RISC-V, SDIV wraps to minBound. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - b8ba7e61 by Simon Jakobi at 2026-05-28T17:32:23-04:00 Prevent dictionary-passing in checkTyEqRhs ...by pre-specializing it to TcM. Previously, wherever checkTyEqRhs was used in other modules, the Core showed dictionary passing ($fMonadIOEnv). The added SPECIALIZE pragma prevents this. - - - - - d603477f by David Eichmann at 2026-05-29T13:17:12-04:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll. The correct dll name differs based on if the dll is inplace/final and if using the Dynamic way. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls at runtime in experiments with windows dynamic linking. - - - - - 1fc21753 by Sylvain Henry at 2026-05-29T13:18:14-04:00 ghc-bignum: copy backend interface haddocks to Native backend (#27305) The haddock comments documenting the BigNat backend interface (function contracts, expected MutableWordArray# sizes, return-value semantics, etc.) were attached to the FFI backend module. Copy them to the Native backend so they remain in tree once the FFI backend is removed. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 717059df by Sylvain Henry at 2026-05-29T13:18:14-04:00 ghc-bignum: remove FFI backend (#27305) The FFI backend of ghc-bignum (now part of ghc-internal) had no known users and is easy to recreate by relinking ghc-internal with a custom backend. Remove the backend module, the bignum-ffi cabal flag, and the ffi option from Hadrian's --bignum selector. The backend interface documentation now lives in the Native backend module. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 4bb3b1d8 by Sylvain Henry at 2026-05-29T13:18:14-04:00 ghc-bignum: remove Check backend (#27305) The Check backend of ghc-bignum (now part of ghc-internal) compared the selected backend's output against the Native backend for validation. It had no known users. Remove the backend module, the bignum-check cabal flag, the bignumCheck Hadrian flavour field, and the check- prefix in Hadrian's --bignum selector. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 6b3044a0 by David Eichmann at 2026-05-30T11:58:48-04:00 Add code comments to allocator code - - - - - f4e04210 by Matthew Pickering at 2026-05-30T11:59:34-04:00 hadrian: Refactor system-cxx-std-lib rules I noticed a few things wrong with the hadrian rules for `system-cxx-std-lib` rules. * For `text` there is an ad-hoc check to depend on `system-cxx-std-lib` outside of `configurePackage`. * The `system-cxx-std-lib` dependency is not read from cabal files. * Recache is not called on the packge database after the `.conf` file is generated, a more natural place for this rule is `registerRules`. Treating this uniformly like other packages is complicated by it not having any source code or a cabal file. However we can do a bit better by reporting the dependency firstly in `PackageData` and then needing the `.conf` file in the same place as every other package in `configurePackage`. This commit increases the `shakeVersion`, to provide backwards compatibility to previous builds with different PackageData. Fixes #25303 Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com> - - - - - 576987d0 by Simon Jakobi at 2026-06-02T04:53:36-04:00 compiler: use nubOrd from containers Address #27103 by replacing GHC.Utils.Misc.ordNub[On] with Data.Containers.ListUtils.nubOrd[On]. Note that nubOrd suffers from a small inefficiency, a fix for which will be included in the next containers release: https://github.com/haskell/containers/issues/1202 - - - - - deea53c3 by David Eichmann at 2026-06-02T04:54:22-04:00 Hadrian: disable response files for GHC/Haddock builders on non-Windows This makes debugging build errors easier on non-windows hosts. See issue #27230 - - - - - f2f5c6ba by Nikita Efremov at 2026-06-02T16:04:54+00:00 fix typo : compete with performance, not complete - - - - - 5524ea0e by Wolfgang Jeltsch at 2026-06-03T08:01:26-04:00 Make the current `base` buildable with GHC 9.14 This comprises the following changes: * Disable some imports into `GHC.Base` for GHC 9.14 * Disable some imports into `Prelude` for GHC 9.14 * Disable separate `ArrowLoop` import for GHC 9.14 * Disable `GHC.Internal.STM` import for GHC 9.14 * Disable `GHC.Internal.Unicode.Version` import for GHC 9.14 * Disable `GHC.Internal.TH.Monad` import for GHC 9.14 * Add alternative `fixIO` import for GHC 9.14 * Add alternative `unsafeCodeCoerce` import for GHC 9.14 * Disable hiding of imported SIMD operations for GHC 9.14 * Disable use of GHC 9.14’s `printToHandleFinalizerExceptionHandler` * Enable use of `getFileHash` from `ghc-internal` for GHC 9.14 * Make `thenA` available for GHC 9.14 * Make `thenM` available for GHC 9.14 * Disable translation of `IoManagerFlagPoll` for GHC 9.14 * Add `hGetNewlineMode` for GHC 9.14 - - - - - d3438055 by Enrico Maria De Angelis at 2026-06-03T08:02:17-04:00 Fix #27067 - Clarify haddocks on `minusNaturalMaybe` - - - - - f9bcfac2 by sheaf at 2026-06-03T14:47:19-04:00 Avoid mkTick in Core Prep breaking ANF As discovered in #27182, mkTick can break ANF. This patch introduces a variant of mkTick that skips the single optimisation that could break ANF. This is preferrable over switching to the raw Tick constructor, as the latter may introduce spurious cost centres in profiling reports. This is a temporary measure until we more thoroughly refactor how mkTick works (see #27141). See Note [mkTick breaks ANF] in GHC.CoreToStg.Prep. Fixes #27182 - - - - - cf1fd661 by Artem Pelenitsyn at 2026-06-03T14:48:09-04:00 clarify comment for getSizeofMutableByteArray#: we get the size in bytes, not "elements" - - - - - a3b431f3 by David Eichmann at 2026-06-04T10:10:19+00:00 Hadrian: convert env variable ACLOCAL_PATH to unix paths. Convert ACLOCAL_PATH to a unix style path when invoking autoreconf. Autoreconf doesn't handle windows paths. See Note [Autoreconf unix paths from ACLOCAL_PATH]. Fixes #27311 - - - - - 18f6138a by Simon Jakobi at 2026-06-04T20:20:31-04:00 testsuite: Deduplicate --only test names config.only is assumed to be a set, but supplying --only overwrote it with the (list) argparse result, which can contain duplicates. When a test ran, config.only.remove(name) dropped only the first occurrence, so a duplicated name lingered and was later misreported as a "test not found" framework failure. Store it as a set instead. Fixes #27322 Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - 2f3cc9ff by Simon Jakobi at 2026-06-08T07:55:49-04:00 testsuite: detect fast bignum via ghc-internal, not removed ghc-bignum The ghc-bignum package was merged into ghc-internal, so the BIGNUM_GMP probe in test.mk ran `ghc-pkg field ghc-bignum exposed-modules`, which fails with "cannot find package ghc-bignum". That error went to stderr and leaked into the captured stderr of every makefile_test, causing spurious [bad stderr] failures across the suite. The probe also silently returned empty, so config.have_fast_bignum was wrongly False even on GMP builds. Probe ghc-internal's extra-libraries for the gmp library instead: the GMP backend module is an other-module (not exposed), but GMP_LIBS adds gmp to extra-libraries only on a GMP build, so this distinguishes the backends. Redirect stderr to keep any future missing-package error off the harness's stderr. This also removes a stale comment as per suggestion from hsyl20. Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - eb3bf6e7 by Alan Zimmerman at 2026-06-08T07:56:32-04:00 EPA: Rename Transform.anchorEof to addModuleCommentOrigDeltas This now matches what it actually does. - - - - - 498bb21a by David Eichmann at 2026-06-09T18:02:39-04:00 Hadrian: avoid response files when command line is short enough This replaces the logic of always using response files on Windows. With the new condition based on command line lenght, reponse files can be avoided in many more cases (on windows). Now that response files are only used in a small number of cases, response files are always kept and the -r / --keep-response-files command line options have been removed The response file paths are nolonger randomized. They are placed in the `_build/rsp` directory. This ensures they are ignored by git and we that Hadrian reuses response file paths when rebuilding rather than leaving stale response files around. Update user guide putting response files in its own section - - - - - 87f510a5 by Simon Hengel at 2026-06-09T18:03:25-04:00 Don't use non-breaking spaces - - - - - 41a19379 by David Eichmann at 2026-06-09T18:04:11-04:00 Hadrian: remove unused wrapper scripts from windows bindist These wrapper scripts are only installed on non-relocatable builds which are not generally supported on windows. - - - - - ce01ccb6 by sheaf at 2026-06-10T05:08:48-04:00 Don't drop ticks around variables of type `IO ()` GHC.Core.Utils.mkTick is responsible for placing a tick on a Core expression. It contains logic for dropping SCCs (non-counting profiling ticks) around non-function variables, as such variables cannot meaningfully contribute to profiles. However, the logic for what counts as a function was incorrect: it used `isFunTy` which returns 'False' for types such as 'IO ()' where the function arrow is hidden under a newtype. We now use 'mightBeFunTy' instead of 'isFunTy'. This ensures we don't drop ticks in cases we aren't sure. On the way, we improve the documentation of 'isFunTy', 'isPiTy' and 'mightBeFunTy', and update the latter's implementation to consistently handle unary classes. Fixes #27225 ------------------------- Metric Decrease: T5642 ------------------------- - - - - - d311c4f1 by Simon Jakobi at 2026-06-10T05:09:32-04:00 testsuite: Add regression test for #4081 Check that a strict constructor field is unboxed once outside an enclosing loop, not re-inspected each iteration (the float-out case-floating from 9cb20b488). Uses simonpj's `data T a = T !a` example from the ticket; T4081.stderr captures the expected Core. Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - 333df444 by sheaf at 2026-06-10T05:10:25-04:00 Check for cabal-install >= 3.12 upfront Starting with commit 8cb99552f607f6bc4000e45ab32532d50c8bb996, Hadrian requires cabal-install >= 3.12 in order to use the 'cabal path' command that was introduced in version 3.12, as per https://github.com/haskell/cabal/blob/a51c4ee1556d816ad86e90db7e6330dd51b0b… This was not reflected in the Hadrian build script, causing a delayed build failure instead of enforcing the version requirement upfront, which this patch does. Fixes #27317 - - - - - 98c20394 by sheaf at 2026-06-10T05:11:09-04:00 Fix crash in Data.Data instance for HsCtxt The Data.Data instance for HsCtxt contained an error for the 'toConstr' method, which could trigger for example when looking at -ddump-tc-ast traces. Replace it with the 'abstractConstr' pattern used in the rest of the codebase. - - - - - 5ac9ce7d by Zubin Duggal at 2026-06-10T21:26:32+05:30 hadrian: Remove old package.conf files when generating new ones Old package.conf files might exists with different hashes, causing issues like #26661 Fixes #26661 - - - - - c9015f09 by sheaf at 2026-06-11T12:40:28-04:00 Fix AArch64 clobbering bug for MUL2 On AArch64, the code generator could clobber one of the input operands when computing the lower bits of a MUL2 operation. This rendered invalid the subsequent computation of the high bits. This commit fixes that by using a temporary register. The register allocator can remove the redundant move in the common case when the registers do not conflict. Fixes #27046 - - - - - 7ab90288 by Rodrigo Mesquita at 2026-06-11T12:41:11-04:00 fix: make T27131 less flaky It seems that T27131 fails flakily in a race where we check the flag before the capability had the chance to process the mailbox which sets the flag. This seemingly should only happen if the capability ends up being the same for setting and checking the flag. - - - - - 8965cb76 by Marc Scholten at 2026-06-12T04:53:22-04:00 haddock: render modules concurrently - - - - - 8cc0b64a by Duncan Coutts at 2026-06-12T04:54:06-04:00 Promote HAVE_PREEMPTION from Timer.c to OSThreads.h We will want to know about HAVE_PREEMPTION in more places. HAVE_PREEMPTION tells us that we do have OS threads available, irrespective of whether THREADED is defined. In particular, HAVE_PREEMPTION is defined on all proper OSs, but not on WASM (and hyopthetically may not be true on some other platforms like micro-controllers, RTOSs, VM hypervisors etc). - - - - - cce574ed by Duncan Coutts at 2026-06-12T04:54:06-04:00 Define ACQUIRE_LOCK_ALWAYS and friends Fix issue #27335 Like the atomic _ALWAYS variants, these lock actions are always defined, rather than being dependent on whether we are in the THREADED case. All the "normal" LOCK macros are defined to be no-ops when !THREADED. The use case for the _ALWAYS variants is where we are using OS threads even in the non-threaded RTS. This includes everything to do with the timer/ticker thread, which is used in the non-threaded RTS too. In particular, we will want to use this for eventlog things, because the timer thread performs eventlogging concurrently with the main capability, even in the non-threaded RTS. - - - - - 1f28d1f6 by Duncan Coutts at 2026-06-12T04:54:06-04:00 Use ACQUIRE/RELEASE_LOCK_ALWAYS with eventBufMutex Even in the non-threaded RTS the eventBufMutex is needed by both the main capability and the timer/ticker thread, so always use the mutex. This should fix #25165 which is about the main capability and the timer thread posting events to the eventlog buffer concurrently and thereby corrupting the buffer data. - - - - - 0ff29782 by Duncan Coutts at 2026-06-12T04:54:06-04:00 Expose eventBufMutex in the EventLog interface/header We will need it in forkProcess to ensure we don't write to the global eventlog buffer concurrently with trying to flush eventlog buffers and do the fork(). - - - - - 7a688395 by Duncan Coutts at 2026-06-12T04:54:07-04:00 Split flushAllCapsEventsBufs into safe and unlocked version Following the convention that unlocked versions have a trailing _ underscore in their name. This one requires the caller to hold the eventlog global buffer mutex. We will need this in forkProcess. - - - - - 341ed474 by Duncan Coutts at 2026-06-12T04:54:07-04:00 Remove redundant use of stopTimer in setNumCapabilities Historically, the comment here was: We must stop the interval timer while we are changing the capabilities array lest handle_tick may try to context switch an old capability. See #17289. and We must disable the timer while we do this since the tick handler may call contextSwitchAllCapabilities, which may see the capabilities array as we free it. What this refers to is that historically, when changing the number of capabilities, the array of capabilities was reallocated to a new size, allocating new ones and freeing the old ones, thus invalidating all existing capbility pointers. Strangely, for good measure the code used to call stopTimer twice (hence the two similar comments above). However, since commit a3eccf06292dd666b24606251a52da2b466a9612, the capabilities array is no longer reallocated. Instead the array is allcoated once on RTS startup to the maximum size it could ever be allowed to be, and then capabilities get enabled/disabled at runtime. So the capability pointers never become invalid anymore. At worst, they may point to capabilities that are disabled. Thus we no longer need to stop the timer (twice) while we change the number of enabled capabilities. This also partially solves issue #27105, which notes that stopTimer is being used as if it were synchronous, when it is not. At least for this case, the solution is that stopTimer is not needed at all! - - - - - 674858e3 by Duncan Coutts at 2026-06-12T04:54:07-04:00 Remove redundant use of stopTimer in forkProcess but replace it with taking the eventlog buffer lock during the fork. Fixes issue #27105 The original reason to block the timer during a fork was that historically the timer was implemented using a periodic timer signal, and the signal itself would interrupt the fork system call (returning EINTR). For large processes (where fork() takes a while) this could permanently livelock: the timer always would go off before the fork could complete, which got retried in a loop forever. The timer is no longer implemented as a unix signal, but uses threads. Thus the original problem no longer exists. The only remaining reason to block the timer tick is to prevent actions taken by the tick from interfering with the delicate process involved in fork (taking a load of locks and pausing everything). The only thing we need to do is to prevent the eventlog from being written to or flushed while the fork is taking place. To achieve this all we need to do is hold the mutex for the global eventlog buffer. This removes the last use of stopTimer that expects stopTimer to work synchronously (which it was not) and thus solves issue #27105. To be clear, we solve issue #27105 not by making stopTimer synchronous, but by eliminating the use sites that expected it to be synchronous. - - - - - 40764930 by sheaf at 2026-06-12T14:54:43-04:00 Add type family performance test for #26426 Some GHC versions produced large numbers of coercions after typechecking and desugaring when compiling the program in #26426: Version | Typechecker time | Typechecker allocations | Coercions -------:|-----------------:|------------------------:|---------: 9.6 | 47 ms | 48 MB | 110k 9.8 | 1000 ms | 486 MB | 10,437k 9.10 | 922 ms | 489 MB | 10,436k 9.12 | 906 ms | 482 MB | 10,437k 9.14 | 63 ms | 55 MB | 333k 10.0 | 47 ms | 64 MB | 35k The improvement 9.12 -> 9.14 was due to commit 22d11fa818fae2c95c494fc0fac1f8cb4c6e7cb6, while the improvement 9.14 -> 10.0 was due to commit 0b7df6db9e46df40e86fbff1a66dc10440b99db5. As the behaviour of GHC seems better than it's ever been on this program, we declare victory, adding this performance test to ensure we don't regress on this program. On the way, we update Note [Combining equalities] in GHC.Tc.SolveR.Equality with the explanation of the 9.12 -> 9.14 improvement (getting rid of an exponential blowup in coercion sizes), and we update Note [Exploiting closed type families] in GHC.Tc.Solver.FunDeps with the explanation of the 9.14 -> 10.0 improvement (bringing down coercion size growth from cubic to quadratic). - - - - - 0f3d0a71 by Zubin Duggal at 2026-06-12T14:55:30-04:00 compiler: mark tool messages as errors/warnings depending on the exit code Fixes #27370 - - - - - d9ea2d76 by mangoiv at 2026-06-13T04:41:51-04:00 libraries/process: bump submodule to v1.6.30.0 - bump the submodule to the appropriate tag - suppress benign warning resulting from the change - - - - - 6ebaaba3 by David Eichmann at 2026-06-13T04:42:37-04:00 ghc-toolchain: don't throw when candidate executables are not found Fixes #27369 - - - - - 6c65e1e1 by David Eichmann at 2026-06-13T04:43:23-04:00 CI: lint-changelog checks for no-changelog label in script instead of rules - - - - - bab37cc6 by konsumlamm at 2026-06-13T19:10:21+02:00 Implement CLC proposal #378 Add `Data.Double` and `Data.Float` modules Document that GHC uses IEEE 754 - - - - - fb5246ad by fendor at 2026-06-15T18:07:23-04:00 Drop `preloadClosure` from `UnitState` It is always hard-coded to the same value. Backpack Unit instantiation isn't using it any more. Allows us to simplify the API and get rid of `improveUnit`. - - - - - 291ce3aa by ARATA Mizuki at 2026-06-15T18:08:26-04:00 RISC-V NCG: Zero-extend the result of castFloatToWord32 According to the ISA manual, FMV.X.W sign-extends the result. We need to truncate the result to avoid creating an exotic Word32 value. Fixes #27300 - - - - - 011be91f by ARATA Mizuki at 2026-06-15T18:08:26-04:00 RISC-V NCG: Treat d28-d31 (ft8-ft11) as caller-saved According to the calling convention, the registers d28-d31 (ft8-ft11) are caller-saved. Fixes #27306 - - - - - e8a54713 by ARATA Mizuki at 2026-06-15T18:08:26-04:00 RISC-V NCG: Set rounding mode when emitting `truncate` If we omit the rounding mode for `fcvt`, `dyn` will be used. We do not want that for `truncate`, so we set `rtz`. In other places, we set `rne` because we do not use the dynamic rounding mode. Fixes #27303 - - - - - 9438bec7 by Zubin Duggal at 2026-06-15T18:09:11-04:00 rts: fix validate build with gcc 16. `__attribute__((regparm(1)))` is ignored on x86_64 and now gcc warns that it is ignored: rts/sm/Evac.h:35:1: error: error: ‘regparm’ attribute ignored [-Werror=attributes] See https://gcc.gnu.org/git/?p=gcc.git;a=commit;h=ccead81bbc39668376eb5cf47066a… Fixes #27366 - - - - - 893e6133 by Andrew Lelechenko at 2026-06-15T23:55:36+01:00 base: more NonEmpty zips CLC proposal: https://github.com/haskell/core-libraries-committee/issues/409 - - - - - 1314f2fd by David Eichmann at 2026-06-16T05:46:52-04:00 Hadrian: fix ghc-internal .def file name - - - - - 7f72bcb3 by mangoiv at 2026-06-16T05:47:39-04:00 compiler: ignore camelCase and Eta reduce hlint hints These do not cohere with the style used in GHC. After disabling them, hlint lints are much less noisy again. - - - - - 842bef9f by Alan Zimmerman at 2026-06-16T05:48:25-04:00 EPA: Use standard type family declaration for Anno - - - - - 541804ef by fendor at 2026-06-16T14:51:12+02:00 WIP: introduce external unit database cache - - - - - 420972e9 by fendor at 2026-06-16T14:52:07+02:00 Never modify UnitInfo for better sharing - - - - - d499fe14 by fendor at 2026-06-16T14:53:26+02:00 WIP: Introduce UnitIndex for global data - - - - - 228 changed files: - .gitlab-ci.yml - boot - + changelog.d/T27046 - + changelog.d/T27182.md - + changelog.d/T27225 - + changelog.d/T27261 - + changelog.d/T27308 - + changelog.d/T27317 - + changelog.d/T27359 - + changelog.d/fix-blackhole-handling - changelog.d/hadrian-response-files.md - + changelog.d/hadrian-stale-package-confs-26661 - + changelog.d/hadrian-system-cxx-std-lib-25303 - + changelog.d/libdir-setting - + changelog.d/module-graph-reuse-in-downsweep - + changelog.d/remove-bignum-check-backend - + changelog.d/remove-bignum-ffi-backend - + changelog.d/tool-messages-27370 - + changelog.d/windows-rethrow-overlapped-exception - compiler/.hlint.yaml - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Regs.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/NonEmpty.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Process.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Unit.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - compiler/GHC/Utils/Logger.hs - compiler/GHC/Utils/Misc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/ghc.cabal.in - docs/users_guide/bugs.rst - docs/users_guide/javascript.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/README.md - hadrian/build-cabal - hadrian/doc/user-settings.md - hadrian/src/Builder.hs - hadrian/src/CommandLine.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Cabal/Type.hs - hadrian/src/Hadrian/Oracles/Path.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Main.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Control/Applicative.hs - libraries/base/src/Control/Arrow.hs - libraries/base/src/Control/Monad.hs - libraries/base/src/Data/Array/Byte.hs - + libraries/base/src/Data/Double.hs - libraries/base/src/Data/Fixed.hs - + libraries/base/src/Data/Float.hs - libraries/base/src/Data/List/NonEmpty.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Conc.hs - libraries/base/src/GHC/Conc/Sync.hs - libraries/base/src/GHC/Exts.hs - libraries/base/src/GHC/Fingerprint.hs - libraries/base/src/GHC/IO/Handle.hs - libraries/base/src/GHC/RTS/Flags.hs - libraries/base/src/GHC/Unicode.hs - libraries/base/src/GHC/Weak.hs - libraries/base/src/GHC/Weak/Finalize.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/IO.hs - libraries/base/src/System/Mem/Weak.hs - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-boot/GHC/Data/ShortByteString.hs - libraries/ghc-boot/GHC/Settings/Utils.hs - libraries/ghc-boot/GHC/Unit/Database.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-internal/bignum-backend.rst - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs - − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs - − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs - − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Lexeme.hs - libraries/ghc-internal/src/GHC/Internal/Natural.hs - libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Run.hs - libraries/process - rts/Capability.c - rts/Messages.c - rts/Schedule.c - rts/ThreadPaused.c - rts/Threads.c - rts/Timer.c - rts/Updates.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/OSThreads.h - rts/include/rts/storage/ClosureMacros.h - rts/sm/BlockAlloc.c - rts/sm/Evac.h - rts/sm/MBlock.c - rts/win32/libHSghc-internal.def.in - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/mk/test.mk - testsuite/tests/MiniQuickCheck.hs - testsuite/tests/codeGen/should_run/T16617.hs - testsuite/tests/codeGen/should_run/T16617.stdout - + testsuite/tests/codeGen/should_run/T27046.hs - + testsuite/tests/codeGen/should_run/T27046_cmm.cmm - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/T27370/Makefile - + testsuite/tests/driver/T27370/T27370.hs - + testsuite/tests/driver/T27370/T27370.pp - + testsuite/tests/driver/T27370/T27370.stderr - + testsuite/tests/driver/T27370/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/ghc-api/settings/LibDir.hs - + testsuite/tests/ghc-api/settings/LibDir.stdout - + testsuite/tests/ghc-api/settings/all.T - 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/numeric/should_run/foundation.hs - + testsuite/tests/perf/compiler/T26426.hs - testsuite/tests/perf/compiler/all.T - + testsuite/tests/perf/should_run/T11226.hs - + testsuite/tests/perf/should_run/T11226.stdout - testsuite/tests/perf/should_run/all.T - + testsuite/tests/profiling/should_compile/T27182.hs - testsuite/tests/profiling/should_compile/all.T - + testsuite/tests/profiling/should_run/T27225.hs - + testsuite/tests/profiling/should_run/T27225.stdout - + testsuite/tests/profiling/should_run/T27225b.hs - + testsuite/tests/profiling/should_run/T27225b.stdout - testsuite/tests/profiling/should_run/all.T - testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample - testsuite/tests/profiling/should_run/callstack001.stdout - testsuite/tests/profiling/should_run/scc001.prof.sample - testsuite/tests/rts/T27131.hs - testsuite/tests/rts/T27131.stdout - + testsuite/tests/simplCore/should_compile/T27261.hs - + testsuite/tests/simplCore/should_compile/T27261_aux.hs - + testsuite/tests/simplCore/should_compile/T4081.hs - + testsuite/tests/simplCore/should_compile/T4081.stderr - testsuite/tests/simplCore/should_compile/all.T - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-api/src/Haddock/Options.hs - utils/haddock/haddock-api/src/Haddock/Utils.hs - utils/haddock/html-test/ref/Hash.html - utils/haddock/html-test/ref/Test.html - utils/haddock/html-test/ref/TypeFamilies3.html The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a00ce157046e07ddea7d35426983d2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a00ce157046e07ddea7d35426983d2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/ghc-9-14-building-base] Correct directory name and clarify GHC version expansion
by Wolfgang Jeltsch (＠jeltsch) 16 Jun '26

16 Jun '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-9-14-building-base at Glasgow Haskell Compiler / GHC Commits: 86b407c5 by Wolfgang Jeltsch at 2026-06-16T14:34:00+02:00 Correct directory name and clarify GHC version expansion - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1160,10 +1160,10 @@ base-build-with-ghc-914: script: - | ghc_version=9.14.1 - url=https://downloads.haskell.org/~ghc/$ghc_version/ghc-$ghc_version-x86_64… - curl "$url" >ghc-$ghc_version.tar.xz - tar -xJf ghc-$ghc_version.tar.xz - cd ghc-$ghc_version + url=https://downloads.haskell.org/~ghc/${ghc_version}/ghc-${ghc_version}-x8… + curl "$url" >ghc-${ghc_version}.tar.xz + tar -xJf ghc-${ghc_version}.tar.xz + cd ghc-${ghc_version}-x86_64-unknown-linux ./configure --prefix "$PWD/../ghc" make install cd - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86b407c5c066e3406c6d9e2a54a00c8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86b407c5c066e3406c6d9e2a54a00c8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T27296-stable-simpl] Compare Core dump sort keys on FastStrings, not Strings
by Simon Jakobi (＠sjakobi2) 16 Jun '26

16 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/T27296-stable-simpl at Glasgow Haskell Compiler / GHC Commits: 41be6868 by Simon Jakobi at 2026-06-16T12:31:33+02:00 Compare Core dump sort keys on FastStrings, not Strings sortCoreBindingsForDump built each binder's sort key with getOccString, i.e. unpackFS of the OccName -- a fresh String -- used both for the lexical tie-break and for the '$' derived-binder test. For the anonymous floats this part of the key is forced for every binder (they all share the noSrcSpan bucket), so the String was allocated and compared repeatedly. Operate on the interned FastString directly instead: * the lexical tie-break uses LexicalFastString, whose Ord is the deterministic byte-wise lexicalCompareFS; * the '$' test is an in-place SBS.elem over the FastString's bytes ('$' is ASCII, so byte membership is exact). The dump ordering is unchanged. Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 1 changed file: - compiler/GHC/Core/Ppr.hs Changes: ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -29,9 +29,10 @@ import GHC.Prelude import GHC.Core import GHC.Core.Stats (CoreStats(..), exprStats) +import GHC.Data.FastString (LexicalFastString(..), fastStringToShortByteString) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Literal( Literal, pprLiteral ) -import GHC.Types.Name( getOccString, getSrcSpan, pprInfixName, pprPrefixName ) +import GHC.Types.Name( getOccFS, getSrcSpan, pprInfixName, pprPrefixName ) import GHC.Types.Var import GHC.Types.Id import GHC.Types.Id.Info @@ -51,6 +52,8 @@ import GHC.Types.SrcLoc ( SrcSpan(..), pprUserRealSpan, srcSpanStartCol import GHC.Types.Tickish import Data.List ( sortOn ) +import Data.Char ( ord ) +import qualified Data.ByteString.Short as SBS {- ************************************************************************ @@ -133,7 +136,7 @@ type DumpSortKey = , Int -- source-span start line , Int -- source-span start column , Int -- dollar-rank: 0 = derived ($w/$s) binder, 1 = its origin - , String -- the OccName string, a lexical tiebreak + , LexicalFastString -- the OccName, compared lexically , RhsKey -- content-based tiebreak (see 'rhsKey') ) @@ -154,9 +157,9 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers bindKey (Rec []) = panic "sortCoreBindingsForDump: empty Rec" elemKey :: CoreBndr -> CoreExpr -> DumpSortKey - elemKey b rhs = (bucket, line, col, dollar_rank, s, rhsKey rhs) + elemKey b rhs = (bucket, line, col, dollar_rank, LexicalFastString nm, rhsKey rhs) where - s = getOccString b + nm = getOccFS b (bucket, line, col) = case getSrcSpan b of RealSrcSpan rs _ -> (0, srcSpanStartLine rs, srcSpanStartCol rs) _ -> (1, 0, 0) -- noSrcSpan: sort last @@ -165,8 +168,10 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers -- bar_$sfoo); rank those before their origin within a shared source span, -- mirroring GHC's default dependency order (the wrapper calls the worker, -- so the worker comes first). - dollar_rank | '$' `elem` s = 0 - | otherwise = 1 + dollar_rank | dollarByte `SBS.elem` fastStringToShortByteString nm = 0 + | otherwise = 1 + + dollarByte = fromIntegral (ord '$') -- | A content-based tie-break on a binder's right-hand side: see point 4 of -- Note [Stable Core dump order]. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41be6868005524a03887baae612d559… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41be6868005524a03887baae612d559… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T27379] Base subVarSet/subDVarSet on a proper subset operation
by Simon Jakobi (＠sjakobi2) 16 Jun '26

16 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/T27379 at Glasgow Haskell Compiler / GHC Commits: 3f0299bd by Simon Jakobi at 2026-06-16T12:42:42+02:00 Base subVarSet/subDVarSet on a proper subset operation Previously these were defined as isEmpty (s1 minus s2), which materializes the entire difference map just to test it for emptiness. The new subUFM/subUDFM use Word64Map.keysAreSubsetOf, which short-circuits on the first non-member and allocates nothing. Complexity-wise the recursion is driven by the first map and only probes the second to depth W (the word width) at each step, never traversing it in full. So keysAreSubsetOf is O(n*W), i.e. O(n) in the size of the first map for fixed W, rather than the O(n+m) of the difference-based version. Closes #27379 Co-Authored-By: Claude Fable 5 <noreply(a)anthropic.com> - - - - - 5 changed files: - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Set.hs Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -235,6 +235,7 @@ module GHC.Data.Word64Map.Internal ( -- * Submap , isSubmapOf, isSubmapOfBy , isProperSubmapOf, isProperSubmapOfBy + , keysAreSubsetOf -- * Min\/Max , lookupMin @@ -2441,6 +2442,21 @@ isSubmapOfBy predicate (Tip k x) t = case lookup k t of Nothing -> False isSubmapOfBy _ Nil _ = True +-- | $O(n \cdot W)$. Are all of the first map's keys present in the second? +-- +-- Like @'isSubmapOfBy' (\\_ _ -> True)@ but fully value-agnostic. +keysAreSubsetOf :: Word64Map a -> Word64Map b -> Bool +keysAreSubsetOf t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) + | shorter m1 m2 = False + | shorter m2 m1 = match p1 p2 m2 && + if zero p1 m2 + then keysAreSubsetOf t1 l2 + else keysAreSubsetOf t1 r2 + | otherwise = p1 == p2 && keysAreSubsetOf l1 l2 && keysAreSubsetOf r1 r2 +keysAreSubsetOf (Bin _ _ _ _) _ = False +keysAreSubsetOf (Tip k _) t = member k t +keysAreSubsetOf Nil _ = True + {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------} ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -206,6 +206,7 @@ module GHC.Data.Word64Map.Lazy ( -- * Submap , isSubmapOf, isSubmapOfBy , isProperSubmapOf, isProperSubmapOfBy + , keysAreSubsetOf -- * Min\/Max , lookupMin ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -48,7 +48,7 @@ module GHC.Types.Unique.DFM ( isNullUDFM, sizeUDFM, intersectUDFM, udfmIntersectUFM, - disjointUDFM, disjointUdfmUfm, + disjointUDFM, disjointUdfmUfm, subUDFM, equalKeysUDFM, minusUDFM, listToUDFM, listToUDFM_Directly, @@ -388,6 +388,10 @@ disjointUDFM (UDFM x _i) (UDFM y _j) = M.disjoint x y disjointUdfmUfm :: UniqDFM key elt -> UniqFM key elt2 -> Bool disjointUdfmUfm (UDFM x _i) y = M.disjoint x (ufmToIntMap y) +-- | True if the first map's keys are a subset of the second's. +subUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> Bool +subUDFM (UDFM x _i) (UDFM y _j) = M.keysAreSubsetOf x y + minusUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> UniqDFM key elt1 minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i -- M.difference returns a subset of a left set, so `i` is a good upper ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Types.Unique.FM ( intersectUFM_C, strictIntersectUFM_C, disjointUFM, + subUFM, equalKeysUFM, diffUFM, nonDetStrictFoldUFM, nonDetFoldUFM, nonDetStrictFoldUFM_DirectlyM, @@ -430,6 +431,10 @@ strictIntersectUFM_C f (UFM x) (UFM y) = UFM (MS.intersectionWith f x y) disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool disjointUFM (UFM x) (UFM y) = M.disjoint x y +-- | True if the first map's keys are a subset of the second's. +subUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool +subUFM (UFM x) (UFM y) = M.keysAreSubsetOf x y + -- | Fold over a 'UniqFM'. -- -- Non-deterministic, unless the folding function is commutative ===================================== compiler/GHC/Types/Var/Set.hs ===================================== @@ -53,8 +53,8 @@ import GHC.Types.Unique import GHC.Types.Name ( Name ) import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.FM( disjointUFM, pluralUFM, pprUFM ) -import GHC.Types.Unique.DFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM ) +import GHC.Types.Unique.FM( disjointUFM, subUFM, pluralUFM, pprUFM ) +import GHC.Types.Unique.DFM( disjointUDFM, subUDFM, udfmToUfm, anyUDFM, allUDFM ) import GHC.Utils.Outputable (SDoc) -- | A non-deterministic Variable Set @@ -141,7 +141,7 @@ mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs -- See comments with type signatures intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2) disjointVarSet s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2) -subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2) +subVarSet s1 s2 = subUFM (getUniqSet s1) (getUniqSet s2) anyVarSet :: (Var -> Bool) -> VarSet -> Bool anyVarSet = uniqSetAny @@ -261,7 +261,7 @@ dVarSetElems :: DVarSet -> [Var] dVarSetElems = uniqDSetToList subDVarSet :: DVarSet -> DVarSet -> Bool -subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2) +subDVarSet s1 s2 = subUDFM (getUniqDSet s1) (getUniqDSet s2) unionDVarSet :: DVarSet -> DVarSet -> DVarSet unionDVarSet = unionUniqDSets View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0299bde8063675d36432ff2ebf44a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0299bde8063675d36432ff2ebf44a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/26616] compiler: refactor error reporting code for ExplicitLevelImports
by Magnus (＠MangoIV) 16 Jun '26

16 Jun '26

Magnus pushed to branch wip/mangoiv/26616 at Glasgow Haskell Compiler / GHC Commits: 768de01f by mangoiv at 2026-06-16T11:58:01+02:00 compiler: refactor error reporting code for ExplicitLevelImports Refactors error reporting code for ExplicitLevelImports to pass in a RdrName and a GlobalReaderElt to be able to report errors that are faithful to the source and to more precisely distinguish between names that are in scope from different qualifications. Fixes #27385 and #26616 - - - - - 30 changed files: - + changelog.d/26616 - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Name/Reader.hs - testsuite/tests/quotes/LiftErrMsg.stderr - testsuite/tests/quotes/LiftErrMsgDefer.stderr - testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/splice-imports/T26088.stderr - testsuite/tests/splice-imports/T26090.stderr - + testsuite/tests/splice-imports/T26616.hs - + testsuite/tests/splice-imports/T26616.stderr - testsuite/tests/splice-imports/all.T Changes: ===================================== changelog.d/26616 ===================================== @@ -0,0 +1,9 @@ +section: compiler +synopsis: Fix bugs with ExplcitLevelImports accepting incorrect qualified imports and reporting errors + incorrectly in the presence of qualified imports +description: When reporting errors, ExplcitLevelImports would sometimes report identifiers qualified at a + module they were not oringally actually be qualified at. It would also allow using *any* qualified import + to bring an identifier into scope, even if that qualified import was not imported at the correct level. + This MR fixes both issues by passing more information to the responsible error reporting code. +mrs: !16195 +issues: #26616 #27385 ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2254,6 +2254,7 @@ data HsImplicitLiftSplice = { implicit_lift_bind_lvl :: S.Set ThLevelIndex , implicit_lift_used_lvl :: ThLevelIndex , implicit_lift_gre :: Maybe GlobalRdrElt + -- ^ Nothing iff 'LevelCheckReason' is 'LevelCheckInstance' , implicit_lift_lid :: LIdOccP GhcRn } ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -12,9 +12,9 @@ module GHC.Rename.Env ( lookupLocatedTopBndrRnN, lookupTopBndrRn, - lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField, + lookupLocatedOccRn, lookupLocatedOccRnGRE, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField, lookupLocatedOccRnNone, - lookupOccRn, lookupOccRn_maybe, lookupSameOccRn_maybe, + lookupOccRn, lookupOccRnGRE, lookupOccRn_maybe, lookupSameOccRn_maybe, lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupLocalOccRn, lookupTypeOccRn, @@ -992,6 +992,11 @@ lookupLocatedOccRn :: WhatLooking -> TcRn (GenLocated (EpAnn ann) Name) lookupLocatedOccRn what = wrapLocMA (lookupOccRn what) +lookupLocatedOccRnGRE :: WhatLooking + -> GenLocated (EpAnn ann) RdrName + -> TcRn (GenLocated (EpAnn ann) GlobalRdrElt) +lookupLocatedOccRnGRE what = wrapLocMA (lookupOccRnGRE what) + lookupLocatedOccRnConstr :: GenLocated (EpAnn ann) RdrName -> TcRn (GenLocated (EpAnn ann) Name) lookupLocatedOccRnConstr = wrapLocMA lookupOccRnConstr @@ -1019,11 +1024,14 @@ lookupLocalOccThLvl_maybe name -- | lookupOccRn looks up an occurrence of a RdrName, and uses its argument to -- determine what kind of suggestions should be displayed if it is not in scope lookupOccRn :: WhatLooking -> RdrName -> RnM Name -lookupOccRn which_suggest rdr_name +lookupOccRn which_suggest = fmap greName . lookupOccRnGRE which_suggest + +lookupOccRnGRE :: WhatLooking -> RdrName -> RnM GlobalRdrElt +lookupOccRnGRE which_suggest rdr_name = do { mb_gre <- lookupOccRn_maybe rdr_name ; case mb_gre of - Just gre -> return $ greName gre - Nothing -> reportUnboundName which_suggest rdr_name } + Just gre -> return gre + Nothing -> mkUnboundGRERdr rdr_name <$ reportUnboundName which_suggest rdr_name } -- | Look up an occurrence of a 'RdrName'. -- @@ -1087,16 +1095,22 @@ lookupLocalOccRn rdr_name -- lookupTypeOccRn looks up an optionally promoted RdrName. -- Used for looking up type variables. -lookupTypeOccRn :: RdrName -> RnM Name +lookupTypeOccRn :: RdrName -> RnM GlobalRdrElt -- see Note [Demotion] lookupTypeOccRn rdr_name = do { mb_gre <- lookupOccRn_maybe rdr_name ; case mb_gre of - Just gre -> return $ greName gre - Nothing -> - if occName rdr_name == occName eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback] - then eqTyConName <$ addDiagnostic TcRnTypeEqualityOutOfScope - else lookup_demoted rdr_name } + Just gre -> return gre + Nothing + | occName rdr_name == occName eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback] + -> mkExactGRE + eqTyConName + -- eqTyCon is not an open family ty con (which is the only + -- case in which the functoriality of TyConFlavour actually + -- matters) + (IAmTyCon (eqTyConName <$ tyConFlavour eqTyCon)) + <$ addDiagnostic TcRnTypeEqualityOutOfScope + | otherwise -> lookup_demoted rdr_name } {- Note [eqTyCon (~) compatibility fallback] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1113,7 +1127,7 @@ but emit appropriate warnings. -} -- Used when looking up a term name (varName or dataName) in a type -lookup_demoted :: RdrName -> RnM Name +lookup_demoted :: RdrName -> RnM GlobalRdrElt lookup_demoted rdr_name | Just demoted_rdr <- demoteRdrNameTcCls rdr_name -- Maybe it's the name of a *data* constructor @@ -1121,11 +1135,12 @@ lookup_demoted rdr_name ; star_is_type <- xoptM LangExt.StarIsType ; let is_star_type = if star_is_type then StarIsType else StarIsNotType star_is_type_hints = noStarIsTypeHints is_star_type rdr_name + mk_unbound_name_GRE hint = unboundGREX looking_for rdr_name hint ; if data_kinds then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr ; case mb_demoted_gre of - Nothing -> unboundNameX looking_for rdr_name star_is_type_hints - Just demoted_gre -> return $ greName demoted_gre} + Nothing -> mk_unbound_name_GRE star_is_type_hints + Just demoted_gre -> return demoted_gre} else do { -- We need to check if a data constructor of this name is -- in scope to give good error messages. However, we do -- not want to give an additional error if the data @@ -1137,13 +1152,13 @@ lookup_demoted rdr_name = [SuggestExtension $ SuggestSingleExtension additional LangExt.DataKinds] | otherwise = star_is_type_hints - ; unboundNameX looking_for rdr_name suggestion } } + ; mk_unbound_name_GRE suggestion } } | isQual rdr_name, Just demoted_rdr_name <- demoteRdrNameTv rdr_name -- Definitely an illegal term variable, as type variables are never exported. -- See Note [Demotion of unqualified variables] (W2) - = report_qualified_term_in_types rdr_name demoted_rdr_name + = mkUnboundGREName <$> report_qualified_term_in_types rdr_name demoted_rdr_name | isUnqual rdr_name, Just demoted_rdr_name <- demoteRdrNameTv rdr_name @@ -1152,12 +1167,12 @@ lookup_demoted rdr_name ; if required_type_arguments then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr_name ; case mb_demoted_gre of - Nothing -> unboundName (LF WL_Anything WL_Anywhere) rdr_name - Just demoted_gre -> return $ greName demoted_gre } - else unboundName looking_for rdr_name } + Nothing -> unboundGRE (LF WL_Anything WL_Anywhere) rdr_name + Just demoted_gre -> return demoted_gre } + else unboundGRE looking_for rdr_name } | otherwise - = unboundName looking_for rdr_name + = unboundGRE looking_for rdr_name where looking_for = LF WL_Type WL_Anywhere ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -321,7 +320,7 @@ rnExpr (HsVar _ (L l v)) -- matching GRE and add a name clash error -- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn). -> do { let sel_name = flSelector $ recFieldLabel fld_info - ; checkThLocalNameNoLift (L (l2l l) (WithUserRdr v sel_name)) + ; checkThLocalNameNoLift (L l $ WithUserRdr v gre) ; return (XExpr (HsRecSelRn (FieldOcc v (L l sel_name))), unitFN sel_name) } | nm == nilDataConName @@ -332,7 +331,7 @@ rnExpr (HsVar _ (L l v)) -> rnExpr (ExplicitList noAnn []) | otherwise - -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v nm)) + -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v gre)) ; return (res_expr, unitFN nm) } }}} ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -606,20 +606,21 @@ rnHsTyKi env tv@(HsTyVar _ ip (L loc rdr_name)) TcRnUnexpectedKindVar rdr_name -- Any type variable at the kind level is illegal without the use -- of PolyKinds (see #14710) - ; name <- rnTyVar env rdr_name + ; gre <- rnTyVar env rdr_name ; this_mod <- getModule ; explicit_level_imports <- xoptM LangExt.ExplicitLevelImports - ; let loc_name_with_rdr = L loc $ WithUserRdr rdr_name name + ; let loc_gre_with_rdr = L loc $ WithUserRdr rdr_name gre + name = greName gre ; if | explicit_level_imports -- See Note [Strict level checks with ExplicitLevelImports] - -> checkThLocalNameNoLift loc_name_with_rdr + -> checkThLocalNameNoLift loc_gre_with_rdr | nameIsLocalOrFrom this_mod name - -> checkThLocalTyName name + -> checkThLocalTyName gre | otherwise -> pure () - ; checkPromotedDataConName env tv Prefix ip name - ; return (HsTyVar noAnn ip loc_name_with_rdr, unitFN name) } + ; checkPromotedDataConName env tv Prefix ip $ greName gre + ; return (HsTyVar noAnn ip $ fmap greName <$> loc_gre_with_rdr, unitFN name) } rnHsTyKi env ty@(HsOpTy _ ty1 tyop ty2) = setSrcSpan (getLocA tyop) $ @@ -826,13 +827,13 @@ throw an error accordingly. -} -------------- -rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name +rnTyVar :: RnTyKiEnv -> RdrName -> RnM GlobalRdrElt rnTyVar env rdr_name - = do { name <- lookupTypeOccRn rdr_name - ; checkNamedWildCard env name - ; return name } + = do { gre <- lookupTypeOccRn rdr_name + ; checkNamedWildCard env $ greName gre + ; return gre } -rnLTyVar :: LocatedN RdrName -> RnM (LocatedN Name) +rnLTyVar :: LocatedN RdrName -> RnM (LocatedN GlobalRdrElt) -- Called externally; does not deal with wildcards rnLTyVar (L loc rdr_name) = do { tyvar <- lookupTypeOccRn rdr_name @@ -843,14 +844,15 @@ rnHsTyOp :: RnTyKiEnv -> HsType GhcPs -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames) rnHsTyOp env overall_ty tyop | L l (HsTyVar ann prom (L loc op)) <- tyop - = do { op' <- rnTyVar env op + = do { opgre <- rnTyVar env op + ; let opName = greName opgre ; unlessXOptM LangExt.TypeOperators $ - if (op' `hasKey` eqTyConKey) -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env + if opName `hasKey` eqTyConKey -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env then addDiagnostic TcRnTypeEqualityRequiresOperators else addErr $ TcRnIllegalTypeOperator (ppr overall_ty) op - ; checkPromotedDataConName env overall_ty Infix prom op' - ; let tyop' = L l (HsTyVar ann prom (L loc (WithUserRdr op op'))) - ; return (tyop', unitFN op') } + ; checkPromotedDataConName env overall_ty Infix prom opName + ; let tyop' = L l (HsTyVar ann prom (L loc (WithUserRdr op opName))) + ; return (tyop', unitFN opName) } | otherwise = rnLHsTyKi env tyop ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2491,8 +2491,8 @@ rnInjectivityAnn tvBndrs (L _ (TyVarSig _ resTv)) bindLocalNames (maybeToList (hsLTyVarName resTv)) $ -- The return type variable scopes over the injectivity annotation -- e.g. type family F a = (r::*) | r -> a - do { injFrom' <- rnLTyVar injFrom - ; injTo' <- mapM rnLTyVar injTo + do { injFrom' <- fmap greName <$> rnLTyVar injFrom + ; injTo' <- mapM (fmap (fmap greName) . rnLTyVar) injTo -- Note: srcSpan is unchanged, but typechecker gets -- confused, l2l call makes it happy ; return $ L (l2l srcSpan) (InjectivityAnn x injFrom' injTo') } @@ -2533,7 +2533,7 @@ rnInjectivityAnn _ _ (L srcSpan (InjectivityAnn x injFrom injTo)) = (injDecl', _) <- askNoErrs $ do injFrom' <- rnLTyVar injFrom injTo' <- mapM rnLTyVar injTo - return $ L srcSpan (InjectivityAnn x injFrom' injTo') + return $ L srcSpan (InjectivityAnn x (fmap greName injFrom') (fmap (fmap greName) injTo')) return $ injDecl' {- ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -1296,7 +1296,8 @@ wrapSrcSpanTPRnM fn (L loc a) = do lookupTypeOccTPRnM :: RdrName -> TPRnM Name lookupTypeOccTPRnM rdr_name = liftRnFV $ do - name <- lookupTypeOccRn rdr_name + gre <- lookupTypeOccRn rdr_name + let name = greName gre pure (name, unitFN name) rn_lty_pat :: LHsType GhcPs -> TPRnM (LHsType GhcRn) ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -1,5 +1,4 @@ {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE MultiWayIf #-} module GHC.Rename.Splice ( rnTopSpliceDecls, @@ -40,7 +39,7 @@ import GHC.Unit.Module import GHC.Types.SrcLoc import GHC.Rename.HsType ( rnLHsType ) -import Control.Monad ( unless, when ) +import Control.Monad ( unless, when, void ) import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr ) @@ -182,11 +181,12 @@ rnUntypedBracket e br_body rn_utbracket :: HsQuote GhcPs -> RnM (HsQuote GhcRn, FreeNames) rn_utbracket (VarBr _ is_value_name rdr_name) - = do { name <- lookupOccRn (if is_value_name then WL_Term else WL_Type) (unLoc rdr_name) - ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) name) - ; if is_value_name then checkThLocalNameNoLift res_name else checkThLocalTyName name - ; check_namespace is_value_name name - ; return (VarBr noExtField is_value_name (noLocA name), unitFN name) } + = do { gre <- lookupOccRnGRE (if is_value_name then WL_Term else WL_Type) (unLoc rdr_name) + ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) gre) + ; let name = greName gre + ; if is_value_name then checkThLocalNameNoLift res_name else checkThLocalTyName gre + ; check_namespace is_value_name $ greName gre + ; return (VarBr noExtField is_value_name (fmap (greName . unwrapUserRdr) res_name), unitFN name) } rn_utbracket (ExpBr _ e) = do { (e', fvs) <- rnLExpr e ; return (ExpBr noExtField e', fvs) } @@ -431,10 +431,11 @@ rnUntypedSplice (HsUntypedSpliceExpr _ expr) flavour rnUntypedSplice (HsQuasiQuote _ quoter quote) flavour = do { -- Rename the quoter; akin to the HsVar case of rnExpr - ; quoter' <- lookupLocatedOccRn WL_TermVariable quoter + ; quoter' <- lookupLocatedOccRnGRE WL_TermVariable quoter ; let res_name = WithUserRdr (unLoc quoter) <$> quoter' ; checkThLocalNameNoLift res_name - ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) quoter' quote, unitFN (unLoc quoter')) } + ; let loc_name = fmap greName quoter' + ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) loc_name quote, unitFN (unLoc loc_name)) } --------------------- rnTypedSplice :: HsTypedSplice GhcPs -- Typed splice expression @@ -907,14 +908,14 @@ traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd , gen ] -checkThLocalTyName :: Name -> RnM () -checkThLocalTyName name +checkThLocalTyName :: GlobalRdrElt -> RnM () +checkThLocalTyName gre | isUnboundName name -- Do not report two errors for = return () -- $(not_in_scope args) | otherwise = do { traceRn "checkThLocalTyName" (ppr name) - ; mb_local_use <- getCurrentAndBindLevel name + ; mb_local_use <- getCurrentAndBindLevel gre ; case mb_local_use of { Nothing -> return () ; -- Not a locally-bound thing Just (top_lvl, bind_lvl, use_lvl) -> @@ -932,28 +933,29 @@ checkThLocalTyName name <+> ppr use_lvl) ; dflags <- getDynFlags ; checkCrossLevelLiftingTy dflags top_lvl bind_lvl use_lvl name } } } + where name = greName gre -- | Check whether we are allowed to use a Name in this context (for TH purposes) -- In the case of a level incorrect program, attempt to fix it by using -- a Lift constraint. -checkThLocalNameWithLift :: LIdOccP GhcRn -> RnM (HsExpr GhcRn) +checkThLocalNameWithLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM (HsExpr GhcRn) checkThLocalNameWithLift = checkThLocalName True -- | Check whether we are allowed to use a Name in this context (for TH purposes) -- In the case of a level incorrect program, do not attempt to fix it by using -- a Lift constraint. -checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM () -checkThLocalNameNoLift name = checkThLocalName False name >> return () +checkThLocalNameNoLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM () +checkThLocalNameNoLift = void . checkThLocalName False -- | Implementation of the level checks -- See Note [Template Haskell levels] -checkThLocalName :: Bool -> LIdOccP GhcRn -> RnM (HsExpr GhcRn) -checkThLocalName allow_lifting name_var +checkThLocalName :: Bool -> LocatedN (WithUserRdr GlobalRdrElt) -> RnM (HsExpr GhcRn) +checkThLocalName allow_lifting loc_gre -- Exact and Orig names are not imported, so presumed available at all levels. -- whenever the user uses exact names, e.g. say @'mkNameG_v' "" "Foo" "bar"@, -- even though the 'mkNameG_v' here is essentially a quotation, we do not do -- level checks as we assume that the user was trying to bypass the level checks - | isExact (userRdrName (unLoc name_var)) || isOrig (userRdrName (unLoc name_var)) + | isExact rdr || isOrig rdr = return (HsVar noExtField name_var) | isUnboundName name -- Do not report two errors for = return (HsVar noExtField name_var) -- $(not_in_scope args) @@ -961,7 +963,7 @@ checkThLocalName allow_lifting name_var = return (HsVar noExtField name_var) | otherwise = do { - mb_local_use <- getCurrentAndBindLevel name + mb_local_use <- getCurrentAndBindLevel $ unwrap loc_gre ; case mb_local_use of { Nothing -> return (HsVar noExtField name_var) ; -- Not a locally-bound thing Just (top_lvl, bind_lvl, use_lvl) -> @@ -969,13 +971,12 @@ checkThLocalName allow_lifting name_var ; let is_local | Just mod <- nameModule_maybe name = mod == cur_mod | otherwise = True - ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl <+> ppr use_lvl) ; dflags <- getDynFlags - ; env <- getGlobalRdrEnv - ; let mgre = lookupGRE_Name env name - ; checkCrossLevelLifting dflags (LevelCheckSplice name mgre) top_lvl is_local allow_lifting bind_lvl use_lvl name_var } } } - where - name = getName name_var + ; checkCrossLevelLifting dflags (LevelCheckSplice $ unLoc loc_gre) top_lvl is_local allow_lifting bind_lvl use_lvl name_var } } } + where rdr = userRdrName $ unLoc name_var + name_var = fmap greName <$> loc_gre + name = unwrap name_var + unwrap = unwrapUserRdr . unLoc -------------------------------------- checkCrossLevelLifting :: DynFlags @@ -1013,12 +1014,14 @@ checkCrossLevelLifting dflags reason top_lvl_flg is_local allow_lifting bind_lvl , any (\bind_idx -> use_lvl_idx == incThLevelIndex bind_idx) (Set.toList bind_lvl) , allow_lifting = do - let mgre = case reason of - LevelCheckSplice _ gre -> gre - _ -> Nothing + let gre + | LevelCheckSplice rdr <- reason + = Just $! unwrapUserRdr rdr + | otherwise + = Nothing (splice_name :: Name) <- newLocalBndrRn (noLocA unqualSplice) let pend_splice :: HsImplicitLiftSplice - pend_splice = HsImplicitLiftSplice bind_lvl use_lvl_idx mgre name_var + pend_splice = HsImplicitLiftSplice bind_lvl use_lvl_idx gre name_var -- Warning for implicit lift (#17804) addDetailedDiagnostic (TcRnImplicitLift name) ===================================== compiler/GHC/Rename/Splice.hs-boot ===================================== @@ -2,7 +2,7 @@ module GHC.Rename.Splice where import GHC.Hs import GHC.Tc.Utils.Monad -import GHC.Types.Name (Name) +import GHC.Types.Name.Reader (WithUserRdr, GlobalRdrElt) import GHC.Types.Name.Set @@ -15,6 +15,6 @@ rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeNames) rnTopSpliceDecls :: HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeNames) -checkThLocalTyName :: Name -> RnM () +checkThLocalTyName :: GlobalRdrElt -> RnM () -checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM () +checkThLocalNameNoLift :: LocatedN (WithUserRdr GlobalRdrElt) -> RnM () ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Rename.Unbound , mkUnboundNameRdr , mkUnboundGRE , mkUnboundGRERdr + , mkUnboundGREName , isUnboundName , reportUnboundName , unknownNameSuggestions @@ -24,6 +25,8 @@ module GHC.Rename.Unbound , LookingFor(..) , unboundName , unboundNameX + , unboundGRE + , unboundGREX , unboundTermNameInTypes , IsTermInTypes(..) , notInScopeErr @@ -102,14 +105,23 @@ mkUnboundNameRdr :: RdrName -> Name mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr) mkUnboundGRE :: OccName -> GlobalRdrElt -mkUnboundGRE occ = mkLocalGRE UnboundGRE NoParent $ mkUnboundName occ +mkUnboundGRE occ = mkUnboundGREName $ mkUnboundName occ mkUnboundGRERdr :: RdrName -> GlobalRdrElt -mkUnboundGRERdr rdr = mkLocalGRE UnboundGRE NoParent $ mkUnboundNameRdr rdr +mkUnboundGRERdr rdr = mkUnboundGREName $ mkUnboundNameRdr rdr + +mkUnboundGREName :: Name -> GlobalRdrElt +mkUnboundGREName = mkLocalGRE UnboundGRE NoParent reportUnboundName :: WhatLooking -> RdrName -> RnM Name reportUnboundName what_look rdr = unboundName (LF what_look WL_Anywhere) rdr +unboundGRE :: LookingFor -> RdrName -> RnM GlobalRdrElt +unboundGRE lf rdr = mkUnboundGREName <$> unboundName lf rdr + +unboundGREX :: LookingFor -> RdrName -> [GhcHint] -> RnM GlobalRdrElt +unboundGREX lf rdr hints = mkUnboundGREName <$> unboundNameX lf rdr hints + unboundName :: LookingFor -> RdrName -> RnM Name unboundName lf rdr = unboundNameX lf rdr [] ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1188,8 +1188,14 @@ mkImplicitLiftingReporter ctxt mkImplicitLiftingError :: ErrorItem -> TcRnMessage mkImplicitLiftingError item = case errorItemOrigin item of - ImplicitLiftOrigin (HsImplicitLiftSplice bound used gre name) -> - TcRnBadlyLevelled (LevelCheckSplice (getName name) gre) bound used (Just item) (cec_defer_type_errors ctxt) + -- mgre is Nothing IFF LevelCheckReason is LevelCheckInstance + ImplicitLiftOrigin (HsImplicitLiftSplice bound used (Just gre) loc_name) -> + TcRnBadlyLevelled + (LevelCheckSplice $ gre <$ unLoc loc_name) + bound + used + (Just item) + (cec_defer_type_errors ctxt) _ -> pprPanic "mkImplicitLiftingError" (ppr item) mkGivenErrorReporter :: Reporter ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3465,12 +3465,16 @@ pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt = mkDecorated $ (text "No instance for:" <+> quotes (ppr (errorItemPred item))) | Just item <- [lift_attempt] ] ++ - [ vcat (text "Available from the imports:" : ppr_imports (gre_imp gre)) - | LevelCheckSplice _ (Just gre) <- [reason] + [ ppr_imports (gre_imp gre) + | LevelCheckSplice (unwrapUserRdr -> gre) <- [reason] , not (isEmptyBag (gre_imp gre)) ] where - ppr_imports :: Bag ImportSpec -> [SDoc] - ppr_imports = map ((bullet <+>) . ppr ) . bagToList + ppr_imports :: Bag ImportSpec -> SDoc + ppr_imports bag + | [imp] <- impspecs = pprImpSpec imp + | otherwise = vcat $ text "Available from the imports:" : map ((bullet <+>) . pprImpSpec) impspecs + where impspecs = bagToList bag + pprImpSpec imp = ppr imp note :: SDoc -> SDoc note note = "Note" <> colon <+> note <> dot @@ -6250,8 +6254,8 @@ pprLevelCheckReason :: LevelCheckReason -> SDoc pprLevelCheckReason = \case LevelCheckInstance _ t -> text "instance for" <+> quotes (ppr t) - LevelCheckSplice t _ -> - quotes (ppr t) + LevelCheckSplice t -> + quotes $ ppr $ userRdrName t pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc pprUninferrableTyVarCtx = \case ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -6338,7 +6338,7 @@ data WrongThingSort data LevelCheckReason = LevelCheckInstance !InstanceWhat !PredType - | LevelCheckSplice !Name !(Maybe GlobalRdrElt) + | LevelCheckSplice !(WithUserRdr GlobalRdrElt) data UninferrableTyVarCtx = UninfTyCtx_ClassContext [TcType] ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -540,7 +540,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod let avail = availFromGRE gre name = greName gre - checkThLocalNameNoLift (ieLWrappedUserRdrName l name) + checkThLocalNameNoLift $ ieLWrappedUserRdrName l gre occs' <- check_occs occs ie [gre] (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans @@ -589,7 +589,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod occs' <- check_occs occs ie [gre] return (Just avail, occs', exp_dflts) - checkThLocalNameNoLift (ieLWrappedUserRdrName l name) + checkThLocalNameNoLift (ieLWrappedUserRdrName l gre) (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans dont_warn_export @@ -617,7 +617,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod all_gres = par : all_kids all_names = map greName all_gres - checkThLocalNameNoLift (ieLWrappedUserRdrName l name) + checkThLocalNameNoLift (ieLWrappedUserRdrName l par) occs' <- check_occs occs ie all_gres (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans @@ -656,7 +656,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod all_gres = par : all_kids all_names = map greName all_gres - checkThLocalNameNoLift (ieLWrappedUserRdrName l name) + checkThLocalNameNoLift (ieLWrappedUserRdrName l par) occs' <- check_occs occs ie all_gres (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans @@ -794,8 +794,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod = addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres) -ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> Name -> LIdOccP GhcRn -ieLWrappedUserRdrName l n = fmap (\rdr -> WithUserRdr rdr n) $ ieLWrappedName l +ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> n -> GenLocated SrcSpanAnnN (WithUserRdr n) +ieLWrappedUserRdrName l n = (\rdr -> WithUserRdr rdr n) <$> ieLWrappedName l -- | In what namespaces should we go looking for an import/export item -- that is out of scope, for suggestions in error messages? @@ -901,7 +901,7 @@ lookupChildrenExport parent_gre child_gres rdr_items = mapAndReportM doOne rdr_i ; return (replaceLWrappedName n ub, gre)} FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) -> do { checkPatSynParent spec_parent par child_nm - ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm) + ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child) ; return (replaceLWrappedName n child_nm, child) } IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -135,7 +135,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import qualified GHC.LanguageExtensions as LangExt import GHC.Iface.Errors.Types -import GHC.Rename.Unbound ( unknownNameSuggestions ) +import GHC.Rename.Unbound ( unknownNameSuggestions, mkUnboundGREName ) import GHC.Tc.Errors.Types.PromotionErr import {-# SOURCE #-} GHC.Tc.Errors.Hole (getHoleFitDispConfig) @@ -252,15 +252,12 @@ tcLookupGlobal name env <- getGblEnv ; case lookupNameEnv (tcg_type_env env) name of { Just thing -> return thing ; - Nothing -> - -- Should it have been in the local envt? -- (NB: use semantic mod here, since names never use -- identity module, see Note [Identity versus semantic module].) - if nameIsLocalOrFrom (tcg_semantic_mod env) name - then notFound name -- Internal names can happen in GHCi - else - + Nothing | nameIsLocalOrFrom (tcg_semantic_mod env) name -> + notFound $ mkUnboundGREName name -- Internal names can happen in GHCi + | otherwise -> -- Try home package table and external package table do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of @@ -1221,10 +1218,10 @@ pprBinders :: [Name] -> SDoc pprBinders [bndr] = quotes (ppr bndr) pprBinders bndrs = pprWithCommas ppr bndrs -notFound :: Name -> TcM TyThing -notFound name +notFound :: GlobalRdrElt -> TcM TyThing +notFound gre = do { lcl_env <- getLclEnv - ; lvls <- getCurrentAndBindLevel name + ; lvls <- getCurrentAndBindLevel gre ; if -- See Note [Out of scope might be a staging error] | isUnboundName name -> failM -- If the name really isn't in scope -- don't report it again (#11941) @@ -1234,8 +1231,13 @@ notFound name -- introducing bugs after a refactoring of that -- function, we check this completely independently -- before scrutinizing lvls - | Just (_top_lvl_flag, bind_lvls, lvl@Splice {}) <- lvls - -> failWithTc (TcRnBadlyLevelled (LevelCheckSplice name Nothing) bind_lvls (thLevelIndex lvl) Nothing ErrorWithoutFlag) + | Just (_top_lvl_flag, bind_lvls, lvl@Splice {}) <- lvls -> failWithTc $ + TcRnBadlyLevelled + (LevelCheckSplice (gre <$ noUserRdr name)) + bind_lvls + (thLevelIndex lvl) + Nothing + ErrorWithoutFlag | otherwise -> pure () ; if isTermVarOrFieldNameSpace (nameNameSpace name) @@ -1260,6 +1262,7 @@ notFound name -- so let's just not print it! Getting a loop here is -- very unhelpful, because it hides one compiler bug with another } + where name = greName gre wrongThingErr :: WrongThingSort -> TcTyThing -> Name -> TcM a wrongThingErr expected thing name = ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2468,32 +2468,22 @@ keepAlive name getThLevel :: TcM ThLevel getThLevel = do { env <- getLclEnv; return (getLclEnvThLevel env) } -getCurrentAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel)) -getCurrentAndBindLevel name +getCurrentAndBindLevel :: GlobalRdrElt -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel)) +getCurrentAndBindLevel gre = do { env <- getLclEnv; - ; case lookupNameEnv (getLclEnvThBndrs env) name of - Nothing -> do - lvls <- getExternalBindLvl name - if Set.empty == lvls - -- This case happens when code is generated for identifiers which are not - -- in scope. - -- - -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||] - then do - return Nothing - else return (Just (TopLevel, lvls, getLclEnvThLevel env)) - Just (top_lvl, bind_lvl) -> return (Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env)) } - -getExternalBindLvl :: Name -> TcRn (Set.Set ThLevelIndex) -getExternalBindLvl name = do - env <- getGlobalRdrEnv - mod <- getModule - case lookupGRE_Name env name of - Just gre -> return $ (Set.map thLevelIndexFromImportLevel (greLevels gre)) - Nothing -> - if nameIsLocalOrFrom mod name - then return $ Set.singleton topLevelIndex - else return Set.empty + ; return $ case lookupNameEnv (getLclEnvThBndrs env) $ greName gre of + Nothing + | Set.null lvls -> Nothing + -- This case happens when code is generated for identifiers which are not + -- in scope. + -- + -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||] + | otherwise -> Just (TopLevel, lvls, getLclEnvThLevel env) + Just (top_lvl, bind_lvl) -> Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env) } + where lvls = getExternalBindLvl gre + +getExternalBindLvl :: GlobalRdrElt -> Set.Set ThLevelIndex +getExternalBindLvl gre = Set.map thLevelIndexFromImportLevel (greLevels gre) setThLevel :: ThLevel -> TcM a -> TcRn a setThLevel l = updLclEnv (setLclEnvThLevel l) ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Types.Name.Reader ( isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, -- ** Preserving user-written qualification - WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName, + WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName, unwrapUserRdr, -- * Local mapping of 'RdrName' to 'Name.Name' LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList, @@ -2247,9 +2247,12 @@ unLocWithUserRdr (L _ (WithUserRdr _ a)) = a noUserRdr :: Name -> WithUserRdr Name noUserRdr n = WithUserRdr (nameRdrName n) n -userRdrName :: WithUserRdr Name -> RdrName +userRdrName :: WithUserRdr a -> RdrName userRdrName (WithUserRdr rdr _) = rdr +unwrapUserRdr :: WithUserRdr a -> a +unwrapUserRdr (WithUserRdr _ a) = a + rdrQual_maybe :: RdrName -> Maybe ModuleName rdrQual_maybe = \case Qual q _ -> Just q ===================================== testsuite/tests/quotes/LiftErrMsg.stderr ===================================== @@ -2,8 +2,7 @@ LiftErrMsg.hs:14:11: error: [GHC-28914] • Level error: ‘id’ is bound at level 0 but used at level 1 • Could not be resolved by implicit lifting due to the following error: No instance for: ‘Lift (a2 -> a2)’ - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the expression: [| id |] In an equation for ‘test’: test = [| id |] @@ -11,8 +10,7 @@ LiftErrMsg.hs:17:13: error: [GHC-28914] • Level error: ‘id’ is bound at level 0 but used at level 1 • Could not be resolved by implicit lifting due to the following error: No instance for: ‘Lift (a1 -> a1)’ - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the expression: [| (id, id) |] In an equation for ‘test2’: test2 = [| (id, id) |] @@ -20,8 +18,7 @@ LiftErrMsg.hs:17:17: error: [GHC-28914] • Level error: ‘id’ is bound at level 0 but used at level 1 • Could not be resolved by implicit lifting due to the following error: No instance for: ‘Lift (a0 -> a0)’ - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the expression: [| (id, id) |] In an equation for ‘test2’: test2 = [| (id, id) |] ===================================== testsuite/tests/quotes/LiftErrMsgDefer.stderr ===================================== @@ -4,12 +4,11 @@ LiftErrMsgDefer.hs:14:12: warning: [GHC-28914] [-Wdeferred-type-errors (in -Wdef • Level error: ‘id’ is bound at level 0 but used at level 1 • Could not be resolved by implicit lifting due to the following error: No instance for: ‘Lift (a2 -> a2)’ - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the expression: [| id |] In an equation for ‘test1’: test1 = [| id |] (deferred type error) HasCallStack backtrace: - throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base + throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:441:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/quotes/LiftErrMsgTyped.stderr ===================================== @@ -2,8 +2,7 @@ LiftErrMsgTyped.hs:14:12: error: [GHC-28914] • Level error: ‘id’ is bound at level 0 but used at level 1 • Could not be resolved by implicit lifting due to the following error: No instance for: ‘Lift (a -> a)’ - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the typed Template Haskell splice: id In the Template Haskell typed quotation: [|| id ||] In the expression: [|| id ||] @@ -12,8 +11,7 @@ LiftErrMsgTyped.hs:17:14: error: [GHC-28914] • Level error: ‘id’ is bound at level 0 but used at level 1 • Could not be resolved by implicit lifting due to the following error: No instance for: ‘Lift (a -> a)’ - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the typed Template Haskell splice: id In the expression: id In the Template Haskell typed quotation: [|| (id, id) ||] ===================================== testsuite/tests/splice-imports/SI03.stderr ===================================== @@ -1,6 +1,5 @@ SI03.hs:10:11: error: [GHC-28914] • Level error: ‘sid’ is bound at level 0 but used at level -1 - • Available from the imports: - • imported from ‘SI01A’ at SI03.hs:5:1-12 + • imported from ‘SI01A’ at SI03.hs:5:1-12 • In the untyped splice: $(sid [| pure () |]) ===================================== testsuite/tests/splice-imports/SI05.stderr ===================================== @@ -1,7 +1,6 @@ SI05.hs:10:11: error: [GHC-28914] - • Level error: ‘SI01A.sid’ is bound at level 0 but used at level -1 - • Available from the imports: - • imported from ‘SI01A’ at SI05.hs:6:1-12 + • Level error: ‘sid’ is bound at level 0 but used at level -1 + • imported from ‘SI01A’ at SI05.hs:6:1-12 • In the untyped splice: $(sid [| pure () |]) SI05.hs:10:11: error: [GHC-87543] ===================================== testsuite/tests/splice-imports/SI25.stderr ===================================== @@ -1,8 +1,7 @@ SI25.hs:16:13: error: [GHC-28914] • Level error: ‘nestedCode’ is bound at level -1 but used at level -2 - • Available from the imports: - • imported from ‘SI25Helper’ at -1 at SI25.hs:6:1-24 + • imported from ‘SI25Helper’ at -1 at SI25.hs:6:1-24 • In the untyped splice: $(nestedCode "nested") In the untyped splice: $($(nestedCode "nested")) ===================================== testsuite/tests/splice-imports/SI28.stderr ===================================== @@ -1,7 +1,6 @@ SI28.hs:8:13: error: [GHC-28914] • Level error: ‘id’ is bound at level 1 but used at level 0 - • Available from the imports: - • imported from ‘Prelude’ at 1 at SI28.hs:6:1-20 + • imported from ‘Prelude’ at 1 at SI28.hs:6:1-20 • In the Template Haskell quotation: [| id |] In the untyped splice: $([| id |]) ===================================== testsuite/tests/splice-imports/SI31.stderr ===================================== @@ -1,6 +1,5 @@ <interactive>:2:3: error: [GHC-28914] • Level error: ‘id’ is bound at level 0 but used at level -1 - • Available from the imports: - • imported from ‘Prelude’ + • imported from ‘Prelude’ • In the untyped splice: $(id [| () |]) ===================================== testsuite/tests/splice-imports/T26088.stderr ===================================== @@ -1,6 +1,5 @@ T26088A.hs:8:8: error: [GHC-28914] • Level error: ‘a’ is bound at level -1 but used at level 1 - • Available from the imports: - • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21 + • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21 • In the Template Haskell quotation: [| a |] ===================================== testsuite/tests/splice-imports/T26090.stderr ===================================== @@ -1,16 +1,13 @@ T26090.hs:2:17: error: [GHC-28914] • Level error: ‘a’ is bound at level 1 but used at level 0 - • Available from the imports: - • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20 + • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20 T26090.hs:4:17: error: [GHC-28914] • Level error: ‘s’ is bound at level 1 but used at level 0 - • Available from the imports: - • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20 + • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20 • In the export: S(s) T26090.hs:5:17: error: [GHC-28914] • Level error: ‘R’ is bound at level 1 but used at level 0 - • Available from the imports: - • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20 + • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20 ===================================== testsuite/tests/splice-imports/T26616.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ExplicitLevelImports, NoImplicitPrelude #-} +module T26616 where + +import quote Data.Maybe qualified as Q +import Data.Maybe qualified as Z +import splice Data.Maybe qualified as S + +foo = Q.isJust ===================================== testsuite/tests/splice-imports/T26616.stderr ===================================== @@ -0,0 +1,4 @@ +T26616.hs:8:7: error: [GHC-28914] + • Level error: ‘Q.isJust’ is bound at level 1 but used at level 0 + • imported qualified from ‘Data.Maybe’ at 1 at T26616.hs:4:1-39 + ===================================== testsuite/tests/splice-imports/all.T ===================================== @@ -52,3 +52,4 @@ test('T26090', [], multimod_compile_fail, ['T26090', '-v0']) test('ModuleExport', [], multimod_compile_fail, ['ModuleExport', '-v0']) test('LevelImportExports', [], makefile_test, []) test('DodgyLevelExport', [], multimod_compile, ['DodgyLevelExport', '-v0 -Wdodgy-exports']) +test('T26616', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/768de01f58b7ca6ab85a8fba5567bea… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/768de01f58b7ca6ab85a8fba5567bea… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] EPA: Use standard type family declaration for Anno
by Marge Bot (＠marge-bot) 16 Jun '26

16 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 842bef9f by Alan Zimmerman at 2026-06-16T05:48:25-04:00 EPA: Use standard type family declaration for Anno - - - - - 1 changed file: - compiler/Language/Haskell/Syntax/Extension.hs Changes: ===================================== compiler/Language/Haskell/Syntax/Extension.hs ===================================== @@ -108,7 +108,7 @@ dataConCantHappen x = case x of {} -- See Note [XRec and SrcSpans in the AST] type family XRec p a = r | r -> a -type family Anno a = b -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation +type family Anno a -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation {- Note [XRec and SrcSpans in the AST] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/842bef9f444667c305c186cdc9a48b8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/842bef9f444667c305c186cdc9a48b8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] compiler: ignore camelCase and Eta reduce hlint hints
by Marge Bot (＠marge-bot) 16 Jun '26

16 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7f72bcb3 by mangoiv at 2026-06-16T05:47:39-04:00 compiler: ignore camelCase and Eta reduce hlint hints These do not cohere with the style used in GHC. After disabling them, hlint lints are much less noisy again. - - - - - 1 changed file: - compiler/.hlint.yaml Changes: ===================================== compiler/.hlint.yaml ===================================== @@ -3,6 +3,8 @@ ########################## - ignore: {} +- ignore: {name: Use camelCase} +- ignore: {name: Eta reduce} - warn: {name: Unused LANGUAGE pragma} - warn: {name: Use fewer LANGUAGE pragmas} - warn: {name: Redundant return} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f72bcb3389ad97f98276d54cb13bea… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f72bcb3389ad97f98276d54cb13bea… You're receiving this email because of your account on gitlab.haskell.org.

1 0